[Pkg] The Trunk: Morphic-eem.2020.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Jan 11 12:51:16 UTC 2023
Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-eem.2020.mcz
==================== Summary ====================
Name: Morphic-eem.2020
Author: eem
Time: 13 July 2022, 4:26:13.938059 pm
UUID: cc442f16-be3a-4aeb-846f-40e0f4fc3d8e
Ancestors: Morphic-mt.2019
Allow the help in a menu tuple contain \'s for carriage returns, to make balloon help easier to format/read.
=============== Diff against Morphic-mt.2019 ===============
Item was removed:
- (PackageInfo named: 'Morphic') preamble: '"Turn off Morphic drawing because we are refactoring ActiveWorld, ActiveHand, and ActiveEvent."
- Project current world setProperty: #shouldDisplayWorld toValue: false.'!
Item was removed:
- SystemOrganization addCategory: #'Morphic-Balloon'!
- SystemOrganization addCategory: #'Morphic-Basic'!
- SystemOrganization addCategory: #'Morphic-Basic-NewCurve'!
- SystemOrganization addCategory: #'Morphic-Borders'!
- SystemOrganization addCategory: #'Morphic-Collections-Arrayed'!
- SystemOrganization addCategory: #'Morphic-Demo'!
- SystemOrganization addCategory: #'Morphic-Events'!
- SystemOrganization addCategory: #'Morphic-Explorer'!
- SystemOrganization addCategory: #'Morphic-Kernel'!
- SystemOrganization addCategory: #'Morphic-Layouts'!
- SystemOrganization addCategory: #'Morphic-Menus'!
- SystemOrganization addCategory: #'Morphic-Menus-DockingBar'!
- SystemOrganization addCategory: #'Morphic-Pluggable Widgets'!
- SystemOrganization addCategory: #'Morphic-Sound-Synthesis'!
- SystemOrganization addCategory: #'Morphic-Support'!
- SystemOrganization addCategory: #'Morphic-Text Support'!
- SystemOrganization addCategory: #'Morphic-TrueType'!
- SystemOrganization addCategory: #'Morphic-Widgets'!
- SystemOrganization addCategory: #'Morphic-Windows'!
- SystemOrganization addCategory: #'Morphic-Worlds'!
Item was removed:
- BracketSliderMorph subclass: #AColorSelectorMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !AColorSelectorMorph commentStamp: 'gvc 5/18/2007 13:52' prior: 0!
- ColorComponentSelector showing an alpha gradient over a hatched background.!
Item was removed:
- ----- Method: AColorSelectorMorph>>color: (in category 'accessing') -----
- color: aColor
- "Set the gradient colors."
-
- super color: aColor asNontranslucentColor.
- self fillStyle: self defaultFillStyle!
Item was removed:
- ----- Method: AColorSelectorMorph>>defaultFillStyle (in category 'accessing - ui') -----
- defaultFillStyle
- "Answer the hue gradient."
-
- ^(GradientFillStyle colors: {self color alpha: 0. self color})
- origin: self topLeft;
- direction: (self orientation == #horizontal
- ifTrue: [self width at 0]
- ifFalse: [0 at self height])!
Item was removed:
- ----- Method: AColorSelectorMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- "Draw a hatch pattern first."
- aCanvas
- fillRectangle: self innerBounds
- fillStyle: (InfiniteForm with: ColorPresenterMorph hatchForm).
- super drawOn: aCanvas!
Item was removed:
- ----- Method: AColorSelectorMorph>>fillStyle: (in category 'visual properties') -----
- fillStyle: fillStyle
- "If it is a color then override with gradient."
-
- fillStyle isColor
- ifTrue: [self color: fillStyle]
- ifFalse: [super fillStyle: fillStyle]!
Item was removed:
- ----- Method: AColorSelectorMorph>>initialize (in category 'initialization') -----
- initialize
- "Initialize the receiver."
-
- super initialize.
- self
- value: 1.0;
- color: Color black!
Item was removed:
- ----- Method: AbstractFont>>lineGapForMorphs (in category '*Morphic-Widgets') -----
- lineGapForMorphs
- "Use this hook to control the compactness of Morphic views such as lists, trees, and buttons."
-
- ^ MorphicProject useCompactLists
- ifTrue: [0]
- ifFalse: [self lineGap]!
Item was removed:
- ----- Method: AbstractFont>>lineGapSliceForMorphs (in category '*Morphic-Widgets') -----
- lineGapSliceForMorphs
- "Use this hook to control the compactness of Morphic views such as lists, trees, and buttons."
-
- ^ MorphicProject useCompactLists
- ifTrue: [0]
- ifFalse: [self lineGapSlice]!
Item was removed:
- ----- Method: AbstractFont>>lineGridForMorphs (in category '*Morphic-Widgets') -----
- lineGridForMorphs
- "Use this hook to control the compactness of Morphic views such as lists, trees, and buttons."
-
- ^ MorphicProject useCompactLists
- ifTrue: [self height]
- ifFalse: [self lineGrid]!
Item was removed:
- Model subclass: #AbstractHierarchicalList
- instanceVariableNames: 'currentSelection'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Explorer'!
-
- !AbstractHierarchicalList commentStamp: '<historical>' prior: 0!
- Contributed by Bob Arning as part of the ObjectExplorer package.
- !
Item was removed:
- ----- Method: AbstractHierarchicalList>>genericMenu: (in category 'menus') -----
- genericMenu: aMenu
-
- aMenu add: 'no menu yet' target: self selector: #yourself.
- ^aMenu!
Item was removed:
- ----- Method: AbstractHierarchicalList>>getCurrentSelection (in category 'selection') -----
- getCurrentSelection
-
- ^currentSelection!
Item was removed:
- ----- Method: AbstractHierarchicalList>>noteNewSelection: (in category 'selection') -----
- noteNewSelection: x
-
- currentSelection := x.
- self changed: #getCurrentSelection.
- currentSelection ifNil: [^self].
- currentSelection sendSettingMessageTo: self.
- !
Item was removed:
- ----- Method: AbstractHierarchicalList>>update: (in category 'updating') -----
- update: aSymbol
-
- aSymbol == #hierarchicalList ifTrue: [
- ^self changed: #getList
- ].
- super update: aSymbol!
Item was removed:
- ----- Method: AbstractHierarchicalList>>veryDeepInner: (in category 'copying') -----
- veryDeepInner: aDeepCopier
- "This method required to avoid copying my 'currentSelection'. See Object>>#veryDeepCopyWith:."
- super veryDeepInner: aDeepCopier!
Item was removed:
- Morph subclass: #AbstractResizerMorph
- instanceVariableNames: 'handleColor handleInset lastMouse showHandle'
- classVariableNames: 'GripThickness HandleLength'
- poolDictionaries: ''
- category: 'Morphic-Windows'!
-
- !AbstractResizerMorph commentStamp: 'jmv 1/29/2006 17:15' prior: 0!
- I am the superclass of a hierarchy of morph specialized in allowing the user to resize or rearrange windows and panes.!
Item was removed:
- ----- Method: AbstractResizerMorph class>>gripThickness (in category 'preferences') -----
- gripThickness
- "A number in pixels that encodes the area were the user can target splitters or edge grips."
-
- <preference: 'Grip Thickness'
- categoryList: #(windows Accessibility)
- description: 'A number in pixels that encodes the area were the user can target splitters or edge grips such as in application windows. Bigger grips make it easier to click on them.'
- type: #Number>
-
- ^ ((GripThickness ifNil: [4]) * RealEstateAgent scaleFactor) rounded!
Item was removed:
- ----- Method: AbstractResizerMorph class>>gripThickness: (in category 'preferences') -----
- gripThickness: anInteger
-
- GripThickness := anInteger ifNotNil: [(anInteger / RealEstateAgent scaleFactor) rounded].
- Project current restoreDisplay.
-
- self flag: #todo. "mt: Update existing grips. This is challenging because it interferes with ProportionalLayoutPolicy, which is tricky to refresh from here for arbitrary morphs."!
Item was removed:
- ----- Method: AbstractResizerMorph class>>handleLength (in category 'preferences') -----
- handleLength
-
- <preference: 'Handle Length'
- categoryList: #(windows Accessibility)
- description: 'AThe size of a grip handle if shown. Can be interpreted as width or height, depending of the resizer orientation. Does not affect the clickable area. See grip thickness for that.'
- type: #Number>
-
- ^ ((HandleLength ifNil: [16]) * RealEstateAgent scaleFactor) rounded!
Item was removed:
- ----- Method: AbstractResizerMorph class>>handleLength: (in category 'preferences') -----
- handleLength: anInteger
-
- HandleLength := anInteger ifNotNil: [(anInteger / RealEstateAgent scaleFactor) rounded].
- Project current restoreDisplay.
-
- self flag: #todo. "mt: Update existing grips. This is challenging because it interferes with ProportionalLayoutPolicy, which is tricky to refresh from here for arbitrary morphs."!
Item was removed:
- ----- Method: AbstractResizerMorph>>handleColor (in category 'accessing') -----
- handleColor
- "Either use my handle color if set up or derive the handle color from my owner's color if I have an owner."
-
- ^ (handleColor notNil or: [self owner isNil])
- ifTrue: [handleColor ifNil: [Color black]]
- ifFalse: [(self userInterfaceTheme resizerColorModifier ifNil: [ [:c | c muchDarker] ])
- value: (self owner color isTransparent ifTrue: [Color white] ifFalse: [self owner color]) ]!
Item was removed:
- ----- Method: AbstractResizerMorph>>handleColor: (in category 'accessing') -----
- handleColor: aColor
-
- handleColor := aColor.
- self changed.!
Item was removed:
- ----- Method: AbstractResizerMorph>>handleInset (in category 'accessing') -----
- handleInset
-
- ^ handleInset ifNil: [1]!
Item was removed:
- ----- Method: AbstractResizerMorph>>handleInset: (in category 'accessing') -----
- handleInset: anInteger
-
- handleInset := anInteger.
- self changed.!
Item was removed:
- ----- Method: AbstractResizerMorph>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: anEvent
-
- ^ true!
Item was removed:
- ----- Method: AbstractResizerMorph>>handlesMouseOver: (in category 'event handling') -----
- handlesMouseOver: anEvent
-
- ^ true
- !
Item was removed:
- ----- Method: AbstractResizerMorph>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
- self color: Color transparent!
Item was removed:
- ----- Method: AbstractResizerMorph>>mouseDown: (in category 'event handling') -----
- mouseDown: anEvent
-
- self referencePoint: anEvent position - self position.!
Item was removed:
- ----- Method: AbstractResizerMorph>>mouseEnter: (in category 'event handling') -----
- mouseEnter: anEvent
-
- anEvent hand showTemporaryCursor: self resizeCursor.!
Item was removed:
- ----- Method: AbstractResizerMorph>>mouseLeave: (in category 'event handling') -----
- mouseLeave: anEvent
-
- anEvent hand showTemporaryCursor: nil.!
Item was removed:
- ----- Method: AbstractResizerMorph>>referencePoint (in category 'accessing') -----
- referencePoint
-
- ^ lastMouse!
Item was removed:
- ----- Method: AbstractResizerMorph>>referencePoint: (in category 'accessing') -----
- referencePoint: aPoint
-
- lastMouse := aPoint.!
Item was removed:
- ----- Method: AbstractResizerMorph>>resizeCursor (in category 'accessing') -----
- resizeCursor
- "The cursor shape I will set to the hand on hovering."
-
- self subclassResponsibility.!
Item was removed:
- ----- Method: AbstractResizerMorph>>setDefaultColors (in category 'initialization') -----
- setDefaultColors
-
- "handleColor := Color lightGray lighter lighter.
- dotColor := Color gray lighter"!
Item was removed:
- ----- Method: AbstractResizerMorph>>setInverseColors (in category 'initialization') -----
- setInverseColors
-
- "handleColor := Color lightGray.
- dotColor := Color white"!
Item was removed:
- ----- Method: AbstractResizerMorph>>showHandle (in category 'accessing') -----
- showHandle
-
- ^ showHandle ifNil: [false]!
Item was removed:
- ----- Method: AbstractResizerMorph>>showHandle: (in category 'accessing') -----
- showHandle: aBoolean
-
- showHandle := aBoolean.
- self changed.!
Item was removed:
- ----- Method: AbstractSound class>>updateScorePlayers (in category '*Morphic-Sounds-sound library-file in/out') -----
- updateScorePlayers
- | soundsBeingEdited |
- "Force all ScorePlayers to update their instrument list from the sound library. This may done after loading, unloading, or replacing a sound to make all ScorePlayers feel the change."
-
- ScorePlayer allSubInstancesDo:
- [:p | p pause].
- SoundPlayer shutDown: true.
- soundsBeingEdited := EnvelopeEditorMorph allSubInstances collect: [:ed | ed soundBeingEdited].
- ScorePlayerMorph allSubInstancesDo:
- [:p | p updateInstrumentsFromLibraryExcept: soundsBeingEdited].
- !
Item was removed:
- PluggableTextMorph subclass: #AcceptableCleanTextMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Pluggable Widgets'!
Item was removed:
- ----- Method: AcceptableCleanTextMorph>>accept (in category 'menu commands') -----
- accept
- "Overridden to allow accept of clean text"
-
- | textToAccept ok |
- textToAccept := textMorph text.
- ok := setTextSelector isNil or:
- [setTextSelector numArgs = 2
- ifTrue:
- [model
- perform: setTextSelector
- with: textToAccept
- with: self]
- ifFalse: [model perform: setTextSelector with: textToAccept]].
- ok
- ifTrue:
- [self setText: self getText.
- self hasUnacceptedEdits: false]!
Item was removed:
- DynamicVariable subclass: #ActiveEventVariable
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Worlds'!
-
- !ActiveEventVariable commentStamp: 'mt 11/9/2020 08:50' prior: 0!
- I refer to the event responsible for the current action. Inbetween event handling cycles my value will be last event from the previous cycle, usually a mouse event.
-
- Please talk to me only through #currentEvent, which is understood by all objects.
-
- For more information, see http://wiki.squeak.org/squeak/6647.!
Item was removed:
- ----- Method: ActiveEventVariable class>>default (in category 'accessing') -----
- default
-
- ^ self currentHand ifNotNil: [:hand | hand lastEvent]!
Item was removed:
- ----- Method: ActiveEventVariable class>>value:during: (in category 'accessing') -----
- value: anObject during: aBlock
- "For backword compatibility with 5.3 and earlier, still maintain the original global variable."
-
- | priorEvent |
- priorEvent := self value.
- ActiveEvent := anObject.
- ^ [super value: anObject during: aBlock] ensure: [
- ActiveEvent == anObject ifTrue: [ActiveEvent := priorEvent]]!
Item was removed:
- DynamicVariable subclass: #ActiveHandVariable
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Worlds'!
-
- !ActiveHandVariable commentStamp: 'mt 11/9/2020 08:50' prior: 0!
- I refer to the hand that issued the event responsible for the current action. In a multi-user setup, this hand identifies which user-incarnation invoked the action. Inbetween event handling cycles, my value is equivalent to the current project's primary hand.
-
- Please talk to me only through #currentHand, which is understood by all objects.
-
- For more information, see http://wiki.squeak.org/squeak/6647.!
Item was removed:
- ----- Method: ActiveHandVariable class>>default (in category 'accessing') -----
- default
-
- ^ self currentWorld primaryHand!
Item was removed:
- ----- Method: ActiveHandVariable class>>value:during: (in category 'accessing') -----
- value: anObject during: aBlock
- "For backword compatibility with 5.3 and earlier, still maintain the original global variable."
-
- | priorHand |
- priorHand := self value.
- ActiveHand := anObject.
- ^ [super value: anObject during: aBlock] ensure: [
- ActiveHand == anObject ifTrue: [ActiveHand := priorHand]]!
Item was removed:
- DynamicVariable subclass: #ActiveWorldVariable
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Worlds'!
-
- !ActiveWorldVariable commentStamp: 'mt 11/9/2020 08:49' prior: 0!
- I refer to the world currently in control of handling some event. Usually my value is identical with the current project's world, but for embedded worlds the world will change when event handling reaches the new (inner world) and will be restored when event handling leaves it.
-
- Please talk to me only through #currentWorld, which is understood by all objects.
-
- For more information, see http://wiki.squeak.org/squeak/6647.!
Item was removed:
- ----- Method: ActiveWorldVariable class>>default (in category 'accessing') -----
- default
-
- ^ Project current world!
Item was removed:
- ----- Method: ActiveWorldVariable class>>value:during: (in category 'accessing') -----
- value: anObject during: aBlock
- "For backword compatibility with 5.3 and earlier, still maintain the original global variable."
-
- | priorWorld |
- priorWorld := self value.
- ActiveWorld := anObject.
- ^ [super value: anObject during: aBlock] ensure: [
- ActiveWorld == anObject ifTrue: [ActiveWorld := priorWorld]]!
Item was removed:
- RectangleMorph subclass: #AlignmentMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Basic'!
-
- !AlignmentMorph commentStamp: 'kfr 10/27/2003 10:25' prior: 0!
- Used for layout.
- Since all morphs now support layoutPolicy the main use of this class is no longer needed.
- Kept around for compability.
- Supports a few methods not found elsewhere that can be convenient, eg. newRow
- !
Item was removed:
- ----- Method: AlignmentMorph class>>columnPrototype (in category 'instance creation') -----
- columnPrototype
- "Answer a prototypical column"
-
- | sampleMorphs aColumn |
- sampleMorphs := #(red yellow green) collect:
- [:aColor | Morph new extent: 130 @ 38; color: (Color perform: aColor); setNameTo: aColor asString; yourself].
- aColumn := self inAColumn: sampleMorphs.
- aColumn setNameTo: 'Column'.
- aColumn color: Color veryVeryLightGray.
- aColumn cellGap: 4; layoutInset: 6.
- aColumn enableDragNDrop.
- aColumn setBalloonText: 'Things dropped into here will automatically be organized into a column. Once you have added your own items here, you will want to remove the sample colored rectangles that this started with, and you will want to change this balloon help message to one of your own!!' translated.
- ^ aColumn!
Item was removed:
- ----- Method: AlignmentMorph class>>defaultNameStemForInstances (in category 'scripting') -----
- defaultNameStemForInstances
- "The code just below, now commented out, resulted in every instance of every sublcass of AlignmentMorph being given a default name of the form 'Alignment1', rather than the desired 'MoviePlayer1', 'ScriptEditor2', etc."
-
- "^ 'Alignment'"
-
- ^ super defaultNameStemForInstances!
Item was removed:
- ----- Method: AlignmentMorph class>>inAColumn: (in category 'instance creation') -----
- inAColumn: aCollectionOfMorphs
- "Answer a columnar AlignmentMorph holding the given collection"
-
- | col |
- col := self newColumn
- color: Color transparent;
- vResizing: #shrinkWrap;
- hResizing: #shrinkWrap;
- layoutInset: 1;
- borderColor: Color black;
- borderWidth: 1;
- wrapCentering: #center;
- cellPositioning: #topCenter.
- aCollectionOfMorphs do: [:each | col addMorphBack: each].
- ^ col!
Item was removed:
- ----- Method: AlignmentMorph class>>inARow: (in category 'instance creation') -----
- inARow: aCollectionOfMorphs
- "Answer a row-oriented AlignmentMorph holding the given collection"
-
- | aRow |
- aRow := self newRow
- color: Color transparent;
- vResizing: #shrinkWrap;
- hResizing: #shrinkWrap;
- layoutInset: 1;
- borderColor: Color black;
- borderWidth: 1;
- wrapCentering: #center;
- cellPositioning: #topCenter.
- aCollectionOfMorphs do: [ :each | aRow addMorphBack: each].
- ^ aRow!
Item was removed:
- ----- Method: AlignmentMorph class>>newColumn (in category 'instance creation') -----
- newColumn
-
- ^ self new
- listDirection: #topToBottom;
- hResizing: #spaceFill;
- extent: 1 at 1;
- vResizing: #spaceFill
- !
Item was removed:
- ----- Method: AlignmentMorph class>>newRow (in category 'instance creation') -----
- newRow
-
- ^ self new
- listDirection: #leftToRight;
- hResizing: #spaceFill;
- vResizing: #spaceFill;
- extent: 1 at 1;
- borderWidth: 0
- !
Item was removed:
- ----- Method: AlignmentMorph class>>newSpacer: (in category 'instance creation') -----
- newSpacer: aColor
- "Answer a space-filling instance of me of the given color."
-
- ^ self new
- hResizing: #spaceFill;
- vResizing: #spaceFill;
- layoutInset: 0;
- borderWidth: 0;
- extent: 1 at 1;
- color: aColor.
- !
Item was removed:
- ----- Method: AlignmentMorph class>>newVariableTransparentSpacer (in category 'instance creation') -----
- newVariableTransparentSpacer
- "Answer a space-filling instance of me of the given color."
-
- ^ self new
- hResizing: #spaceFill;
- vResizing: #spaceFill;
- layoutInset: 0;
- borderWidth: 0;
- extent: 1 at 1;
- color: Color transparent
- !
Item was removed:
- ----- Method: AlignmentMorph class>>rowPrototype (in category 'instance creation') -----
- rowPrototype
- "Answer a prototypical row"
-
- | sampleMorphs aRow |
- sampleMorphs := (1 to: (2 + 3 atRandom)) collect:
- [:integer | EllipseMorph new extent: ((60 + (20 atRandom)) @ (80 + ((20 atRandom)))); color: Color random; setNameTo: ('egg', integer asString); yourself].
- aRow := self inARow: sampleMorphs.
- aRow setNameTo: 'Row'.
- aRow enableDragNDrop.
- aRow cellGap: 6.
- aRow layoutInset: 8.
- aRow setBalloonText: 'Things dropped into here will automatically be organized into a row. Once you have added your own items here, you will want to remove the sample colored eggs that this started with, and you will want to change this balloon help message to one of your own!!' translated.
- aRow color: Color veryVeryLightGray.
- ^ aRow
-
- "AlignmentMorph rowPrototype openInHand"!
Item was removed:
- ----- Method: AlignmentMorph>>canHaveFillStyles (in category 'visual properties') -----
- canHaveFillStyles
- "Return true if the receiver can have general fill styles; not just colors.
- This method is for gradually converting old morphs."
-
- ^ self class == AlignmentMorph "no subclasses"!
Item was removed:
- ----- Method: AlignmentMorph>>convertOldAlignmentsNov2000:using: (in category 'object fileIn') -----
- convertOldAlignmentsNov2000: varDict using: smartRefStrm
- "major change - much of AlignmentMorph is now implemented more generally in Morph"
-
- "These are going away
- #('orientation' 'centering' 'hResizing' 'vResizing'
- 'inset' 'minCellSize' 'layoutNeeded' 'priorFullBounds')"
-
- | orientation centering hResizing vResizing inset minCellSize inAlignment |
- orientation := varDict at: 'orientation'.
- centering := varDict at: 'centering'.
- hResizing := varDict at: 'hResizing'.
- vResizing := varDict at: 'vResizing'.
- inset := varDict at: 'inset'.
- minCellSize := varDict at: 'minCellSize'.
- (orientation == #horizontal or: [orientation == #vertical])
- ifTrue: [self layoutPolicy: TableLayout new].
- self cellPositioning: #topLeft.
- self rubberBandCells: true.
- orientation == #horizontal ifTrue: [self listDirection: #leftToRight].
- orientation == #vertical ifTrue: [self listDirection: #topToBottom].
- centering == #topLeft ifTrue: [self wrapCentering: #topLeft].
- centering == #bottomRight ifTrue: [self wrapCentering: #bottomRight].
- centering == #center
- ifTrue:
- [self wrapCentering: #center.
- orientation == #horizontal
- ifTrue: [self cellPositioning: #leftCenter]
- ifFalse: [self cellPositioning: #topCenter]].
- (inset isNumber or: [inset isPoint]) ifTrue: [self layoutInset: inset].
- (minCellSize isNumber or: [minCellSize isPoint])
- ifTrue: [self minCellSize: minCellSize].
- (self hasProperty: #clipToOwnerWidth) ifTrue: [self clipSubmorphs: true].
-
- "now figure out if our owner was an AlignmentMorph, even if it is reshaped..."
- inAlignment := false.
- owner isMorph
- ifTrue: [(owner isAlignmentMorph) ifTrue: [inAlignment := true]]
- ifFalse:
- ["e.g., owner may be reshaped"
-
- (owner class instanceVariablesString
- findString: 'orientation centering hResizing vResizing') > 0
- ifTrue:
- ["this was an alignment morph being reshaped"
-
- inAlignment := true]].
- "And check for containment in system windows"
- owner isSystemWindow ifTrue: [inAlignment := true].
- (hResizing == #spaceFill and: [inAlignment not])
- ifTrue: [self hResizing: #shrinkWrap]
- ifFalse: [self hResizing: hResizing].
- (vResizing == #spaceFill and: [inAlignment not])
- ifTrue: [self vResizing: #shrinkWrap]
- ifFalse: [self vResizing: vResizing]!
Item was removed:
- ----- Method: AlignmentMorph>>convertToCurrentVersion:refStream: (in category 'objects from disk') -----
- convertToCurrentVersion: varDict refStream: smartRefStrm
-
- | newish |
- newish := super convertToCurrentVersion: varDict refStream:
- smartRefStrm.
-
- "major change - much of AlignmentMorph is now implemented
- more generally in Morph"
- varDict at: 'hResizing' ifPresent: [ :x |
- ^ newish convertOldAlignmentsNov2000: varDict using:
- smartRefStrm].
- ^ newish
- !
Item was removed:
- ----- Method: AlignmentMorph>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- "answer the default border width for the receiver"
- ^ 0!
Item was removed:
- ----- Method: AlignmentMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color
- r: 0.8
- g: 1.0
- b: 0.8!
Item was removed:
- ----- Method: AlignmentMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
- self layoutPolicy: TableLayout new;
- listDirection: #leftToRight;
- wrapCentering: #topLeft;
- hResizing: #spaceFill;
- vResizing: #spaceFill;
- layoutInset: 2;
- rubberBandCells: true!
Item was removed:
- ----- Method: AlignmentMorph>>isAlignmentMorph (in category 'classification') -----
- isAlignmentMorph
-
- ^ true
- !
Item was removed:
- ----- Method: AlignmentMorph>>openInWindowLabeled:inWorld: (in category 'initialization') -----
- openInWindowLabeled: aString inWorld: aWorld
-
- self layoutInset: 0.
- ^super openInWindowLabeled: aString inWorld: aWorld.!
Item was removed:
- ----- Method: AlignmentMorph>>wantsKeyboardFocusFor: (in category 'event handling') -----
- wantsKeyboardFocusFor: aSubmorph
- aSubmorph wouldAcceptKeyboardFocus ifTrue: [^ true].
- ^ super wantsKeyboardFocusFor: aSubmorph!
Item was removed:
- ColorMappingCanvas subclass: #AlphaBlendingCanvas
- instanceVariableNames: 'alpha'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Support'!
Item was removed:
- ----- Method: AlphaBlendingCanvas>>alpha (in category 'accessing') -----
- alpha
- ^alpha!
Item was removed:
- ----- Method: AlphaBlendingCanvas>>alpha: (in category 'accessing') -----
- alpha: newAlpha
- alpha := newAlpha.!
Item was removed:
- ----- Method: AlphaBlendingCanvas>>image:at:sourceRect:rule: (in category 'private') -----
- image: aForm at: aPoint sourceRect: sourceRect rule: rule
- "Draw the given form. For the 'paint' combination rule use stenciling otherwise simply fill the source rectangle."
- rule = Form paint ifTrue:[
- ^myCanvas
- image: aForm
- at: aPoint
- sourceRect: sourceRect
- rule: Form paintAlpha
- alpha: alpha.
- ].
- rule = Form over ifTrue:[
- ^myCanvas
- image: aForm
- at: aPoint
- sourceRect: sourceRect
- rule: Form blendAlpha
- alpha: alpha.
- ].!
Item was removed:
- ----- Method: AlphaBlendingCanvas>>mapColor: (in category 'private') -----
- mapColor: aColor
- aColor isColor ifFalse:[^aColor]. "Should not happen but who knows..."
- aColor isTransparent ifTrue:[^aColor].
- aColor isOpaque ifTrue:[^aColor alpha: alpha].
- ^aColor alpha: (aColor alpha * alpha)!
Item was removed:
- ----- Method: AlphaBlendingCanvas>>mapFillStyle: (in category 'private') -----
- mapFillStyle: aFillStyle
-
- ^ self alpha = 1.0
- ifTrue: [aFillStyle]
- ifFalse: [super mapFillStyle: aFillStyle]
- !
Item was removed:
- ----- Method: AlphaBlendingCanvas>>on: (in category 'initialization') -----
- on: aCanvas
- myCanvas := aCanvas.
- alpha := 1.0.!
Item was removed:
- PluggableListMorph subclass: #AlternatePluggableListMorphOfMany
- instanceVariableNames: 'getSelectionListSelector setSelectionListSelector'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Pluggable Widgets'!
-
- !AlternatePluggableListMorphOfMany commentStamp: 'cmm 3/2/2010 14:39' prior: 0!
- This is a multi-select list that is more conventional in its behavior than PluggableListMorphOfMany. It utilizes a shift+click mechanism for selecting ranges, and control+click for toggling individual selections. This list also allows fast mouse swipes without missing any message selections.!
Item was removed:
- ----- Method: AlternatePluggableListMorphOfMany class>>on:list:primarySelection:changePrimarySelection:listSelection:changeListSelection:menu: (in category 'instance creation') -----
- on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel
- ^ self new
- on: anObject
- list: listSel
- primarySelection: getSelectionSel
- changePrimarySelection: setSelectionSel
- listSelection: getListSel
- changeListSelection: setListSel
- menu: getMenuSel
- keystroke: #arrowKey:from: "default"!
Item was removed:
- ----- Method: AlternatePluggableListMorphOfMany class>>on:list:primarySelection:changePrimarySelection:listSelection:changeListSelection:menu:keystroke: (in category 'instance creation') -----
- on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel keystroke: keyActionSel
- ^ self new
- on: anObject
- list: listSel
- primarySelection: getSelectionSel
- changePrimarySelection: setSelectionSel
- listSelection: getListSel
- changeListSelection: setListSel
- menu: getMenuSel
- keystroke: keyActionSel!
Item was removed:
- ----- Method: AlternatePluggableListMorphOfMany>>changeModelSelection: (in category 'model access') -----
- changeModelSelection: anInteger
- "Change the model's selected item index to be anInteger."
-
- ^self
- changeModelSelection: anInteger
- shifted: Sensor shiftPressed
- controlled: Sensor controlKeyPressed
- !
Item was removed:
- ----- Method: AlternatePluggableListMorphOfMany>>changeModelSelection:shifted:controlled: (in category 'model access') -----
- changeModelSelection: anInteger shifted: shiftedBoolean controlled: controlledBoolean
- "Change the model's selected item index to be anInteger."
-
- setIndexSelector ifNotNil:
- [ model
- perform: setIndexSelector
- with: anInteger
- with: shiftedBoolean
- with: controlledBoolean ]
- !
Item was removed:
- ----- Method: AlternatePluggableListMorphOfMany>>hasMultiSelection (in category 'testing') -----
- hasMultiSelection
-
- ^ true!
Item was removed:
- ----- Method: AlternatePluggableListMorphOfMany>>itemSelectedAmongMultiple: (in category 'model access') -----
- itemSelectedAmongMultiple: viewIndex
- ^self listSelectionAt: (self modelIndexFor: viewIndex)!
Item was removed:
- ----- Method: AlternatePluggableListMorphOfMany>>listSelectionAt: (in category 'model access') -----
- listSelectionAt: index
- getSelectionListSelector ifNil:[^false].
- ^model perform: getSelectionListSelector with: index!
Item was removed:
- ----- Method: AlternatePluggableListMorphOfMany>>listSelectionAt:put: (in category 'model access') -----
- listSelectionAt: index put: value
- setSelectionListSelector ifNil:[^false].
- ^model perform: setSelectionListSelector with: index with: value!
Item was removed:
- ----- Method: AlternatePluggableListMorphOfMany>>mouseDown: (in category 'event handling') -----
- mouseDown: event
- | row |
-
- event yellowButtonPressed ifTrue: [^ self yellowButtonActivity: event shiftPressed].
-
- row := self rowAtLocation: event position.
-
- row = 0 ifTrue: [^super mouseDown: event].
-
- model okToChange ifFalse: [^ self]. "No change if model is locked"
-
- "Inform model of selected item and let it toggle."
- self
- changeModelSelection: (self modelIndexFor: row)
- shifted: event shiftPressed
- controlled: event controlKeyPressed.
-
-
- "
- event hand releaseMouseFocus: aMorph.
- submorphs do: [ :each | each changed ]
- "!
Item was removed:
- ----- Method: AlternatePluggableListMorphOfMany>>mouseLeaveDragging: (in category 'event handling') -----
- mouseLeaveDragging: anEvent
- "Dragging means changing the list's multi-selection state. Thus, there is no support for drag-and-drop of elements within a selection."
-
- self hoverRow: nil.
- self resetPotentialDropRow.!
Item was removed:
- ----- Method: AlternatePluggableListMorphOfMany>>mouseMove: (in category 'event handling') -----
- mouseMove: event
- "The mouse has moved, as characterized by the event provided. Adjust the scrollbar, and alter the selection as appropriate"
-
- | oldIndex oldVal row |
- event position y < self top
- ifTrue:
- [scrollBar scrollUp: 1.
- row := self rowAtLocation: scroller topLeft + (1 @ 1)]
- ifFalse:
- [row := event position y > self bottom
- ifTrue:
- [scrollBar scrollDown: 1.
- self rowAtLocation: scroller bottomLeft + (1 @ -1)]
- ifFalse: [ self rowAtLocation: event position]].
- row = 0 ifTrue: [^super mouseDown: event].
-
- model okToChange ifFalse: [^self]. "No change if model is locked"
-
- "Set meaning for subsequent dragging of selection"
- oldIndex := self getCurrentSelectionIndex.
- oldIndex ~= 0 ifTrue: [oldVal := self listSelectionAt: oldIndex].
- "Need to restore the old one, due to how model works, and set new one."
- oldIndex ~= 0 ifTrue: [self listSelectionAt: oldIndex put: oldVal].
-
- "Inform model of selected item and let it toggle."
- self
- changeModelSelection: (self modelIndexFor: row)
- shifted: true
- controlled: true.
- submorphs do: [:each | each changed]!
Item was removed:
- ----- Method: AlternatePluggableListMorphOfMany>>mouseUp: (in category 'event handling') -----
- mouseUp: event
-
- event hand newKeyboardFocus: self.
- hasFocus := true.
- Cursor normal show.!
Item was removed:
- ----- Method: AlternatePluggableListMorphOfMany>>on:list:primarySelection:changePrimarySelection:listSelection:changeListSelection:menu:keystroke: (in category 'initialization') -----
- on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel keystroke: keyActionSel
- "setup a whole load of pluggability options"
-
- getSelectionListSelector := getListSel.
- setSelectionListSelector := setListSel.
- self
- on: anObject
- list: listSel
- selected: getSelectionSel
- changeSelected: setSelectionSel
- menu: getMenuSel
- keystroke: keyActionSel!
Item was removed:
- ----- Method: AlternatePluggableListMorphOfMany>>update: (in category 'updating') -----
- update: aSymbol
-
- aSymbol == #allSelections ifTrue: [
- "Convenient - yet hard-coded - way to refresh all selections."
- super update: getIndexSelector.
- ^ self changed].
- aSymbol == getSelectionListSelector ifTrue: [
- ^ self changed].
-
- super update: aSymbol.!
Item was removed:
- ImageMorph subclass: #AnimatedImageMorph
- instanceVariableNames: 'images delays stepTime imageIndex disposals'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Basic'!
-
- !AnimatedImageMorph commentStamp: 'EG 12/4/2021 12:33' prior: 0!
- I am an ImageMorph that can hold more than one image. Each image has its own delay time. I am most commonly created using GIFReaderWriter when it contains multiple images/frames.!
Item was removed:
- ----- Method: AnimatedImageMorph class>>fileReaderServicesForFile:suffix: (in category 'fileIn/Out') -----
- fileReaderServicesForFile: fullName suffix: suffix
-
- ^((GIFReadWriter typicalFileExtensions asSet
- add: '*'; add: 'form'; yourself)
- includes: suffix)
- ifTrue: [ self services ]
- ifFalse: [#()]
- !
Item was removed:
- ----- Method: AnimatedImageMorph class>>fromGIFFileNamed: (in category 'instance creation') -----
- fromGIFFileNamed: fileName
- | reader |
- reader := GIFReadWriter formsFromFileNamed: fileName.
- ^reader forms size = 1
- ifTrue: [ ImageMorph new image: reader forms first ]
- ifFalse: [ self new fromGIFReader: reader ]!
Item was removed:
- ----- Method: AnimatedImageMorph class>>fromStream: (in category 'instance creation') -----
- fromStream: aStream
- | reader |
- reader := GIFReadWriter formsFromStream: aStream.
- ^reader forms size = 1
- ifTrue: [ ImageMorph new image: reader forms first ]
- ifFalse: [ self new fromGIFReader: reader ]!
Item was removed:
- ----- Method: AnimatedImageMorph class>>fromUrl: (in category 'instance creation') -----
- fromUrl: aUrl
-
- ^ self new fromUrl: aUrl!
Item was removed:
- ----- Method: AnimatedImageMorph class>>initialize (in category 'class initialization') -----
- initialize
- "register the receiver in the global registries"
- self environment
- at: #FileServices
- ifPresent: [:cl | cl registerFileReader: self]!
Item was removed:
- ----- Method: AnimatedImageMorph class>>openGIFInWindow: (in category 'instance creation') -----
- openGIFInWindow: aStream
- ^(self fromStream: aStream binary) openInWorld!
Item was removed:
- ----- Method: AnimatedImageMorph class>>serviceOpenGIFInWindow (in category 'fileIn/Out') -----
- serviceOpenGIFInWindow
- "Answer a service for opening a gif graphic in a window"
- ^ (SimpleServiceEntry
- provider: self
- label: 'open GIF graphic as a morph'
- selector: #openGIFInWindow:
- description: 'open a (possibly animated) GIF graphic file as a morph'
- buttonLabel: 'open')
- argumentGetter: [:fileList | fileList readOnlyStream]!
Item was removed:
- ----- Method: AnimatedImageMorph class>>services (in category 'fileIn/Out') -----
- services
- ^ Array
- with: self serviceOpenGIFInWindow
- "with: Form serviceImageImports"
- with: Form serviceImageAsBackground!
Item was removed:
- ----- Method: AnimatedImageMorph class>>unload (in category 'class initialization') -----
- unload
- "Unload the receiver from global registries"
- self environment
- at: #FileServices
- ifPresent: [:cl | cl unregisterFileReader: self]!
Item was removed:
- ----- Method: AnimatedImageMorph>>addCustomMenuItems:hand: (in category 'stepping and presenter') -----
- addCustomMenuItems: aMenu hand: aHand
- super addCustomMenuItems: aMenu hand: aHand.
- aMenu addUpdating: #steppingString action: #toggleStepping!
Item was removed:
- ----- Method: AnimatedImageMorph>>delays (in category 'accessing') -----
- delays
-
- ^ delays!
Item was removed:
- ----- Method: AnimatedImageMorph>>fromFrames: (in category 'initialization') -----
- fromFrames: aFrameCollection
- "Initialize this morph from a colleciton of
- AnimatedImageFrames"
- delays := OrderedCollection new.
- disposals := OrderedCollection new.
- images := OrderedCollection new.
- aFrameCollection do: [ :frame |
- delays add: frame delay.
- disposals add: frame disposal.
- images add: frame form ].!
Item was removed:
- ----- Method: AnimatedImageMorph>>fromGIFFileNamed: (in category 'private') -----
- fromGIFFileNamed: fileName
- self fromReader: (GIFReadWriter formsFromFileNamed: fileName)!
Item was removed:
- ----- Method: AnimatedImageMorph>>fromGIFReader: (in category 'initialization') -----
- fromGIFReader: aGIFReader
- self
- fromFrames: aGIFReader frames;
- color: aGIFReader backgroundColor;
- width: aGIFReader canvasWidth;
- height: aGIFReader canvasHeight.
-
- "Set the current active image form to
- a form that is the same dimensions as this morph"
- self image: ((FormCanvas extent: (aGIFReader canvasWidth)@(aGIFReader canvasHeight))
- fillColor: self color;
- drawImage: images first
- at: images first offset;
- form)!
Item was removed:
- ----- Method: AnimatedImageMorph>>fromImages: (in category 'private') -----
- fromImages: anArray
- images := anArray.
- self setUniformDelay: 10.
- imageIndex := 0
- !
Item was removed:
- ----- Method: AnimatedImageMorph>>fromImages:delay: (in category 'private') -----
- fromImages: anArray delay: anInteger
- images := anArray.
- self setUniformDelay: anInteger.!
Item was removed:
- ----- Method: AnimatedImageMorph>>fromReader: (in category 'private') -----
- fromReader: reader
- images := reader forms.
- delays := reader delays.
- (images anySatisfy:[:each|(each colors includes: Color transparent)]) ifTrue:[self isOpaque: true].
- self reset.!
Item was removed:
- ----- Method: AnimatedImageMorph>>fromStream: (in category 'private') -----
- fromStream: aStream
- self fromGIFReader: (GIFReadWriter formsFromStream: aStream)!
Item was removed:
- ----- Method: AnimatedImageMorph>>fromUrl: (in category 'initialization') -----
- fromUrl: aUrl
-
- | client response |
- client := self environment classNamed: #WebClient.
- self flag: #todo. "mt: Use AppRegistry to download stuff from the Internet."
- client ifNil: [ self error: 'No WebClient installed' ].
- response := client httpGet: aUrl.
- (response code = 200) not ifTrue: [ self error: 'Bad URL or response' ].
- ((response headerAt: 'Content-Type') = 'image/gif') not
- ifTrue: [ self error: 'Url does not respond with a gif, but a ', (response headerAt: 'Content-Type')].
- ^ self fromStream: response content asByteArray readStream.!
Item was removed:
- ----- Method: AnimatedImageMorph>>images (in category 'private') -----
- images
- ^images!
Item was removed:
- ----- Method: AnimatedImageMorph>>images: (in category 'accessing') -----
- images: aCollectionOfForms
- images := aCollectionOfForms!
Item was removed:
- ----- Method: AnimatedImageMorph>>initialize (in category 'private') -----
- initialize
- imageIndex := 1.
- stepTime := 10.
- super initialize!
Item was removed:
- ----- Method: AnimatedImageMorph>>reset (in category 'private') -----
- reset
- imageIndex := 1.
- self image: (Form extent: self maxImagesExtent depth: 32).!
Item was removed:
- ----- Method: AnimatedImageMorph>>setStepping: (in category 'stepping and presenter') -----
- setStepping: aBoolean
- self wantsSteps ifFalse:[^false].
- aBoolean ifTrue:[self startStepping]
- ifFalse:[self stopStepping].!
Item was removed:
- ----- Method: AnimatedImageMorph>>setUniformDelay: (in category 'private') -----
- setUniformDelay: anInteger
- "set delay to a uniform value for all images"
- delays := Array new: images size withAll: anInteger.!
Item was removed:
- ----- Method: AnimatedImageMorph>>step (in category 'stepping and presenter') -----
- step
- | disposal canvas current |
- "If we are about to go beyond the number of images,
- then loop back to the first one"
- ((imageIndex) >= images size)
- ifTrue: [ imageIndex := 1 ]
- ifFalse: [ imageIndex := imageIndex + 1 ].
-
- current := images at: imageIndex.
-
- "If this is the first image in the sequence, we don't
- have a previous disposal to look at. So just paint
- the image -- equiv to #leaveCurrent"
- canvas := image getCanvas.
- (imageIndex == 1)
- ifTrue: [
- image getCanvas drawImage: current at: current offset ]
- ifFalse: [
- "Otherwise, we need to look at the previous image's disposal method
- to see if we should restore the background"
- disposal := disposals at: imageIndex - 1.
- (disposal == #restoreBackground)
- ifTrue: [
- "canvas
- fillRectangle: self bounds
- color: self color"
- canvas := (Form extent: canvas extent depth: 32) getCanvas.
- canvas fillRectangle: ((current offset) corner: (current offset + current extent)) color: self color.
- canvas drawImage: current at: current offset ]
- ifFalse: [ canvas paintImage: current at: current offset ]
- ].
- self image: canvas form.
- self stepTime: (delays at: imageIndex)!
Item was removed:
- ----- Method: AnimatedImageMorph>>stepTime (in category 'stepping and presenter') -----
- stepTime
- ^stepTime ifNil: [super stepTime]!
Item was removed:
- ----- Method: AnimatedImageMorph>>stepTime: (in category 'stepping and presenter') -----
- stepTime: anInteger
- stepTime := anInteger!
Item was removed:
- ----- Method: AnimatedImageMorph>>steppingString (in category 'stepping and presenter') -----
- steppingString
- ^ (self isStepping
- ifTrue: ['<on>']
- ifFalse: ['<off>']), 'stepping' translated!
Item was removed:
- ----- Method: AnimatedImageMorph>>toggleStepping (in category 'stepping and presenter') -----
- toggleStepping
- self wantsSteps
- ifTrue: [
- self isStepping
- ifFalse: [self startStepping]
- ifTrue: [self stopStepping]]!
Item was removed:
- ----- Method: AnimatedImageMorph>>wantsSteps (in category 'stepping and presenter') -----
- wantsSteps
- ^(images size > 1)
- !
Item was removed:
- FormCanvas subclass: #BalloonCanvas
- instanceVariableNames: 'transform colorTransform engine aaLevel deferred'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Balloon'!
-
- !BalloonCanvas commentStamp: '<historical>' prior: 0!
- BalloonCanvas is a canvas using the BalloonEngine for drawing wherever possible. It has various methods which other canvases do not support due to the extra features of the balloon engine.!
Item was removed:
- ----- Method: BalloonCanvas>>aaLevel (in category 'accessing') -----
- aaLevel
- ^aaLevel!
Item was removed:
- ----- Method: BalloonCanvas>>aaLevel: (in category 'accessing') -----
- aaLevel: newLevel
- "Only allow changes to aaLevel if we're working on >= 8 bit forms"
- form depth >= 8 ifFalse:[^self].
- aaLevel = newLevel ifTrue:[^self].
- self flush. "In case there are pending primitives in the engine"
- aaLevel := newLevel.
- engine ifNotNil:[engine aaLevel: aaLevel].!
Item was removed:
- ----- Method: BalloonCanvas>>asBalloonCanvas (in category 'converting') -----
- asBalloonCanvas
- ^self!
Item was removed:
- ----- Method: BalloonCanvas>>colorTransformBy: (in category 'transforming') -----
- colorTransformBy: aColorTransform
- aColorTransform ifNil:[^self].
- colorTransform
- ifNil:[colorTransform := aColorTransform]
- ifNotNil:[colorTransform := colorTransform composedWithLocal: aColorTransform]!
Item was removed:
- ----- Method: BalloonCanvas>>copy (in category 'copying') -----
- copy
-
- self flush.
- ^super copy!
Item was removed:
- ----- Method: BalloonCanvas>>deferred (in category 'accessing') -----
- deferred
- ^deferred!
Item was removed:
- ----- Method: BalloonCanvas>>deferred: (in category 'accessing') -----
- deferred: aBoolean
- deferred == aBoolean ifTrue:[^self].
- self flush. "Force pending prims on screen"
- deferred := aBoolean.
- engine ifNotNil:[engine deferred: aBoolean].!
Item was removed:
- ----- Method: BalloonCanvas>>drawBezier3Shape:color:borderWidth:borderColor: (in category 'balloon drawing') -----
- drawBezier3Shape: vertices color: c borderWidth: borderWidth borderColor:
- borderColor
- self drawBezierShape: (Bezier3Segment convertBezier3ToBezier2:
- vertices) color: c borderWidth: borderWidth borderColor: borderColor!
Item was removed:
- ----- Method: BalloonCanvas>>drawBezierShape:color:borderWidth:borderColor: (in category 'balloon drawing') -----
- drawBezierShape: vertices color: c borderWidth: borderWidth borderColor: borderColor
- "Draw a boundary shape that is defined by a list of vertices.
- Each three subsequent vertices define a quadratic bezier segment.
- For lines, the control point should be set to either the start or the end
- of the bezier curve."
- | fillC borderC |
- fillC := self shadowColor ifNil:[c].
- borderC := self shadowColor ifNil:[borderColor].
- self ensuredEngine
- drawBezierShape: vertices
- fill: fillC
- borderWidth: borderWidth
- borderColor: borderC
- transform: transform.!
Item was removed:
- ----- Method: BalloonCanvas>>drawCompressedShape: (in category 'balloon drawing') -----
- drawCompressedShape: compressedShape
- "Draw a compressed shape"
- self ensuredEngine
- drawCompressedShape: compressedShape
- transform: transform.!
Item was removed:
- ----- Method: BalloonCanvas>>drawGeneralBezier3Shape:color:borderWidth:borderColor: (in category 'balloon drawing') -----
- drawGeneralBezier3Shape: contours color: c borderWidth: borderWidth
- borderColor: borderColor
- | b2 |
- b2 := contours collect: [:b3 | Bezier3Segment
- convertBezier3ToBezier2: b3 ].
- self drawGeneralBezierShape: b2 color: c borderWidth: borderWidth
- borderColor: borderColor!
Item was removed:
- ----- Method: BalloonCanvas>>drawGeneralBezierShape:color:borderWidth:borderColor: (in category 'balloon drawing') -----
- drawGeneralBezierShape: contours color: c borderWidth: borderWidth borderColor: borderColor
- "Draw a general boundary shape (e.g., possibly containing holes)"
- | fillC borderC |
- fillC := self shadowColor ifNil:[c].
- borderC := self shadowColor ifNil:[borderColor].
- self ensuredEngine
- drawGeneralBezierShape: contours
- fill: fillC
- borderWidth: borderWidth
- borderColor: borderC
- transform: transform.!
Item was removed:
- ----- Method: BalloonCanvas>>drawGeneralPolygon:color:borderWidth:borderColor: (in category 'balloon drawing') -----
- drawGeneralPolygon: contours color: c borderWidth: borderWidth borderColor: borderColor
- "Draw a general polygon (e.g., a polygon that can contain holes)"
- | fillC borderC |
- fillC := self shadowColor ifNil:[c].
- borderC := self shadowColor ifNil:[borderColor].
- self ensuredEngine
- drawGeneralPolygon: contours
- fill: fillC
- borderWidth: borderWidth
- borderColor: borderC
- transform: transform.!
Item was removed:
- ----- Method: BalloonCanvas>>drawOval:color:borderWidth:borderColor: (in category 'balloon drawing') -----
- drawOval: r color: c borderWidth: borderWidth borderColor: borderColor
- "Draw the oval defined by the given rectangle"
- | fillC borderC |
- fillC := self shadowColor ifNil:[c].
- borderC := self shadowColor ifNil:[borderColor].
- self ensuredEngine
- drawOval: r
- fill: fillC
- borderWidth: borderWidth
- borderColor: borderC
- transform: transform.!
Item was removed:
- ----- Method: BalloonCanvas>>drawPolygon:fillStyle: (in category 'drawing-polygons') -----
- drawPolygon: vertices fillStyle: aFillStyle
- "Fill the given polygon."
- self drawPolygon: vertices fillStyle: aFillStyle borderWidth: 0 borderColor: nil!
Item was removed:
- ----- Method: BalloonCanvas>>drawPolygon:fillStyle:borderWidth:borderColor: (in category 'drawing-polygons') -----
- drawPolygon: vertices fillStyle: aFillStyle borderWidth: borderWidth borderColor: borderColor
- "Draw a simple polygon defined by the list of vertices."
- | fillC borderC |
- vertices ifEmpty: [ ^ self ].
- fillC := self shadowColor ifNil:[aFillStyle].
- borderC := self shadowColor ifNil:[borderColor].
- self ensuredEngine
- drawPolygon: (vertices copyWith: vertices first)
- fill: fillC
- borderWidth: borderWidth
- borderColor: borderC
- transform: transform.!
Item was removed:
- ----- Method: BalloonCanvas>>drawRectangle:color:borderWidth:borderColor: (in category 'balloon drawing') -----
- drawRectangle: r color: c borderWidth: borderWidth borderColor: borderColor
- "Draw a rectangle"
- | fillC borderC |
- fillC := self shadowColor ifNil:[c].
- borderC := self shadowColor ifNil:[borderColor].
- self ensuredEngine
- drawRectangle: r
- fill: fillC
- borderWidth: borderWidth
- borderColor: borderC
- transform: transform.!
Item was removed:
- ----- Method: BalloonCanvas>>drawString:from:to:in:font:color: (in category 'TODO') -----
- drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c
- (self ifNoTransformWithIn: boundsRect)
- ifTrue:[^super drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c]!
Item was removed:
- ----- Method: BalloonCanvas>>ensuredEngine (in category 'accessing') -----
- ensuredEngine
- engine ifNil:[
- engine := BalloonEngine new.
- "engine := BalloonDebugEngine new"
- engine aaLevel: aaLevel.
- engine bitBlt: port.
- engine destOffset: origin.
- engine clipRect: clipRect.
- engine deferred: deferred.
- engine].
- engine colorTransform: colorTransform.
- engine edgeTransform: transform.
- ^engine!
Item was removed:
- ----- Method: BalloonCanvas>>fillColor: (in category 'drawing') -----
- fillColor: c
- "Note: This always fills, even if the color is transparent."
- "Note2: To achieve the above we must make sure that c is NOT transparent"
- self frameAndFillRectangle: form boundingBox
- fillColor: (c alpha: 1.0)
- borderWidth: 0
- borderColor: nil!
Item was removed:
- ----- Method: BalloonCanvas>>fillOval:color:borderWidth:borderColor: (in category 'drawing') -----
- fillOval: r color: c borderWidth: borderWidth borderColor: borderColor
- "Draw a filled and outlined oval"
- "Note: The optimization test below should actually read:
- self ifNoTransformWithIn: (r insetBy: borderWidth // 2)
- but since borderWidth is assumed to be very small related to r we don't check it."
-
- (self ifNoTransformWithIn: r)
- ifTrue:[^super fillOval: r color: c borderWidth: borderWidth borderColor: borderColor].
-
- ^self drawOval: (r insetBy: borderWidth // 2)
- color: c
- borderWidth: borderWidth
- borderColor: borderColor!
Item was removed:
- ----- Method: BalloonCanvas>>fillOval:fillStyle:borderWidth:borderColor: (in category 'drawing-ovals') -----
- fillOval: aRectangle fillStyle: aFillStyle borderWidth: bw borderColor: bc
- "Fill the given rectangle."
- ^self drawOval: (aRectangle insetBy: bw // 2)
- color: aFillStyle "@@: Name confusion!!!!!!"
- borderWidth: bw
- borderColor: bc
- !
Item was removed:
- ----- Method: BalloonCanvas>>fillRectangle:color: (in category 'drawing') -----
- fillRectangle: r color: c
- "Fill the rectangle with the given color"
- ^self frameAndFillRectangle: r
- fillColor: c
- borderWidth: 0
- borderColor: nil!
Item was removed:
- ----- Method: BalloonCanvas>>fillRectangle:fillStyle: (in category 'drawing-rectangles') -----
- fillRectangle: aRectangle fillStyle: aFillStyle
- "Fill the given rectangle."
- ^self drawRectangle: aRectangle
- color: aFillStyle "@@: Name confusion!!!!!!"
- borderWidth: 0
- borderColor: nil
- !
Item was removed:
- ----- Method: BalloonCanvas>>fillRoundRect:radius:fillStyle: (in category 'drawing-rectangles') -----
- fillRoundRect: aRectangle radius: radius fillStyle: fillStyle
- | points |
- radius asPoint <= (0 at 0)
- ifTrue:[^self fillRectangle: aRectangle fillStyle: fillStyle].
- (radius * 2) asPoint >= aRectangle extent
- ifTrue:[^self fillOval: aRectangle fillStyle: fillStyle].
- "decompose aRectangle into bezier form"
- points := self makeRoundRectShape: aRectangle radius: radius.
- "blast the bezier shape out"
- self
- drawBezierShape: points
- color: fillStyle
- borderWidth: 0
- borderColor: nil.
- !
Item was removed:
- ----- Method: BalloonCanvas>>flush (in category 'initialize') -----
- flush
- "Force all pending primitives onscreen"
- engine ifNotNil:[engine flush].!
Item was removed:
- ----- Method: BalloonCanvas>>frameAndFillRectangle:fillColor:borderWidth:borderColor: (in category 'drawing') -----
- frameAndFillRectangle: r fillColor: c borderWidth: borderWidth borderColor: borderColor
- "Draw a filled and outlined rectangle"
- "Note: The optimization test below should actually read:
- self ifNoTransformWithIn: (r insetBy: borderWidth // 2)
- but since borderWidth is assumed to be very small related to r we don't check it."
-
- (self ifNoTransformWithIn: r)
- ifTrue:[^super frameAndFillRectangle: r fillColor: c borderWidth: borderWidth borderColor: borderColor].
-
- ^self drawRectangle: (r insetBy: borderWidth // 2)
- color: c
- borderWidth: borderWidth
- borderColor: borderColor!
Item was removed:
- ----- Method: BalloonCanvas>>frameAndFillRectangle:fillColor:borderWidth:topLeftColor:bottomRightColor: (in category 'drawing') -----
- frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth topLeftColor: topLeftColor bottomRightColor: bottomRightColor
- "Draw a beveled or raised rectangle"
- | bw |
-
- "Note: The optimization test below should actually read:
- self ifNoTransformWithIn: (r insetBy: borderWidth // 2)
- but since borderWidth is assumed to be very small related to r we don't check it."
-
- (self ifNoTransformWithIn: r)
- ifTrue:[^super frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth topLeftColor: topLeftColor bottomRightColor: bottomRightColor].
-
- "Fill rectangle and draw top and left border"
- bw := borderWidth // 2.
- self drawRectangle: (r insetBy: bw)
- color: fillColor
- borderWidth: borderWidth
- borderColor: topLeftColor.
- "Now draw bottom right border."
- self drawPolygon: (Array with: r topRight + (bw negated at bw)
- with: r bottomRight - bw asPoint
- with: r bottomLeft + (bw at bw negated))
- color: nil
- borderWidth: borderWidth
- borderColor: bottomRightColor.!
Item was removed:
- ----- Method: BalloonCanvas>>frameRectangle:width:color: (in category 'drawing') -----
- frameRectangle: r width: w color: c
- "Draw a frame around the given rectangle"
- ^self frameAndFillRectangle: r
- fillColor: Color transparent
- borderWidth: w
- borderColor: c!
Item was removed:
- ----- Method: BalloonCanvas>>frameRoundRect:radius:width:color: (in category 'drawing-rectangles') -----
- frameRoundRect: aRectangle radius: radius width: borderWidth color: borderColor
- | outerPoints innerRect innerRadius innerPoints |
- (borderWidth isZero or:[borderColor isTransparent])
- ifTrue:[^self].
- radius asPoint <= (0 at 0)
- ifTrue:[^self frameRectangle: aRectangle width: borderWidth color: borderColor].
- "decompose inner rectangle into bezier shape"
- innerRect := aRectangle insetBy: borderWidth.
- innerRect area <= 0
- ifTrue:[^self fillRoundRect: aRectangle radius: radius fillStyle: borderColor].
- innerRadius := (radius - borderWidth) asPoint.
- innerPoints := self makeRoundRectShape: innerRect radius: innerRadius.
- "decompose outer rectangle into bezier shape"
- outerPoints := self makeRoundRectShape: aRectangle radius: radius.
- self
- drawGeneralBezierShape: (Array with: outerPoints with: innerPoints)
- color: borderColor
- borderWidth: 0
- borderColor: nil.!
Item was removed:
- ----- Method: BalloonCanvas>>ifNoTransformWithIn: (in category 'private') -----
- ifNoTransformWithIn: box
- "Return true if the current transformation does not affect the given bounding box"
- | delta |
- transform ifNil: [^true].
- delta := (transform localPointToGlobal: box origin) - box origin.
- ^(transform localPointToGlobal: box corner) - box corner = delta!
Item was removed:
- ----- Method: BalloonCanvas>>image:at:sourceRect:rule: (in category 'private') -----
- image: aForm at: aPoint sourceRect: sourceRect rule: rule
- | warp dstRect srcQuad dstOffset center |
- (self ifNoTransformWithIn: sourceRect) & false
- ifTrue:[^super image: aForm at: aPoint sourceRect: sourceRect rule: rule].
- dstRect := (transform localBoundsToGlobal: (aForm boundingBox translateBy: aPoint)).
- dstOffset := 0 at 0. "dstRect origin."
- "dstRect := 0 at 0 corner: dstRect extent."
- center := 0 at 0."transform globalPointToLocal: dstRect origin."
- srcQuad := transform globalPointsToLocal: (dstRect innerCorners).
- srcQuad := srcQuad collect:[:pt| pt - aPoint].
- warp := (WarpBlt toForm: form)
- sourceForm: aForm;
- cellSize: 2; "installs a new colormap if cellSize > 1"
- combinationRule: Form over.
- warp copyQuad: srcQuad toRect: (dstRect translateBy: dstOffset).
-
- self frameRectangle: (aForm boundingBox translateBy: aPoint) color: Color green.
-
- "... TODO ... create a bitmap fill style from the form and use it for a simple rectangle."!
Item was removed:
- ----- Method: BalloonCanvas>>initialize (in category 'initialize') -----
- initialize
- super initialize.
- aaLevel := 1.
- deferred := false.!
Item was removed:
- ----- Method: BalloonCanvas>>isBalloonCanvas (in category 'testing') -----
- isBalloonCanvas
- ^true!
Item was removed:
- ----- Method: BalloonCanvas>>isVisible: (in category 'testing') -----
- isVisible: aRectangle
- ^transform
- ifNil:[super isVisible: aRectangle]
- ifNotNil:[super isVisible: (transform localBoundsToGlobal: aRectangle)]!
Item was removed:
- ----- Method: BalloonCanvas>>line:to:brushForm: (in category 'TODO') -----
- line: point1 to: point2 brushForm: brush
- "Who's gonna use this?"
- | pt1 pt2 |
- self flush. "Sorry, but necessary..."
- transform
- ifNil:[pt1 := point1. pt2 := point2]
- ifNotNil:[pt1 := transform localPointToGlobal: point1.
- pt2 := transform localPointToGlobal: point2].
- ^super line: pt1 to: pt2 brushForm: brush!
Item was removed:
- ----- Method: BalloonCanvas>>line:to:width:color: (in category 'drawing') -----
- line: pt1 to: pt2 width: w color: c
- "Draw a line from pt1 to: pt2"
-
- (aaLevel = 1 and: [self ifNoTransformWithIn:(pt1 rect: pt2)])
- ifTrue:[^super line: pt1 to: pt2 width: w color: c].
- ^self drawPolygon: (Array with: pt1 with: pt2)
- color: c
- borderWidth: w
- borderColor: c!
Item was removed:
- ----- Method: BalloonCanvas>>makeRoundRectShape:radius: (in category 'private') -----
- makeRoundRectShape: aRectangle radius: radius
- "decompose a rounded rectangle into bezier form"
- | ovalDiameter rectExtent segments points endPoint seg idx offset rectOffset |
- ovalDiameter := (radius * 2) asPoint min: aRectangle extent.
- (ovalDiameter x <= 0 or: [ovalDiameter y <= 0]) ifTrue: [
- "degenerates into rectangle - just hand back four lines"
- | topLeft topRight bottomLeft bottomRight |
- topLeft := aRectangle topLeft.
- topRight := aRectangle topRight.
- bottomLeft := aRectangle bottomLeft.
- bottomRight := aRectangle bottomRight.
-
- points := Array new: 4 * 3.
- points at: 1 put: topLeft.
- points at: 2 put: topLeft.
- points at: 3 put: topRight.
-
- points at: 4 put: topRight.
- points at: 5 put: topRight.
- points at: 6 put: bottomRight.
-
- points at: 7 put: bottomRight.
- points at: 8 put: bottomRight.
- points at: 9 put: bottomLeft.
-
- points at: 10 put: bottomLeft.
- points at: 11 put: bottomLeft.
- points at: 12 put: topLeft.
- ^points
- ].
- rectExtent := aRectangle extent - ovalDiameter.
- rectOffset := aRectangle origin.
- segments := Bezier2Segment makeEllipseSegments: (0 @ 0 extent: ovalDiameter).
- "patch up the segments to include lines connecting the oval parts.
- we need: 8*3 points for the oval parts + 4*3 points for the connecting lines"
- points := Array new: 12 * 3.
- idx := 0.
- "Tweaked offsets to clean up curves. MAD"
- endPoint := segments last end + rectOffset + (0 @ -1).
- 1 to: 8 by: 2 do: [:i |
- i = 1 ifTrue: [offset := rectOffset + (rectExtent x @ 0) + (1 @ -1)]. "top, tr"
- i = 3 ifTrue: [offset := rectOffset + rectExtent + (1 @ 1)]. "right, br"
- i = 5 ifTrue: [offset := rectOffset + (0 @ rectExtent y) + (0 @ 1)]. "bottom, bl"
- i = 7 ifTrue: [offset := rectOffset + (0 @ -1)]."left, tl"
- seg := segments at: i.
- "insert a line segment for the horizontal part of the round rect"
- points at: (idx := idx + 1) put: endPoint.
- points at: (idx := idx + 1) put: endPoint.
- points at: (idx := idx + 1) put: seg start + offset.
- "now the first half-arc"
- points at: (idx := idx + 1) put: seg start + offset.
- points at: (idx := idx + 1) put: seg via + offset.
- points at: (idx := idx + 1) put: seg end + offset.
- "the second half-arc"
- seg := segments at: i + 1.
- points at: (idx := idx + 1) put: seg start + offset.
- points at: (idx := idx + 1) put: seg via + offset.
- points at: (idx := idx + 1) put: seg end + offset.
- endPoint := seg end + offset.
- ].
- ^points!
Item was removed:
- ----- Method: BalloonCanvas>>paragraph:bounds:color: (in category 'TODO') -----
- paragraph: para bounds: bounds color: c
- (self ifNoTransformWithIn: bounds)
- ifTrue:[^super paragraph: para bounds: bounds color: c].!
Item was removed:
- ----- Method: BalloonCanvas>>point:color: (in category 'drawing') -----
- point: pt color: c
- "Is there any use for this?"
- | myPt |
- transform
- ifNil:[myPt := pt]
- ifNotNil:[myPt := transform localPointToGlobal: pt].
- ^super point: myPt color: c!
Item was removed:
- ----- Method: BalloonCanvas>>postCopy (in category 'copying') -----
- postCopy
-
- super postCopy.
- ^self resetEngine!
Item was removed:
- ----- Method: BalloonCanvas>>preserveStateDuring: (in category 'transforming') -----
- preserveStateDuring: aBlock
- | state result |
- state := BalloonState new.
- state transform: transform.
- state colorTransform: colorTransform.
- state aaLevel: self aaLevel.
- result := aBlock value: self.
- transform := state transform.
- colorTransform := state colorTransform.
- self aaLevel: state aaLevel.
- ^result!
Item was removed:
- ----- Method: BalloonCanvas>>resetEngine (in category 'initialize') -----
- resetEngine
- engine := nil.!
Item was removed:
- ----- Method: BalloonCanvas>>transformBy: (in category 'transforming') -----
- transformBy: aTransform
- aTransform ifNil:[^self].
- transform
- ifNil:[transform := aTransform]
- ifNotNil:[transform := transform composedWithLocal: aTransform]!
Item was removed:
- ----- Method: BalloonCanvas>>transformBy:during: (in category 'transforming') -----
- transformBy: aDisplayTransform during: aBlock
- | myTransform result |
- myTransform := transform.
- self transformBy: aDisplayTransform.
- result := aBlock value: self.
- transform := myTransform.
- ^result!
Item was removed:
- PolygonMorph subclass: #BalloonMorph
- instanceVariableNames: 'target offsetFromTarget balloonOwner'
- classVariableNames: 'BalloonColor BalloonFont'
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !BalloonMorph commentStamp: '<historical>' prior: 0!
- A balloon with text used for the display of explanatory information.
-
- Balloon help is integrated into Morphic as follows:
- If a Morph has the property #balloonText, then it will respond to #showBalloon by adding a text balloon to the world, and to #deleteBalloon by removing the balloon.
-
- Moreover, if mouseOverEnabled is true (see class msg), then the Hand will arrange to cause display of the balloon after the mouse has lingered over the morph for a while, and removal of the balloon when the mouse leaves the bounds of that morph. In any case, the Hand will attempt to remove any such balloons before handling mouseDown events, or displaying other balloons.
-
- Balloons should not be duplicated with veryDeepCopy unless their target is also duplicated at the same time.!
Item was removed:
- ----- Method: BalloonMorph class>>balloonColor (in category 'preferences') -----
- balloonColor
-
- self flag: #remove. "mt: We should remove this additional getter in the future and use UI themes instead:"
- ^ (UserInterfaceTheme current get: #color for: #BalloonMorph) ifNil: [(TranslucentColor r: 0.92 g: 0.92 b: 0.706 alpha: 0.749)]!
Item was removed:
- ----- Method: BalloonMorph class>>balloonColor: (in category 'preferences') -----
- balloonColor: aColor
-
- self flag: #remove. "mt: We should remove this additional setter in the future and use UI themes instead:"
- UserInterfaceTheme current set: #color for: #BalloonMorph to: aColor.!
Item was removed:
- ----- Method: BalloonMorph class>>balloonFont (in category 'utility') -----
- balloonFont
-
- self flag: #remove. "mt: We should remove this additional getter in the future and use UI themes instead:"
- ^ (UserInterfaceTheme current get: #font for: #BalloonMorph) ifNil: [TextStyle defaultFont]!
Item was removed:
- ----- Method: BalloonMorph class>>balloonTextColor (in category 'preferences') -----
- balloonTextColor
-
- self flag: #remove. "mt: We should remove this additional getter in the future and use UI themes instead:"
- ^ (UserInterfaceTheme current get: #textColor for: #BalloonMorph) ifNil: [Color black]!
Item was removed:
- ----- Method: BalloonMorph class>>balloonTextColor: (in category 'preferences') -----
- balloonTextColor: aColor
-
- self flag: #remove. "mt: We should remove this additional setter in the future and use UI themes instead:"
- UserInterfaceTheme current set: #textColor for: #BalloonMorph to: aColor.!
Item was removed:
- ----- Method: BalloonMorph class>>chooseBalloonFont (in category 'utility') -----
- chooseBalloonFont
- "BalloonMorph chooseBalloonFont"
-
- Preferences
- chooseFontWithPrompt: 'Ballon Help font...' translated
- andSendTo: self
- withSelector: #setBalloonFontTo:
- highlightSelector: #balloonFont!
Item was removed:
- ----- Method: BalloonMorph class>>getBestLocation:for:corner: (in category 'private') -----
- getBestLocation: vertices for: morph corner: cornerName
- "Try four rel locations of the balloon for greatest unclipped area. 12/99 sma"
-
- | rect maxArea verts rectCorner morphPoint mbc a mp dir bestVerts result usableArea |
- "wiz 1/8/2005 Choose rect independantly of vertice order or size. Would be nice it this took into account curveBounds but it does not."
- rect := Rectangle encompassing: vertices.
- maxArea := -1.
- verts := vertices.
- usableArea := (morph world ifNil: [self currentWorld]) viewBox.
- 1 to: 4 do: [:i |
- dir := #(vertical horizontal) atWrap: i.
- verts := verts collect: [:p | p flipBy: dir centerAt: rect center].
- rectCorner := #(bottomLeft bottomRight topRight topLeft) at: i.
- morphPoint := #(topCenter topCenter bottomCenter bottomCenter) at: i.
- a := ((rect
- align: (rect perform: rectCorner)
- with: (mbc := morph boundsForBalloon perform: morphPoint))
- intersect: usableArea) area.
- (a > maxArea or: [a = rect area and: [rectCorner = cornerName]]) ifTrue:
- [maxArea := a.
- bestVerts := verts.
- mp := mbc]].
- result := bestVerts collect: [:p | p + (mp - bestVerts first)] "Inlined align:with:".
- ^ result!
Item was removed:
- ----- Method: BalloonMorph class>>getTextMorph:for: (in category 'private') -----
- getTextMorph: aStringOrMorph for: balloonOwner
- "Construct text morph."
- | m text |
- aStringOrMorph isMorph
- ifTrue: [m := aStringOrMorph]
- ifFalse: [BalloonFont
- ifNil: [text := aStringOrMorph]
- ifNotNil: [text := aStringOrMorph asText
- addAttribute: (TextFontReference toFont: balloonOwner balloonFont);
- addAttribute: (TextColor color: self balloonTextColor)].
- m := (TextMorph new contents: text) centered].
- m setToAdhereToEdge: #adjustedCenter.
- ^ m!
Item was removed:
- ----- Method: BalloonMorph class>>getVertices: (in category 'private') -----
- getVertices: bounds
- "Construct vertices for a balloon up and to left of anchor"
-
- | corners |
- corners := bounds corners atAll: #[1 4 3 2].
- ^ (Array
- with: corners first + (0 - bounds width // 2 @ 0)
- with: corners first + (0 - bounds width // 4 @ (bounds height // 2))) , corners!
Item was removed:
- ----- Method: BalloonMorph class>>setBalloonFontTo: (in category 'utility') -----
- setBalloonFontTo: aFont
-
- self flag: #remove. "mt: We should remove this additional setter in the future and use UI themes instead:"
- UserInterfaceTheme current set: #font for: #BalloonMorph to: aFont.!
Item was removed:
- ----- Method: BalloonMorph class>>string:for: (in category 'instance creation') -----
- string: str for: morph
- ^ self string: str for: morph corner: #bottomLeft!
Item was removed:
- ----- Method: BalloonMorph class>>string:for:corner: (in category 'instance creation') -----
- string: str for: morph corner: cornerName
- "Make up and return a balloon for morph. Find the quadrant that
- clips the text the least, using cornerName as a tie-breaker. tk 9/12/97"
- | text vertices balloon |
- balloon := self new.
- text := self
- getTextMorph: (str asString withNoLineLongerThan: Preferences maxBalloonHelpLineLength)
- for: morph.
- balloon userInterfaceTheme textColor ifNotNil:
- [:col | text color: col].
- balloon userInterfaceTheme font ifNotNil: [ : font | text font: font ].
- vertices := self getVertices: text bounds.
- vertices := self
- getBestLocation: vertices
- for: morph
- corner: cornerName.
- ^ balloon
- color: morph balloonColor ;
- setVertices: vertices ;
- addMorph: text ;
- setTarget: morph!
Item was removed:
- ----- Method: BalloonMorph class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ super themeProperties, {
- { #borderColor. 'Colors'. 'Color of the balloon''s border.' }.
- { #borderWidth. 'Borders'. 'Width of the balloon''s border.' }.
- { #color. 'Colors', 'Color for the balloon background.' }.
- { #font. 'Fonts'. 'Font for balloon text if not overridden by text attributes.' }.
- { #textColor. 'Colors'. 'Color for the balloon text if not overridden by text attributes.' }.
- }!
Item was removed:
- ----- Method: BalloonMorph>>adjustedCenter (in category 'menus') -----
- adjustedCenter
- "Return the center of the original textMorph box within the balloon."
-
- ^ (self vertices last: 4) average rounded !
Item was removed:
- ----- Method: BalloonMorph>>applyUserInterfaceTheme (in category 'updating') -----
- applyUserInterfaceTheme
-
- super applyUserInterfaceTheme.
- self setDefaultParameters.!
Item was removed:
- ----- Method: BalloonMorph>>balloonOwner (in category 'accessing') -----
- balloonOwner
- ^balloonOwner!
Item was removed:
- ----- Method: BalloonMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- self disableLayout: true.
- self morphicLayerNumber: self class balloonLayer.
- ""
- self beSmoothCurve.
-
- offsetFromTarget := 0 @ 0.
-
- self setDefaultParameters.!
Item was removed:
- ----- Method: BalloonMorph>>popUp (in category 'initialization') -----
- popUp
- | w worldBounds |
- target ifNil: [^ self].
- target isInWorld ifFalse: [^ self].
- w := target world.
- self prepareToOpen.
- "So that if the translation below makes it overlap the receiver, it won't interfere with the rootMorphsAt: logic and hence cause flashing. Without this, flashing happens, believe me!!"
- ((worldBounds := w bounds) containsRect: self bounds) ifFalse:
- [self bounds: (self bounds translatedToBeWithin: worldBounds)].
- self openInWorld.
- w activeHand addBalloonHelp: self.
- !
Item was removed:
- ----- Method: BalloonMorph>>popUpAt: (in category 'initialization') -----
- popUpAt: point
-
- self position: point.
- self popUp.!
Item was removed:
- ----- Method: BalloonMorph>>popUpAt:forHand: (in category 'initialization') -----
- popUpAt: aPoint forHand: aHand
-
- self popUpForHand: aHand.!
Item was removed:
- ----- Method: BalloonMorph>>popUpFor:hand: (in category 'initialization') -----
- popUpFor: aMorph hand: aHand
- "Pop up the receiver as balloon help for the given hand"
- balloonOwner := aMorph.
- self popUpForHand: aHand.!
Item was removed:
- ----- Method: BalloonMorph>>popUpForHand: (in category 'initialization') -----
- popUpForHand: aHand
- "Pop up the receiver as balloon help for the given hand"
- | worldBounds |
- self prepareToOpen.
- aHand world addMorphFront: self.
- "So that if the translation below makes it overlap the receiver, it won't
- interfere with the rootMorphsAt: logic and hence cause flashing. Without
- this, flashing happens, believe me!!"
- ((worldBounds := aHand world bounds) containsRect: self bounds) ifFalse:
- [self bounds: (self bounds translatedToBeWithin: worldBounds)].
- aHand resetBalloonHelp: self.
- !
Item was removed:
- ----- Method: BalloonMorph>>prepareToOpen (in category 'private') -----
- prepareToOpen
- "Override the color if not already set."
- self userInterfaceTheme color ifNotNil: [ : col | self color: col].
- self
- lock ;
- fullBounds!
Item was removed:
- ----- Method: BalloonMorph>>setDefaultParameters (in category 'initialization') -----
- setDefaultParameters
-
- self
- borderWidth: (self userInterfaceTheme borderWidth ifNil: [0]);
- borderColor: (self userInterfaceTheme borderColor ifNil: [Color black]);
- color: (self userInterfaceTheme color ifNil: [TranslucentColor r: 0.92 g: 0.92 b: 0.706 alpha: 0.749]).!
Item was removed:
- ----- Method: BalloonMorph>>setTarget: (in category 'private') -----
- setTarget: aMorph
- (target := aMorph) ifNotNil: [offsetFromTarget := self position - target position]!
Item was removed:
- ----- Method: BalloonMorph>>step (in category 'stepping and presenter') -----
- step
- "Move with target."
-
- target ifNotNil: [self position: target position + offsetFromTarget].
- !
Item was removed:
- ----- Method: BalloonMorph>>stepTime (in category 'stepping and presenter') -----
- stepTime
- ^ 0 "every cycle"!
Item was removed:
- ----- Method: BitBlt class>>asGrafPort (in category '*Morphic') -----
- asGrafPort
- "Return the GrafPort associated with the receiver"
- ^GrafPort!
Item was removed:
- ----- Method: BitmapFillStyle>>addFillStyleMenuItems:hand:from: (in category '*Morphic-Balloon') -----
- addFillStyleMenuItems: aMenu hand: aHand from: aMorph
- "Add the items for changing the current fill style of the receiver"
- aMenu add: 'choose new graphic' translated target: self selector: #chooseNewGraphicIn:event: argument: aMorph.
- aMenu add: 'grab new graphic' translated target: self selector: #grabNewGraphicIn:event: argument: aMorph.
- super addFillStyleMenuItems: aMenu hand: aHand from: aMorph.!
Item was removed:
- ----- Method: BitmapFillStyle>>chooseNewGraphicIn:event: (in category '*Morphic-Balloon') -----
- 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!
Item was removed:
- ----- Method: BitmapFillStyle>>grabNewGraphicIn:event: (in category '*Morphic-Balloon') -----
- grabNewGraphicIn: aMorph event: evt
- "Used by any morph that can be represented by a graphic"
- | fill |
- fill := Form fromUser.
- fill boundingBox area = 0
- ifTrue: [^ self].
- self form: fill.
- self direction: fill width @ 0.
- self normal: 0 @ fill height.
- aMorph changed!
Item was removed:
- ----- Method: BitmapFillStyle>>newForm:forMorph: (in category '*Morphic-Balloon') -----
- newForm: aForm forMorph: aMorph
- self form: aForm.
- self direction: (aForm width @ 0).
- self normal: (0 @ aForm height).
- aMorph changed.!
Item was removed:
- CornerGripMorph subclass: #BorderGripMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
Item was removed:
- ----- Method: BorderGripMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- super drawOn: aCanvas.
-
- self showHandle ifTrue: [
- self orientation = #vertical ifTrue: [
- aCanvas
- fillRoundRect: (((self width @ (self height * 0.25 min: self class handleLength)) center: self center) insetBy: self handleInset)
- radius: 3
- fillStyle: (SolidFillStyle color: self handleColor)].
- self orientation = #horizontal ifTrue: [
- aCanvas
- fillRoundRect: ((((self width * 0.25 min: self class handleLength) @ self height) center: self center) insetBy: self handleInset)
- radius: 3
- fillStyle: (SolidFillStyle color: self handleColor)] ].!
Item was removed:
- ----- Method: BorderGripMorph>>handleInset (in category 'accessing') -----
- handleInset
-
- ^ (handleInset notNil or: [self owner isNil])
- ifTrue: [handleInset ifNil: [2]]
- ifFalse: [(self owner borderWidth max: 1) * 2]!
Item was removed:
- ----- Method: BorderGripMorph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
- layoutProportionallyInBounds: layoutBounds positioning: cellPositioning
-
- super layoutProportionallyInBounds: layoutBounds positioning: cellPositioning.
-
- self flag: #workaround. "mt: We cannot know that our owner has always the correct properties at this time."
- self orientation = #vertical ifTrue: [
- self width: self class gripThickness + (self owner borderWidth * 2)].
- self orientation = #horizontal ifTrue: [
- self height: self class gripThickness + (self owner borderWidth * 2)].
- !
Item was removed:
- ----- Method: BorderGripMorph>>orientation (in category 'accessing') -----
- orientation
- "#vertical or #horizontal"
-
- self subclassResponsibility.!
Item was removed:
- ----- Method: BorderGripMorph>>showHandle (in category 'accessing') -----
- showHandle
-
- ^ showHandle ifNil: [self class drawEdgeResizeHandles]!
Item was removed:
- Object subclass: #BorderStyle
- instanceVariableNames: ''
- classVariableNames: 'Default'
- poolDictionaries: ''
- category: 'Morphic-Borders'!
-
- !BorderStyle commentStamp: 'kfr 10/27/2003 10:19' prior: 0!
- See BorderedMorph
-
- BorderedMorh new borderStyle: (BorderStyle inset width: 2); openInWorld.!
Item was removed:
- ----- Method: BorderStyle class>>borderStyleChoices (in category 'instance creation') -----
- borderStyleChoices
- "Answer the superset of all supported borderStyle symbols"
-
- ^ #(simple inset raised complexAltFramed complexAltInset complexAltRaised complexFramed complexInset complexRaised)!
Item was removed:
- ----- Method: BorderStyle class>>borderStyleForSymbol: (in category 'instance creation') -----
- borderStyleForSymbol: sym
- "Answer a border style corresponding to the given symbol"
-
- | aSymbol |
- aSymbol := sym == #none ifTrue: [#simple] ifFalse: [sym].
- ^ (self borderStyleChoices includes: aSymbol)
- ifTrue: [self perform: aSymbol]
- ifFalse: [nil]
- "
- | aSymbol selector |
- aSymbol := sym == #none ifTrue: [#simple] ifFalse: [sym].
- selector := Vocabulary eToyVocabulary translationKeyFor: aSymbol.
- selector isNil ifTrue: [selector := aSymbol].
- ^ self perform: selector
- "
- !
Item was removed:
- ----- Method: BorderStyle class>>color:width: (in category 'instance creation') -----
- color: aColor width: aNumber
- ^self width: aNumber color: aColor!
Item was removed:
- ----- Method: BorderStyle class>>complexAltFramed (in category 'instance creation') -----
- complexAltFramed
- ^ComplexBorder style: #complexAltFramed!
Item was removed:
- ----- Method: BorderStyle class>>complexAltInset (in category 'instance creation') -----
- complexAltInset
- ^ComplexBorder style: #complexAltInset!
Item was removed:
- ----- Method: BorderStyle class>>complexAltRaised (in category 'instance creation') -----
- complexAltRaised
- ^ComplexBorder style: #complexAltRaised!
Item was removed:
- ----- Method: BorderStyle class>>complexFramed (in category 'instance creation') -----
- complexFramed
- ^ComplexBorder style: #complexFramed!
Item was removed:
- ----- Method: BorderStyle class>>complexInset (in category 'instance creation') -----
- complexInset
- ^ComplexBorder style: #complexInset!
Item was removed:
- ----- Method: BorderStyle class>>complexRaised (in category 'instance creation') -----
- complexRaised
- ^ComplexBorder style: #complexRaised!
Item was removed:
- ----- Method: BorderStyle class>>default (in category 'instance creation') -----
- default
- ^Default ifNil:[Default := self new]!
Item was removed:
- ----- Method: BorderStyle class>>inset (in category 'instance creation') -----
- inset
- ^InsetBorder new!
Item was removed:
- ----- Method: BorderStyle class>>raised (in category 'instance creation') -----
- raised
- ^RaisedBorder new!
Item was removed:
- ----- Method: BorderStyle class>>simple (in category 'instance creation') -----
- simple
- "Answer a simple border style"
-
- ^ SimpleBorder new!
Item was removed:
- ----- Method: BorderStyle class>>thinGray (in category 'instance creation') -----
- thinGray
- ^ self width: 1 color: Color gray!
Item was removed:
- ----- Method: BorderStyle class>>width: (in category 'instance creation') -----
- width: aNumber
- ^self width: aNumber color: Color black!
Item was removed:
- ----- Method: BorderStyle class>>width:color: (in category 'instance creation') -----
- width: aNumber color: aColor
- "Since I am abstact, use SimpleBorder instead."
-
- ^ (self == BorderStyle ifTrue: [SimpleBorder] ifFalse: [self]) new
- color: aColor;
- width: aNumber;
- yourself!
Item was removed:
- ----- Method: BorderStyle>>= (in category 'comparing') -----
- = aBorderStyle
- ^self species = aBorderStyle species
- and:[self style == aBorderStyle style
- and:[self width = aBorderStyle width
- and:[self color = aBorderStyle color]]].!
Item was removed:
- ----- Method: BorderStyle>>baseColor (in category 'accessing') -----
- baseColor
- ^Color transparent!
Item was removed:
- ----- Method: BorderStyle>>baseColor: (in category 'accessing') -----
- baseColor: aColor
- "Ignored"!
Item was removed:
- ----- Method: BorderStyle>>color (in category 'accessing') -----
- color
- ^Color transparent!
Item was removed:
- ----- Method: BorderStyle>>color: (in category 'accessing') -----
- color: aColor
- "Ignored"!
Item was removed:
- ----- Method: BorderStyle>>drawLineFrom:to:on: (in category 'drawing') -----
- drawLineFrom: startPoint to: stopPoint on: aCanvas
- ^aCanvas line: startPoint to: stopPoint width: self width color: self color!
Item was removed:
- ----- Method: BorderStyle>>frameOval:on: (in category 'drawing') -----
- frameOval: aRectangle on: aCanvas
- "Frame the given rectangle on aCanvas"
- aCanvas frameOval: aRectangle width: self width color: self color!
Item was removed:
- ----- Method: BorderStyle>>framePolygon:on: (in category 'drawing') -----
- framePolygon: vertices on: aCanvas
- "Frame the given rectangle on aCanvas"
- self framePolyline: vertices on: aCanvas.
- self drawLineFrom: vertices last to: vertices first on: aCanvas.!
Item was removed:
- ----- Method: BorderStyle>>framePolyline:on: (in category 'drawing') -----
- framePolyline: vertices on: aCanvas
- "Frame the given rectangle on aCanvas"
-
- | prev next |
- prev := vertices first.
- 2 to: vertices size
- do:
- [:i |
- next := vertices at: i.
- self
- drawLineFrom: prev
- to: next
- on: aCanvas.
- prev := next]!
Item was removed:
- ----- Method: BorderStyle>>frameRectangle:on: (in category 'drawing') -----
- frameRectangle: aRectangle on: aCanvas
- "Frame the given rectangle on aCanvas"
- aCanvas frameRectangle: aRectangle width: self width color: self color!
Item was removed:
- ----- Method: BorderStyle>>hash (in category 'comparing') -----
- hash
- "hash is implemented because #= is implemented"
- ^self species hash bitXor: (self width hash bitXor: self color hash)!
Item was removed:
- ----- Method: BorderStyle>>inset (in category 'accessing') -----
- inset
- "Possible inset when honoring this border style. The default implementation uses #width to return a uniform inset."
- ^ self width!
Item was removed:
- ----- Method: BorderStyle>>isBorderStyle (in category 'testing') -----
- isBorderStyle
- ^true!
Item was removed:
- ----- Method: BorderStyle>>isComplex (in category 'testing') -----
- isComplex
- ^false!
Item was removed:
- ----- Method: BorderStyle>>releaseCachedState (in category 'initialize') -----
- releaseCachedState
- "Release any associated cached state"!
Item was removed:
- ----- Method: BorderStyle>>style (in category 'accessing') -----
- style
- ^#none!
Item was removed:
- ----- Method: BorderStyle>>trackColorFrom: (in category 'color tracking') -----
- trackColorFrom: aMorph
- "If necessary, update our color to reflect a change in aMorphs color"!
Item was removed:
- ----- Method: BorderStyle>>width (in category 'accessing') -----
- width
- ^0!
Item was removed:
- ----- Method: BorderStyle>>width: (in category 'accessing') -----
- width: aNumber
- "Ignored"!
Item was removed:
- Morph subclass: #BorderedMorph
- instanceVariableNames: 'borderWidth borderColor'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Kernel'!
-
- !BorderedMorph commentStamp: 'kfr 10/27/2003 11:17' prior: 0!
- BorderedMorph introduce borders to morph. Borders have the instanceVariables borderWidth and borderColor.
-
- BorderedMorph new borderColor: Color red; borderWidth: 10; openInWorld.
-
- BorderedMorph also have a varaity of border styles: simple, inset, raised, complexAltFramed, complexAltInset, complexAltRaised, complexFramed, complexInset, complexRaised.
- These styles are set using the classes BorderStyle, SimpleBorder, RaisedBorder, InsetBorder and ComplexBorder.
-
- BorderedMorph new borderStyle: (SimpleBorder width: 1 color: Color white); openInWorld.
- BorderedMorph new borderStyle: (BorderStyle inset width: 2); openInWorld.
-
-
- !
Item was removed:
- ----- Method: BorderedMorph>>acquireBorderWidth: (in category 'geometry') -----
- acquireBorderWidth: aBorderWidth
- "Gracefully acquire the new border width, keeping the interior area intact and not seeming to shift"
-
- | delta |
- (delta := aBorderWidth- self borderWidth) = 0 ifTrue: [^ self].
- self bounds: ((self bounds origin - (delta @ delta)) corner: (self bounds corner + (delta @ delta))).
- self borderWidth: aBorderWidth.!
Item was removed:
- ----- Method: BorderedMorph>>addBorderStyleMenuItems:hand: (in category 'menu') -----
- addBorderStyleMenuItems: aMenu hand: aHandMorph
- "Add border-style menu items"
-
- | subMenu |
- subMenu := MenuMorph new defaultTarget: self.
- "subMenu addTitle: 'border' translated."
- subMenu addStayUpItemSpecial.
- subMenu addList:
- {{'border color...' translated. #changeBorderColor:}.
- {'border width...' translated. #changeBorderWidth:}}.
- subMenu addLine.
- BorderStyle borderStyleChoices do:
- [:sym | (self borderStyleForSymbol: sym)
- ifNotNil:
- [subMenu add: sym translated target: self selector: #setBorderStyle: argument: sym]].
- aMenu add: 'border style' translated subMenu: subMenu
- !
Item was removed:
- ----- Method: BorderedMorph>>addCellGapToLayoutFrames (in category 'resize handling') -----
- addCellGapToLayoutFrames
-
- self changeCellGapOfLayoutFrames: self cellGap.!
Item was removed:
- ----- Method: BorderedMorph>>addCornerGrips (in category 'resize handling') -----
- addCornerGrips
- self
- addMorphBack: (TopLeftGripMorph new target: self; position: self position).
- self
- addMorphBack: (TopRightGripMorph new target: self; position: self position).
- self
- addMorphBack: (BottomLeftGripMorph new target: self;position: self position).
- self
- addMorphBack: (BottomRightGripMorph new target: self;position: self position)!
Item was removed:
- ----- Method: BorderedMorph>>addEdgeGrips (in category 'resize handling') -----
- addEdgeGrips
- "Add resizers along the four edges of the receiver"
-
- self
- addMorphBack: (TopGripMorph new target: self;position: self position).
- self
- addMorphBack: (BottomGripMorph new target: self;position: self position).
- self
- addMorphBack: (RightGripMorph new target: self;position: self position).
- self
- addMorphBack: (LeftGripMorph new target: self;position: self position).!
Item was removed:
- ----- Method: BorderedMorph>>addGrips (in category 'resize handling') -----
- addGrips
- "Always add both corner grips and edge grips."
-
- self removeGrips.
-
- self addCornerGrips.
- self addEdgeGrips. !
Item was removed:
- ----- Method: BorderedMorph>>addMorph:fullFrame: (in category 'resize handling') -----
- addMorph: aMorph fullFrame: aLayoutFrame
- "Add aMorph according to aLayoutFrame."
-
- self removeCellGapFromLayoutFrames.
- super addMorph: aMorph fullFrame: aLayoutFrame.
- self addCellGapToLayoutFrames.
-
- self wantsPaneSplitters ifTrue: [self addPaneSplitters].!
Item was removed:
- ----- Method: BorderedMorph>>addPaneHSplitterAtBottomOfRow: (in category 'resize handling') -----
- addPaneHSplitterAtBottomOfRow: someMorphs
-
- | targetFrame targetY minX maxX splitter |
- targetFrame := someMorphs first layoutFrame.
- targetY := targetFrame bottomFraction.
-
- minX := (someMorphs detectMin: [:each | each layoutFrame leftFraction]) layoutFrame leftFraction.
- maxX := (someMorphs detectMax: [:each | each layoutFrame rightFraction]) layoutFrame rightFraction.
-
- splitter := ProportionalSplitterMorph new beSplitsTopAndBottom; yourself.
- splitter layoutFrame: (LayoutFrame
- fractions: (minX @ targetY corner: maxX @ targetY)
- offsets: (targetFrame leftOffset @ targetFrame bottomOffset
- corner: targetFrame rightOffset @ 0)).
-
- self addMorphBack: (splitter position: self position).!
Item was removed:
- ----- Method: BorderedMorph>>addPaneHSplitters (in category 'resize handling') -----
- addPaneHSplitters
-
- | remaining targetY sameY |
- remaining := self paneMorphs reject: [:each |
- each layoutFrame isNil
- or: [each layoutFrame bottomFraction = 1
- or: [each layoutFrame hasFixedHeight]]].
- [remaining notEmpty] whileTrue:
- [targetY := remaining first layoutFrame bottomFraction.
- sameY := self paneMorphs select: [:each | each layoutFrame bottomFraction = targetY].
- self addPaneHSplitterAtBottomOfRow: sameY.
- remaining := remaining copyWithoutAll: sameY]!
Item was removed:
- ----- Method: BorderedMorph>>addPaneSplitters (in category 'resize handling') -----
- addPaneSplitters
-
- self removePaneSplitters.
-
- self addPaneVSplitters.
- self addPaneHSplitters.
-
- self linkSubmorphsToSplitters!
Item was removed:
- ----- Method: BorderedMorph>>addPaneVSplitterAtRightOfColumn: (in category 'resize handling') -----
- addPaneVSplitterAtRightOfColumn: someMorphs
-
- | targetFrame targetX minY maxY splitter |
- targetFrame := someMorphs first layoutFrame.
- targetX := targetFrame rightFraction.
-
- minY := (someMorphs detectMin: [:each | each layoutFrame topFraction]) layoutFrame topFraction.
- maxY := (someMorphs detectMax: [:each | each layoutFrame bottomFraction]) layoutFrame bottomFraction.
-
- splitter := ProportionalSplitterMorph new beSplitsLeftAndRight; yourself.
- splitter layoutFrame: (LayoutFrame
- fractions: (targetX @ minY corner: targetX @ maxY)
- offsets: (targetFrame rightOffset @ (targetFrame topOffset)
- corner: (0 @ (targetFrame bottomOffset)))).
-
- self addMorphBack: (splitter position: self position).!
Item was removed:
- ----- Method: BorderedMorph>>addPaneVSplitters (in category 'resize handling') -----
- addPaneVSplitters
-
- | remaining targetX sameX |
- remaining := self paneMorphs reject: [:each |
- each layoutFrame isNil
- or: [each layoutFrame rightFraction = 1
- or: [each layoutFrame hasFixedWidth]]].
- [remaining notEmpty] whileTrue:
- [targetX := remaining first layoutFrame rightFraction.
- sameX := self paneMorphs select: [:each | each layoutFrame rightFraction = targetX].
- self addPaneVSplitterAtRightOfColumn: sameX.
- remaining := remaining copyWithoutAll: sameX]!
Item was removed:
- ----- Method: BorderedMorph>>areasRemainingToFill: (in category 'drawing') -----
- areasRemainingToFill: aRectangle
- "Fixed here to test the fillStyle rather than color for translucency.
- Since can have a translucent fillStyle while the (calculated) color is not."
-
- self fillStyle isTranslucent
- ifTrue: [^ Array with: aRectangle].
- self wantsRoundedCorners
- ifTrue: [(self borderWidth > 0
- and: [self borderColor isColor
- and: [self borderColor isTranslucent]])
- ifTrue: [^ aRectangle
- areasOutside: (self innerBounds intersect: self boundsWithinCorners)]
- ifFalse: [^ aRectangle areasOutside: self boundsWithinCorners]]
- ifFalse: [(self borderWidth > 0
- and: [self borderColor isColor
- and: [self borderColor isTranslucent]])
- ifTrue: [^ aRectangle areasOutside: self innerBounds]
- ifFalse: [^ aRectangle areasOutside: self bounds]]
- !
Item was removed:
- ----- Method: BorderedMorph>>borderColor: (in category 'accessing') -----
- borderColor: aColorOrSymbolOrNil
-
- super borderColor: aColorOrSymbolOrNil.
-
- self flag: #compatibility. "mt: For older code, update the instance variables. Should be removed in the future."
- borderColor := self borderStyle color.!
Item was removed:
- ----- Method: BorderedMorph>>borderInitialize (in category 'initialization') -----
- borderInitialize
- "initialize the receiver state related to border"
-
- self borderStyle: (
- self defaultBorderStyle
- baseColor: self defaultBorderColor;
- width: self defaultBorderWidth;
- trackColorFrom: self;
- yourself).!
Item was removed:
- ----- Method: BorderedMorph>>borderInset (in category 'initialization') -----
- borderInset
- "Change border to inset. Preserve width and color."
-
- self borderStyle: (
- BorderStyle inset
- width: self borderStyle width;
- baseColor: Color transparent;
- trackColorFrom: self;
- yourself).!
Item was removed:
- ----- Method: BorderedMorph>>borderRaised (in category 'initialization') -----
- borderRaised
- "Change border to inset. Preserve width and color."
-
- self borderStyle: (
- BorderStyle raised
- width: self borderStyle width;
- baseColor: Color transparent;
- trackColorFrom: self;
- yourself).!
Item was removed:
- ----- Method: BorderedMorph>>borderSimple (in category 'initialization') -----
- borderSimple
- "Change border to simple. Preserve width and color."
-
- self borderStyle: (
- BorderStyle simple
- width: self borderStyle width;
- baseColor: self borderStyle color; "Override any raised/inset specials."
- trackColorFrom: self;
- yourself).!
Item was removed:
- ----- Method: BorderedMorph>>borderStyle: (in category 'accessing') -----
- borderStyle: aBorderStyle
-
- super borderStyle: aBorderStyle.
-
- self flag: #compatibility. "mt: For older code, update the instance variables. Should be removed in the future."
- borderWidth := self borderStyle width.
- borderColor := self borderStyle color.!
Item was removed:
- ----- Method: BorderedMorph>>borderWidth: (in category 'accessing') -----
- borderWidth: anInteger
-
- super borderWidth: anInteger.
-
- self flag: #compatibility. "mt: For older code, update the instance variables. Should be removed in the future."
- borderWidth := self borderStyle width.!
Item was removed:
- ----- Method: BorderedMorph>>cellGap: (in category 'layout properties') -----
- cellGap: aNumber
-
- self cellGap = aNumber ifTrue: [^ self].
-
- self removeCellGapFromLayoutFrames.
- super cellGap: aNumber.
- self addCellGapToLayoutFrames.
-
- (self wantsPaneSplitters and: [aNumber > 0])
- ifTrue: [self addPaneSplitters]
- ifFalse: [self removePaneSplitters].!
Item was removed:
- ----- Method: BorderedMorph>>changeBorderColor: (in category 'menu') -----
- changeBorderColor: evt
- | aHand |
- aHand := evt ifNotNil: [evt hand] ifNil: [self primaryHand].
- self changeColorTarget: self selector: #borderColor: originalColor: self borderColor hand: aHand!
Item was removed:
- ----- Method: BorderedMorph>>changeBorderWidth: (in category 'menu') -----
- changeBorderWidth: evt
- | handle origin aHand newWidth oldWidth |
- aHand := evt ifNil: [self primaryHand] ifNotNil: [evt hand].
- origin := aHand position.
- oldWidth := self borderWidth.
- (handle := HandleMorph new)
- forEachPointDo:
- [:newPoint | handle removeAllMorphs.
- handle addMorph:
- (LineMorph from: origin to: newPoint color: Color black width: 1).
- newWidth := (newPoint - origin) r asInteger // 5.
- self borderWidth: newWidth]
- lastPointDo:
- [:newPoint | handle deleteBalloon.
- self halo ifNotNil: [:halo | halo addHandles].
- self rememberCommand:
- (Command new cmdWording: 'border change' translated;
- undoTarget: self selector: #borderWidth: argument: oldWidth;
- redoTarget: self selector: #borderWidth: argument: newWidth)].
- aHand attachMorph: handle.
- handle setProperty: #helpAtCenter toValue: true.
- handle showBalloon:
- 'Move cursor farther from
- this point to increase border width.
- Click when done.' translated hand: evt hand.
- handle startStepping!
Item was removed:
- ----- Method: BorderedMorph>>changeCellGapOfLayoutFrames: (in category 'resize handling') -----
- changeCellGapOfLayoutFrames: delta
- "Enumerate all submorphs' #layoutFrame and change their offsets the amount of the receiver's #cellGap to that #addPaneSplitters can work. NOTE THAT not fully general-purpose and the rules a little bit hacky, currently optimized for horizontal text fields and button rows that have a fixed height besides a resizable widget such as other text fields or lists. Most challenging layouts include MessageNames and MCOperationsBrowser (incl. variations)."
-
- | frames |
- delta = 0 ifTrue: [^ self].
-
- "For robustness, only work on submorphs that have their layout frame set."
- frames := self paneMorphs
- select: [:ea | ea layoutFrame notNil]
- thenCollect: [:ea | ea layoutFrame].
-
- frames ifEmpty: [^ self].
-
- "Sort all frames to prioritize the ones with fixed height, e.g., button rows or one-liners."
- frames := frames sorted: [:a :b |
- (a hasFixedHeight and: [b hasFixedHeight not])
- or: [a hasFixedHeight = b hasFixedHeight
- and: [a topFraction < b topFraction]] ].
-
- "Enumerate all frames and add the gap by changing the corresponding offsets."
- frames do: [:thisFrame |
- | left right bottom top |
-
- "First, the easy part. Left and right offsets."
- left := thisFrame leftOffset.
- right := thisFrame rightOffset.
-
- thisFrame leftFraction = 0
- ifFalse: [ "Add a spacing to the frame if it is not top or leftmost."
- left := left + delta]
- ifTrue: [ "Expect another, resizable widget besides me if I have a fixed width."
- thisFrame hasFixedWidth ifTrue: [right := right - delta]].
-
- "Second, the tricky part. Optimized for fixed button rows and text lines."
- bottom := thisFrame bottomOffset.
- top := thisFrame topOffset.
-
- thisFrame topFraction = 0 ifTrue: [ "Special treatment for the topmost row"
- (frames anySatisfy: [:otherFrame | otherFrame ~~ thisFrame
- "Is there any otherFrame that hasFixedHeight with whom thisFrame shares the topFraction?"
- and: [otherFrame hasFixedHeight
- and: [otherFrame leftFraction <= thisFrame leftFraction
- and: [otherFrame rightFraction >= thisFrame rightFraction
- and: [otherFrame topFraction = thisFrame topFraction]]]] ])
- ifTrue: [ "Okay, make room for that otherFrame."
- top := top + delta.
- thisFrame hasFixedHeight ifTrue: [
- "If thisFrame happens to be fixed too, be sure to not change its height."
- bottom := bottom + delta ]] ].
-
- (frames anySatisfy: [:otherFrame | otherFrame ~~ thisFrame
- "Is there any otherFrame that hasFixedHeight with whom thisFrame shares the bottomFraction?"
- and: [otherFrame hasFixedHeight
- and: [otherFrame leftFraction <= thisFrame leftFraction
- and: [otherFrame rightFraction >= thisFrame rightFraction
- and: [otherFrame bottomFraction = thisFrame bottomFraction]]]] ])
- ifTrue: [ "Okay, make room for that otherFrame."
- bottom := bottom - delta.
- thisFrame hasFixedHeight ifTrue: [
- "If thisFrame happens to be fixed too, be sure to not change its height."
- top := top - delta ]].
-
- thisFrame bottomFraction ~= 1 ifTrue: [ "Basic treatment for all (inner) rows"
- (thisFrame hasFixedHeight not or: [thisFrame topFraction ~= 0])
- ifTrue: [ "All inner frames whould make room at the bottom except for topmost fixed ones, which we already treated above."
- bottom := bottom - delta.
- thisFrame hasFixedHeight ifTrue: [
- "If thisFrame happens to be fixed too, be sure to not change its height."
- top := top - delta ]] ].
-
- "We are finished. Remember the new offsets."
- thisFrame
- topOffset: top;
- bottomOffset: bottom;
- leftOffset: left;
- rightOffset: right].
-
- self layoutChanged.!
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 at 6)
- ifTrue: [ ^(in + (Point r: 5.0 degrees: (pt - in) degrees)) asIntegerPoint ].
- ].
- ^pt.!
Item was removed:
- ----- Method: BorderedMorph>>cornerGrips (in category 'resize handling') -----
- cornerGrips
-
- ^ self submorphsSatisfying: [:each | (each isKindOf: CornerGripMorph) and: [(each isKindOf: BorderGripMorph) not]]!
Item was removed:
- ----- Method: BorderedMorph>>defaultBorderColor (in category 'initialization') -----
- defaultBorderColor
- "answer the default border color/fill style for the receiver"
- ^ Color black!
Item was removed:
- ----- Method: BorderedMorph>>defaultBorderStyle (in category 'initialization') -----
- defaultBorderStyle
- ^ BorderStyle simple!
Item was removed:
- ----- Method: BorderedMorph>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- "answer the default border width for the receiver"
- ^ 2!
Item was removed:
- ----- Method: BorderedMorph>>displayScaleChangedBy: (in category 'display scale') -----
- displayScaleChangedBy: factor
- "The system's scale factor has changed. Try to scale the receiver so that it looks nice on the display. See DisplayScreen >> #uiScaleFactor:."
-
- self paneMorphs
- select: [:ea | ea respondsTo: #displayScaleChangedBy:]
- thenDo: [:ea | ea displayScaleChangedBy: factor].
-
- self bounds: ((self topLeft * factor) rounded extent: (self extent * factor) rounded).
-
- self removeGrips; removePaneSplitters.
- self cellGap: 0.
-
- self paneMorphs do: [:ea | ea layoutFrame ifNotNil: [:frame |
- frame topOffset: (frame topOffset * factor) rounded.
- frame bottomOffset: (frame bottomOffset * factor) rounded.
- frame leftOffset: (frame leftOffset * factor) rounded.
- frame rightOffset: (frame rightOffset * factor) rounded]].
-
- self wantsGrips ifTrue: [self addGrips].
- self wantsPaneSplitters ifTrue: [self addPaneSplitters].!
Item was removed:
- ----- Method: BorderedMorph>>doFastWindowReframe: (in category 'resize handling') -----
- doFastWindowReframe: ptName
-
- | newBounds delta |
- "For fast display, only higlight the rectangle during loop"
- newBounds := self bounds newRectButtonPressedDo: [:f |
- f
- withSideOrCorner: ptName
- setToPoint: (self pointFromWorld: Sensor cursorPoint)
- minExtent: self minimumExtent].
- delta := newBounds origin - self bounds origin.
- self bounds: newBounds.
- self flag: #workaround. "mt: Due to a layout-specific 'let us start in the top-left corner of a layout cell'-behavior, we have to go up the owner chain and propagate the delta. See Morph >> #layoutInBounds:positioning: and there section 1.2."
- self allOwnersDo: [:owner |
- (owner layoutPolicy notNil and: [owner ~~ Project current world])
- ifTrue: [owner topLeft: owner topLeft + delta]].
- ^newBounds.!
Item was removed:
- ----- Method: BorderedMorph>>edgeGrips (in category 'resize handling') -----
- edgeGrips
-
- ^ self submorphsSatisfying: [:each | each isKindOf: BorderGripMorph]!
Item was removed:
- ----- Method: BorderedMorph>>fastFramingOn (in category 'resize handling') -----
- fastFramingOn
-
- ^ Preferences fastDragWindowForMorphic!
Item was removed:
- ----- Method: BorderedMorph>>fullPrintOn: (in category 'printing') -----
- fullPrintOn: aStream
- aStream nextPutAll: '('.
- super fullPrintOn: aStream.
- aStream nextPutAll: ') setBorderWidth: '; print: self borderWidth;
- nextPutAll: ' borderColor: ' , (self colorString: self borderColor)!
Item was removed:
- ----- Method: BorderedMorph>>grips (in category 'resize handling') -----
- grips
-
- ^ self submorphsSatisfying: [:each | each isKindOf: CornerGripMorph]!
Item was removed:
- ----- Method: BorderedMorph>>handlesDisplayScaleChangedBy: (in category 'display scale') -----
- handlesDisplayScaleChangedBy: factor
-
- ^ self isSystemWindow!
Item was removed:
- ----- Method: BorderedMorph>>hasTranslucentColor (in category 'accessing') -----
- hasTranslucentColor
- "Answer true if this any of this morph is translucent but not transparent."
-
- (self color isColor and: [self color isTranslucentColor]) ifTrue: [^ true].
- (self borderColor isColor and: [self borderColor isTranslucentColor]) ifTrue: [^ true].
- ^ false
- !
Item was removed:
- ----- Method: BorderedMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
- self borderInitialize!
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 at 6)
- ifTrue: [ ^(in + (Point r: 5.0 degrees: (pt - in) degrees)) asIntegerPoint ].
- ].
- ^pt.!
Item was removed:
- ----- Method: BorderedMorph>>linkSubmorphsToSplitters (in category 'resize handling') -----
- linkSubmorphsToSplitters
-
- self splitters do: [:splitter |
- splitter splitsTopAndBottom ifTrue: [
- self submorphsDo: [:morph |
- ((morph ~= splitter
- and: [morph layoutFrame bottomFraction = splitter layoutFrame topFraction])
- and: [morph layoutFrame hasFixedHeight not
- or: [(morph layoutFrame topOffset) < 0]])
- ifTrue: [splitter addLeftOrTop: morph].
- ((morph ~= splitter
- and: [morph layoutFrame topFraction = splitter layoutFrame bottomFraction])
- and: [morph layoutFrame hasFixedHeight not
- or: [(morph layoutFrame bottomOffset) > 0]])
- ifTrue: [splitter addRightOrBottom: morph]]].
- splitter splitsLeftAndRight ifTrue: [
- self submorphsDo: [:morph |
- ((morph ~= splitter
- and: [morph layoutFrame rightFraction = splitter layoutFrame leftFraction])
- and: [morph layoutFrame hasFixedWidth not
- or: [(morph layoutFrame leftOffset) < 0]])
- ifTrue: [splitter addLeftOrTop: morph].
- ((morph ~= splitter
- and: [morph layoutFrame leftFraction = splitter layoutFrame rightFraction])
- and: [morph layoutFrame hasFixedWidth not
- or: [(morph layoutFrame rightOffset) > 0]])
- ifTrue: [splitter addRightOrBottom: morph]]]]!
Item was removed:
- ----- Method: BorderedMorph>>paneMorphs (in category 'resize handling') -----
- paneMorphs
-
- ^ self submorphs copyWithoutAll: self splitters, self grips!
Item was removed:
- ----- Method: BorderedMorph>>removeCellGapFromLayoutFrames (in category 'resize handling') -----
- removeCellGapFromLayoutFrames
-
- self changeCellGapOfLayoutFrames: self cellGap negated.!
Item was removed:
- ----- Method: BorderedMorph>>removeCornerGrips (in category 'resize handling') -----
- removeCornerGrips
-
- self cornerGrips do: [:each | each delete].!
Item was removed:
- ----- Method: BorderedMorph>>removeEdgeGrips (in category 'resize handling') -----
- removeEdgeGrips
-
- self edgeGrips do: [:ea | ea delete].!
Item was removed:
- ----- Method: BorderedMorph>>removeGrips (in category 'resize handling') -----
- removeGrips
-
- self removeCornerGrips.
- self removeEdgeGrips.!
Item was removed:
- ----- Method: BorderedMorph>>removePaneSplitters (in category 'resize handling') -----
- removePaneSplitters
-
- self splitters do: [:each | each delete]!
Item was removed:
- ----- Method: BorderedMorph>>splitters (in category 'resize handling') -----
- splitters
-
- ^ self submorphsSatisfying: [:each | each isKindOf: ProportionalSplitterMorph]!
Item was removed:
- ----- Method: BorderedMorph>>useRoundedCorners (in category 'accessing') -----
- useRoundedCorners
- self cornerStyle: #rounded!
Item was removed:
- ----- Method: BorderedMorph>>useSquareCorners (in category 'accessing') -----
- useSquareCorners
- self cornerStyle: #square!
Item was removed:
- ----- Method: BorderedMorph>>wantsGrips (in category 'resize handling') -----
- wantsGrips
-
- ^ self valueOfProperty: #allowGrips ifAbsent: [false]!
Item was removed:
- ----- Method: BorderedMorph>>wantsGrips: (in category 'resize handling') -----
- wantsGrips: aBoolean
-
- self setProperty: #allowGrips toValue: aBoolean.!
Item was removed:
- ----- Method: BorderedMorph>>wantsPaneSplitters (in category 'resize handling') -----
- wantsPaneSplitters
-
- ^ self valueOfProperty: #allowPaneSplitters ifAbsent: [false]!
Item was removed:
- ----- Method: BorderedMorph>>wantsPaneSplitters: (in category 'resize handling') -----
- wantsPaneSplitters: aBoolean
-
- self setProperty: #allowPaneSplitters toValue: aBoolean.!
Item was removed:
- BorderedMorph subclass: #BorderedSubpaneDividerMorph
- instanceVariableNames: 'resizingEdge'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph class>>forBottomEdge (in category 'instance creation') -----
- forBottomEdge
- ^self new horizontal resizingEdge: #bottom!
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph class>>forTopEdge (in category 'instance creation') -----
- forTopEdge
- ^self new horizontal resizingEdge: #top!
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph class>>horizontal (in category 'instance creation') -----
- horizontal
- ^self new horizontal!
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph class>>vertical (in category 'instance creation') -----
- vertical
- ^self new vertical!
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- "answer the default border width for the receiver"
- ^ 0!
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color black!
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph>>firstEnter: (in category 'private') -----
- firstEnter: evt
- "The first time this divider is activated, find its window and redirect further interaction there."
- | window |
-
- window := self firstOwnerSuchThat: [:m | m respondsTo: #secondaryPaneTransition:divider:].
- window ifNil: [ self suspendEventHandler. ^ self ]. "not working out"
- window secondaryPaneTransition: evt divider: self.
- self on: #mouseEnter send: #secondaryPaneTransition:divider: to: window.
- !
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph>>horizontal (in category 'layout') -----
- horizontal
-
- self hResizing: #spaceFill.!
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
- self extent: 1 @ 1!
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph>>resizingEdge (in category 'accessing') -----
- resizingEdge
-
- ^resizingEdge
- !
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph>>resizingEdge: (in category 'accessing') -----
- resizingEdge: edgeSymbol
-
- (#(top bottom) includes: edgeSymbol) ifFalse:
- [ self error: 'resizingEdge must be #top or #bottom' ].
- resizingEdge := edgeSymbol.
- self on: #mouseEnter send: #firstEnter: to: self.
- !
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph>>vertical (in category 'layout') -----
- vertical
-
- self vResizing: #spaceFill.!
Item was removed:
- BorderGripMorph subclass: #BottomGripMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
Item was removed:
- ----- Method: BottomGripMorph>>apply: (in category 'target resize') -----
- apply: delta
- | oldBounds |
- oldBounds := self target bounds.
- self target
- bounds: (oldBounds origin corner: oldBounds corner + (0 @ delta y))!
Item was removed:
- ----- Method: BottomGripMorph>>defaultHeight (in category 'initialize') -----
- defaultHeight
-
- ^ self class gripThickness!
Item was removed:
- ----- Method: BottomGripMorph>>gripLayoutFrame (in category 'accessing') -----
- gripLayoutFrame
- ^ LayoutFrame
- fractions: (0 @ 1 corner: 1 @ 1)
- offsets: (0 @ 0 corner: 0 @ 0)!
Item was removed:
- ----- Method: BottomGripMorph>>initialize (in category 'initialize') -----
- initialize
- super initialize.
- self hResizing: #spaceFill.!
Item was removed:
- ----- Method: BottomGripMorph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
- layoutProportionallyInBounds: layoutBounds positioning: cellPositioning
-
- super layoutProportionallyInBounds: layoutBounds positioning: cellPositioning.
-
- self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
- self bottom: owner bottom.!
Item was removed:
- ----- Method: BottomGripMorph>>orientation (in category 'accessing') -----
- orientation
-
- ^ #horizontal!
Item was removed:
- ----- Method: BottomGripMorph>>ptName (in category 'accessing') -----
- ptName
- ^#bottom!
Item was removed:
- ----- Method: BottomGripMorph>>resizeCursor (in category 'accessing') -----
- resizeCursor
-
- ^ Cursor resizeForEdge: #top!
Item was removed:
- CornerGripMorph subclass: #BottomLeftGripMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
-
- !BottomLeftGripMorph commentStamp: 'jmv 1/29/2006 17:17' prior: 0!
- I am the handle in the left bottom of windows used for resizing them.!
Item was removed:
- ----- Method: BottomLeftGripMorph>>apply: (in category 'target resize') -----
- apply: delta
- | oldBounds |
- oldBounds := self target bounds.
- self target
- bounds: (oldBounds origin + (delta x @ 0) corner: oldBounds corner + (0 @ delta y)).
- self flag: #workaround. "mt: Due to a layout-specific 'let us start in the top-left corner of a layout cell'-behavior, we have to go up the owner chain and propagate the delta. See Morph >> #layoutInBounds:positioning: and there section 1.2."
- self target allOwnersDo:
- [:anOwner |
- (anOwner layoutPolicy notNil and: [anOwner ~~ Project current world])
- ifTrue: [anOwner left: anOwner left + delta x]].!
Item was removed:
- ----- Method: BottomLeftGripMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- super drawOn: aCanvas.
-
- self showHandle ifTrue: [
- aCanvas
- fillRoundRect: ((self topLeft + (self handleInset @ self handleInset negated) extent: self class gripThickness @ self height) insetBy: self handleInset)
- radius: 3
- fillStyle: (SolidFillStyle color: self handleColor).
- aCanvas
- fillRoundRect: ((self bottomLeft + (self handleInset @ (self handleInset negated + self class gripThickness negated)) extent: self width @ self class gripThickness) insetBy: self handleInset)
- radius: 3
- fillStyle: (SolidFillStyle color: self handleColor).]!
Item was removed:
- ----- Method: BottomLeftGripMorph>>gripLayoutFrame (in category 'accessing') -----
- gripLayoutFrame
- ^ LayoutFrame
- fractions: (0 @ 1 corner: 0 @ 1)
- offsets: (0 @ 0 corner: 0 @ 0)!
Item was removed:
- ----- Method: BottomLeftGripMorph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
- layoutProportionallyInBounds: layoutBounds positioning: cellPositioning
-
- self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
- self bottomLeft: owner bottomLeft.!
Item was removed:
- ----- Method: BottomLeftGripMorph>>ptName (in category 'accessing') -----
- ptName
- ^#bottomLeft!
Item was removed:
- ----- Method: BottomLeftGripMorph>>resizeCursor (in category 'accessing') -----
- resizeCursor
-
- ^ Cursor resizeForEdge: #bottomLeft!
Item was removed:
- CornerGripMorph subclass: #BottomRightGripMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
-
- !BottomRightGripMorph commentStamp: 'jmv 1/29/2006 17:18' prior: 0!
- I am the handle in the right bottom of windows used for resizing them.!
Item was removed:
- ----- Method: BottomRightGripMorph>>apply: (in category 'target resize') -----
- apply: delta
- | oldBounds |
- oldBounds := self target bounds.
- self target
- bounds: (oldBounds origin corner: oldBounds corner + delta)!
Item was removed:
- ----- Method: BottomRightGripMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- super drawOn: aCanvas.
-
- self showHandle ifTrue: [
- aCanvas
- fillRoundRect: ((self topRight + ((self handleInset negated + self class gripThickness negated) @ self handleInset negated) extent: self class gripThickness @ self height) insetBy: self handleInset)
- radius: 3
- fillStyle: (SolidFillStyle color: self handleColor).
- aCanvas
- fillRoundRect: ((self bottomLeft + (self handleInset negated @ (self handleInset negated + self class gripThickness negated)) extent: self width @ self class gripThickness) insetBy: self handleInset)
- radius: 3
- fillStyle: (SolidFillStyle color: self handleColor).]!
Item was removed:
- ----- Method: BottomRightGripMorph>>gripLayoutFrame (in category 'accessing') -----
- gripLayoutFrame
- ^ LayoutFrame
- fractions: (1 @ 1 corner: 1 @ 1)
- offsets: (0 @ 0 corner: 0 @ 0)!
Item was removed:
- ----- Method: BottomRightGripMorph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
- layoutProportionallyInBounds: layoutBounds positioning: cellPositioning
-
- self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
- self bottomRight: owner bottomRight.!
Item was removed:
- ----- Method: BottomRightGripMorph>>ptName (in category 'accessing') -----
- ptName
- ^#bottomRight!
Item was removed:
- ----- Method: BottomRightGripMorph>>resizeCursor (in category 'accessing') -----
- resizeCursor
-
- ^ Cursor resizeForEdge: #bottomRight!
Item was removed:
- Morph subclass: #BracketMorph
- instanceVariableNames: 'orientation'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !BracketMorph commentStamp: 'gvc 5/18/2007 13:48' prior: 0!
- Morph displaying opposing arrows.!
Item was removed:
- ----- Method: BracketMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- "Draw triangles at the edges."
-
- |r|
- r := self horizontal
- ifTrue: [self bounds insetBy: (2 at 1 corner: 2 at 1)]
- ifFalse: [self bounds insetBy: (1 at 2 corner: 1 at 2)].
- aCanvas
- drawPolygon: (self leftOrTopVertices: self bounds)
- fillStyle: self borderColor;
- drawPolygon: (self leftOrTopVertices: r)
- fillStyle: self fillStyle;
- drawPolygon: (self rightOrBottomVertices: self bounds)
- fillStyle: self borderColor;
- drawPolygon: (self rightOrBottomVertices: r)
- fillStyle: self fillStyle!
Item was removed:
- ----- Method: BracketMorph>>horizontal (in category 'accessing') -----
- horizontal
- "Answer whether horizontal or vertical."
-
- ^self orientation == #horizontal!
Item was removed:
- ----- Method: BracketMorph>>horizontal: (in category 'accessing') -----
- horizontal: aBoolean
- "Set whether horizontal or vertical."
-
- ^self orientation: (aBoolean ifTrue: [#horizontal] ifFalse: [#vertical])!
Item was removed:
- ----- Method: BracketMorph>>initialize (in category 'initialization') -----
- initialize
- "Initialize the receiver."
-
- super initialize.
- self
- orientation: #horizontal!
Item was removed:
- ----- Method: BracketMorph>>leftOrTopVertices: (in category 'geometry') -----
- leftOrTopVertices: r
- "Answer the vertices for a left or top bracket in the given rectangle."
-
- ^self orientation == #vertical
- ifTrue: [{r topLeft - (0 at 1). r left + (r height // 2 + (r height \\ 2))@(r center y - (r height + 1 \\ 2)).
- r left + (r height // 2 + (r height \\ 2))@(r center y). r bottomLeft}]
- ifFalse: [{r topLeft. (r center x - (r width + 1 \\ 2))@(r top + (r width // 2 + (r width \\ 2))).
- r center x@(r top + (r width // 2 + (r width \\ 2))). r topRight}]!
Item was removed:
- ----- Method: BracketMorph>>orientation (in category 'accessing') -----
- orientation
- "Answer the value of orientation"
-
- ^ orientation!
Item was removed:
- ----- Method: BracketMorph>>orientation: (in category 'accessing') -----
- orientation: anObject
- "Set the value of orientation"
-
- orientation := anObject.
- self changed!
Item was removed:
- ----- Method: BracketMorph>>rightOrBottomVertices: (in category 'geometry') -----
- rightOrBottomVertices: r
- "Answer the vertices for a right or bottom bracket in the given rectangle."
-
- ^self orientation == #vertical
- ifTrue: [{r topRight - (0 at 1). r right - (r height // 2 + (r height \\ 2))@(r center y - (r height + 1 \\ 2)).
- r right - (r height // 2 + (r height \\ 2))@(r center y). r bottomRight}]
- ifFalse: [{(r center x)@(r bottom - 1 - (r width // 2 + (r width \\ 2))).
- r center x @(r bottom - 1 - (r width // 2 + (r width \\ 2))). r bottomRight. r bottomLeft - (1 at 0)}]!
Item was removed:
- Slider subclass: #BracketSliderMorph
- instanceVariableNames: 'getEnabledSelector enabled'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !BracketSliderMorph commentStamp: 'gvc 5/18/2007 13:39' prior: 0!
- Abstract superclass for morphs that are used to select a component (R, G, B or A) of a colour.!
Item was removed:
- ----- Method: BracketSliderMorph>>adoptPaneColor: (in category 'accessing - ui') -----
- adoptPaneColor: paneColor
- "Pass on to the border too."
- super adoptPaneColor: paneColor.
- paneColor ifNil: [ ^ self ].
- self
- fillStyle: self fillStyleToUse ;
- borderStyle:
- (BorderStyle inset
- width: 1 ;
- baseColor: self color twiceDarker) ;
- sliderColor:
- (self enabled
- ifTrue: [ paneColor twiceDarker ]
- ifFalse: [ self paneColor twiceDarker paler ])!
Item was removed:
- ----- Method: BracketSliderMorph>>defaultColor (in category 'accessing - ui') -----
- defaultColor
- "Answer the default color/fill style for the receiver."
-
- ^Color white!
Item was removed:
- ----- Method: BracketSliderMorph>>defaultFillStyle (in category 'accessing - ui') -----
- defaultFillStyle
- "Answer the defauolt fill style."
-
- ^Color gray!
Item was removed:
- ----- Method: BracketSliderMorph>>disable (in category 'accessing') -----
- disable
- "Disable the receiver."
-
- self enabled: false!
Item was removed:
- ----- Method: BracketSliderMorph>>enable (in category 'accessing') -----
- enable
- "Enable the receiver."
-
- self enabled: true!
Item was removed:
- ----- Method: BracketSliderMorph>>enabled (in category 'accessing') -----
- enabled
- "Answer the value of enabled"
-
- ^ enabled!
Item was removed:
- ----- Method: BracketSliderMorph>>enabled: (in category 'accessing') -----
- enabled: anObject
- "Set the value of enabled"
-
- enabled = anObject ifTrue: [^self].
- enabled := anObject.
- self changed: #enabled.
- self
- adoptPaneColor: self color;
- changed!
Item was removed:
- ----- Method: BracketSliderMorph>>extent: (in category 'geometry') -----
- extent: aPoint
- "Update the gradient directions."
-
- super extent: aPoint.
- self updateFillStyle!
Item was removed:
- ----- Method: BracketSliderMorph>>fillStyleToUse (in category 'accessing - ui') -----
- fillStyleToUse
- "Answer the fillStyle that should be used for the receiver."
-
- ^self fillStyle!
Item was removed:
- ----- Method: BracketSliderMorph>>getEnabledSelector (in category 'accessing') -----
- getEnabledSelector
- "Answer the value of getEnabledSelector"
-
- ^ getEnabledSelector!
Item was removed:
- ----- Method: BracketSliderMorph>>getEnabledSelector: (in category 'accessing') -----
- getEnabledSelector: aSymbol
- "Set the value of getEnabledSelector"
-
- getEnabledSelector := aSymbol.
- self updateEnabled!
Item was removed:
- ----- Method: BracketSliderMorph>>gradient (in category 'accessing - ui') -----
- gradient
- "Answer the gradient."
-
- self subclassResponsibility!
Item was removed:
- ----- Method: BracketSliderMorph>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: evt
- "Answer true."
-
- ^true!
Item was removed:
- ----- Method: BracketSliderMorph>>initialize (in category 'initialization') -----
- initialize
- "Initialize the receiver."
-
- super initialize.
- self
- enabled: true;
- fillStyle: self defaultFillStyle;
- borderStyle: (BorderStyle inset baseColor: self color; width: 1);
- sliderColor: Color black;
- clipSubmorphs: true!
Item was removed:
- ----- Method: BracketSliderMorph>>initializeSlider (in category 'initialization') -----
- initializeSlider
- "Make the slider raised."
-
- slider :=( BracketMorph newBounds: self totalSliderArea)
- horizontal: self orientation == #horizontal;
- color: self thumbColor;
- borderStyle: (BorderStyle raised baseColor: Color white; width: 1).
- sliderShadow := (BracketMorph newBounds: self totalSliderArea)
- horizontal: self orientation == #horizontal;
- color: self pagingArea color;
- borderStyle: (BorderStyle inset baseColor: (Color white alpha: 0.6); width: 1).
- slider on: #mouseMove send: #scrollAbsolute: to: self.
- slider on: #mouseDown send: #mouseDownInSlider: to: self.
- slider on: #mouseUp send: #mouseUpInSlider: to: self.
- "(the shadow must have the pagingArea as its owner to highlight properly)"
- self pagingArea addMorph: sliderShadow.
- sliderShadow hide.
- self addMorph: slider.
- self computeSlider.
- !
Item was removed:
- ----- Method: BracketSliderMorph>>minHeight (in category 'layout') -----
- minHeight
- "Answer the receiver's minimum height.
- Give it a bit of a chance..."
-
- ^8 max: super minHeight!
Item was removed:
- ----- Method: BracketSliderMorph>>mouseDown: (in category 'event handling') -----
- mouseDown: anEvent
- "Set the value directly."
-
- self enabled ifTrue: [
- self
- scrollPoint: anEvent;
- computeSlider].
- super mouseDown: anEvent.
- self enabled ifFalse: [^self].
- anEvent hand newMouseFocus: slider event: anEvent.
- slider
- mouseEnter: anEvent copy;
- mouseDown: anEvent copy
- !
Item was removed:
- ----- Method: BracketSliderMorph>>mouseDownInSlider: (in category 'other events') -----
- mouseDownInSlider: event
- "Ignore if disabled."
-
- self enabled ifFalse: [^self].
- ^super mouseDownInSlider: event!
Item was removed:
- ----- Method: BracketSliderMorph>>roomToMove (in category 'geometry') -----
- roomToMove
- "Allow to run off the edges a bit."
-
- ^self orientation == #horizontal
- ifTrue: [self totalSliderArea insetBy: ((self sliderThickness // 2 at 0) negated corner: (self sliderThickness // 2 + 1)@0)]
- ifFalse: [self totalSliderArea insetBy: (0@(self sliderThickness // 2) negated corner: 0@(self sliderThickness // 2 - (self sliderThickness \\ 2) + 1))]!
Item was removed:
- ----- Method: BracketSliderMorph>>scrollAbsolute: (in category 'scrolling') -----
- scrollAbsolute: event
- "Ignore if disabled."
-
- self enabled ifFalse: [^self].
- ^super scrollAbsolute: event!
Item was removed:
- ----- Method: BracketSliderMorph>>scrollPoint: (in category 'event handling') -----
- scrollPoint: event
- "Scroll to the event position."
-
- | r p |
- r := self roomToMove.
- self orientation == #horizontal
- ifTrue: [r width = 0 ifTrue: [^ self]]
- ifFalse: [r height = 0 ifTrue: [^ self]].
- p := event position - (self sliderThickness // 2) adhereTo: r.
- self descending
- ifFalse:
- [self setValue: (self orientation == #horizontal
- ifTrue: [(p x - r left) asFloat / r width]
- ifFalse: [(p y - r top) asFloat / r height])]
- ifTrue:
- [self setValue: (self orientation == #horizontal
- ifTrue: [(r right - p x) asFloat / r width]
- ifFalse: [(r bottom - p y) asFloat / r height])]!
Item was removed:
- ----- Method: BracketSliderMorph>>sliderColor: (in category 'accessing - ui') -----
- sliderColor: newColor
- "Set the slider colour."
-
- super sliderColor: (self enabled ifTrue: [Color black] ifFalse: [self sliderShadowColor]).
- slider ifNotNil: [slider borderStyle baseColor: Color white]!
Item was removed:
- ----- Method: BracketSliderMorph>>sliderShadowColor (in category 'accessing - ui') -----
- sliderShadowColor
- "Answer the color for the slider shadow."
-
- ^Color black alpha: 0.6!
Item was removed:
- ----- Method: BracketSliderMorph>>sliderThickness (in category 'geometry') -----
- sliderThickness
- "Answer the thickness of the slider."
-
- ^((self orientation == #horizontal
- ifTrue: [self height]
- ifFalse: [self width]) // 2 max: 8) // 2 * 2 + 1!
Item was removed:
- ----- Method: BracketSliderMorph>>update: (in category 'updating') -----
- update: aSymbol
- "Update the value."
-
- super update: aSymbol.
- aSymbol == self getEnabledSelector ifTrue: [
- ^self updateEnabled].!
Item was removed:
- ----- Method: BracketSliderMorph>>updateEnabled (in category 'testing') -----
- updateEnabled
- "Update the enablement state."
-
- self model ifNotNil: [
- self getEnabledSelector ifNotNil: [
- self enabled: (self model perform: self getEnabledSelector)]]!
Item was removed:
- ----- Method: BracketSliderMorph>>updateFillStyle (in category 'initialization') -----
- updateFillStyle
- "Update the fill style directions."
-
- |b fs|
- fs := self fillStyle.
- fs isOrientedFill ifTrue: [
- b := self innerBounds.
- fs origin: b topLeft.
- fs direction: (self orientation == #horizontal
- ifTrue: [b width at 0]
- ifFalse: [0 at b height])]!
Item was removed:
- ----- Method: BracketSliderMorph>>updateSlider (in category 'initialization') -----
- updateSlider
-
- super updateSlider.
-
- slider horizontal: self orientation == #horizontal.
- sliderShadow horizontal: self orientation == #horizontal.!
Item was removed:
- ----- Method: Browser>>displayClass: (in category '*Morphic-Menus-DockingBar-accessing') -----
- displayClass: aClass
- "Assuming the receiver has answered true to isDisplayingClass:, come to the front and select the given class."
- | index |
- index := self multiWindowIndexForClassName: aClass name.
- index ~= 0 ifTrue:
- [multiWindowState selectWindowIndex: index.
- ^(multiWindowState models at: index) selectClass: aClass].
- self selectClass: aClass!
Item was removed:
- ----- Method: Browser>>isDisplayingClass: (in category '*Morphic-Menus-DockingBar-accessing') -----
- isDisplayingClass: aClass
- | className |
- className := aClass name.
- (self multiWindowIndexForClassName: className) ~= 0 ifTrue: [^true].
- ^selectedClassName = className!
Item was removed:
- ----- Method: Browser>>multiWindowIndexForClassName: (in category '*Morphic-Menus-DockingBar-accessing') -----
- multiWindowIndexForClassName: className
- "Answer the index of a browser displaying className in multiWindowState, if any.
- Otherwise answer zero."
- multiWindowState ifNil: [^0].
- multiWindowState models withIndexDo:
- [:browser :index|
- browser selectedClassName = className ifTrue: [^index]].
- ^0!
Item was removed:
- FlattenEncoder subclass: #Canvas
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Support'!
-
- !Canvas commentStamp: '<historical>' prior: 0!
- A canvas is a two-dimensional medium on which morphs are drawn in a device-independent manner. Canvases keep track of the origin and clipping rectangle, as well as the underlying drawing medium (such as a window, pixmap, or postscript script).
-
- Subclasses must implement (at least) the following methods:
- * Drawing:
- #fillOval:color:borderWidth:borderColor:
- #frameAndFillRectangle:fillColor:borderWidth:borderColor:
- #drawPolygon:color:borderWidth:borderColor:
- #image:at:sourceRect:rule:
- #stencil:at:sourceRect:rule:
- #line:to:width:color:
- #paragraph:bounds:color:
- #text:bounds:font:color:
- * Support
- #clipBy:during:
- #translateBy:during:
- #translateBy:clippingTo:during:
- #transformBy:clippingTo:during:
- !
Item was removed:
- ----- Method: Canvas class>>filterSelector (in category 'configuring') -----
- filterSelector
- ^#drawOnCanvas:.!
Item was removed:
- ----- Method: Canvas>>asAlphaBlendingCanvas: (in category 'converting') -----
- asAlphaBlendingCanvas: alpha
- ^(AlphaBlendingCanvas on: self) alpha: alpha!
Item was removed:
- ----- Method: Canvas>>asShadowDrawingCanvas (in category 'converting') -----
- asShadowDrawingCanvas
- ^self asShadowDrawingCanvas: (Color black alpha: 0.5).!
Item was removed:
- ----- Method: Canvas>>asShadowDrawingCanvas: (in category 'converting') -----
- asShadowDrawingCanvas: aColor
- ^(ShadowDrawingCanvas on: self) shadowColor: aColor!
Item was removed:
- ----- Method: Canvas>>cache:using:during: (in category 'drawing-support') -----
- cache: aRectangle using: aCache during: aBlock
- "Cache the execution of aBlock by the given cache.
- Note: At some point we may want to actually *create* the cache here;
- for now we're only using it."
-
- (aCache notNil
- and: [(aCache isForm) and: [aCache extent = aRectangle extent]])
- ifTrue: [^self paintImage: aCache at: aRectangle origin].
- aBlock value: self!
Item was removed:
- ----- Method: Canvas>>clipBy:during: (in category 'drawing-support') -----
- clipBy: aRectangle during: aBlock
- "Set a clipping rectangle active only during the execution of aBlock.
- Note: In the future we may want to have more general clip shapes - not just rectangles"
- ^self subclassResponsibility!
Item was removed:
- ----- Method: Canvas>>clipRect (in category 'accessing') -----
- clipRect
- "Return the currently active clipping rectangle"
- ^self subclassResponsibility!
Item was removed:
- ----- Method: Canvas>>contentsOfArea: (in category 'accessing') -----
- contentsOfArea: aRectangle
- "Return the contents of the given area"
- ^self contentsOfArea: aRectangle into: (Form extent: aRectangle extent depth: self depth)!
Item was removed:
- ----- Method: Canvas>>contentsOfArea:into: (in category 'accessing') -----
- contentsOfArea: aRectangle into: aForm
- "Return the contents of the given area"
- ^self subclassResponsibility!
Item was removed:
- ----- Method: Canvas>>copyClipRect: (in category 'copying') -----
- copyClipRect: newClipRect
-
- ^ ClippingCanvas canvas: self clipRect: newClipRect
- !
Item was removed:
- ----- Method: Canvas>>depth (in category 'accessing') -----
- depth
-
- ^ Display depth
- !
Item was removed:
- ----- Method: Canvas>>displayIsFullyUpdated (in category 'Nebraska/embeddedWorlds') -----
- displayIsFullyUpdated!
Item was removed:
- ----- Method: Canvas>>doesRoundedCorners (in category 'testing') -----
- doesRoundedCorners
-
- ^ true!
Item was removed:
- ----- Method: Canvas>>draw: (in category 'drawing-general') -----
- draw: anObject
- ^anObject drawOn: self!
Item was removed:
- ----- Method: Canvas>>drawImage:at: (in category 'drawing-images') -----
- drawImage: aForm at: aPoint
- "Draw the given Form, which is assumed to be a Form or ColorForm"
-
- self drawImage: aForm
- at: aPoint
- sourceRect: aForm boundingBox!
Item was removed:
- ----- Method: Canvas>>drawImage:at:sourceRect: (in category 'drawing-images') -----
- drawImage: aForm at: aPoint sourceRect: sourceRect
- "Draw the given form."
- self shadowColor ifNotNil:[
- ^self fillRectangle: ((aForm boundingBox intersect: sourceRect) translateBy: aPoint)
- color: self shadowColor].
- ^self image: aForm
- at: aPoint
- sourceRect: sourceRect
- rule: Form over!
Item was removed:
- ----- Method: Canvas>>drawMorph: (in category 'drawing-general') -----
- drawMorph: aMorph
- self draw: aMorph!
Item was removed:
- ----- Method: Canvas>>drawPolygon:color:borderWidth:borderColor: (in category 'drawing-polygons') -----
- drawPolygon: vertices color: aColor borderWidth: bw borderColor: bc
- "Draw the given polygon."
- ^self subclassResponsibility!
Item was removed:
- ----- Method: Canvas>>drawPolygon:fillStyle: (in category 'drawing-polygons') -----
- drawPolygon: vertices fillStyle: aFillStyle
- "Fill the given polygon."
- self drawPolygon: vertices fillStyle: aFillStyle borderWidth: 0 borderColor: Color transparent!
Item was removed:
- ----- Method: Canvas>>drawPolygon:fillStyle:borderWidth:borderColor: (in category 'drawing-polygons') -----
- drawPolygon: vertices fillStyle: aFillStyle borderWidth: bw borderColor: bc
- "Fill the given polygon.
- Note: The default implementation does not recognize any enhanced fill styles"
- self drawPolygon: vertices color: aFillStyle asColor borderWidth: bw borderColor: bc!
Item was removed:
- ----- Method: Canvas>>drawString:at: (in category 'drawing-text') -----
- drawString: s at: pt
-
- ^ self drawString: s from: 1 to: s size at: pt font: nil color: Color black!
Item was removed:
- ----- Method: Canvas>>drawString:at:font:color: (in category 'drawing-text') -----
- drawString: s at: pt font: aFont color: aColor
-
- ^ self drawString: s from: 1 to: s size at: pt font: aFont color: aColor!
Item was removed:
- ----- Method: Canvas>>drawString:from:to:at:font:color: (in category 'drawing-text') -----
- drawString: s from: firstIndex to: lastIndex at: pt font: font color: aColor
- self drawString: s from: firstIndex to: lastIndex in: (pt extent: 10000 at 10000) font: font color: aColor!
Item was removed:
- ----- Method: Canvas>>drawString:from:to:in:font:color: (in category 'drawing-text') -----
- drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c
- ^self subclassResponsibility!
Item was removed:
- ----- Method: Canvas>>drawString:in: (in category 'drawing-text') -----
- drawString: s in: boundsRect
- ^self drawString: s from: 1 to: s size in: boundsRect font: nil color: Color black!
Item was removed:
- ----- Method: Canvas>>drawString:in:font:color: (in category 'drawing-text') -----
- drawString: s in: boundsRect font: fontOrNil color: c
- ^self drawString: s from: 1 to: s size in: boundsRect font: fontOrNil color: c!
Item was removed:
- ----- Method: Canvas>>extent (in category 'accessing') -----
- extent
- "Return the physical extent of the output device"
- ^self subclassResponsibility!
Item was removed:
- ----- Method: Canvas>>fillColor: (in category 'drawing') -----
- fillColor: aColor
- "Fill the receiver with the given color.
- Note: This method should be named differently since it is intended to fill the background and thus fills even if the color is transparent"
- ^self fillRectangle: self clipRect color: (aColor alpha: 1.0).!
Item was removed:
- ----- Method: Canvas>>fillOval:color: (in category 'drawing-ovals') -----
- fillOval: r color: c
-
- self fillOval: r color: c borderWidth: 0 borderColor: Color transparent.
- !
Item was removed:
- ----- Method: Canvas>>fillOval:color:borderWidth:borderColor: (in category 'drawing-ovals') -----
- fillOval: r color: c borderWidth: borderWidth borderColor: borderColor
- "Fill the given oval."
- ^self subclassResponsibility!
Item was removed:
- ----- Method: Canvas>>fillOval:fillStyle: (in category 'drawing-ovals') -----
- fillOval: aRectangle fillStyle: aFillStyle
- "Fill the given oval."
- ^self fillOval: aRectangle fillStyle: aFillStyle borderWidth: 0 borderColor: Color transparent!
Item was removed:
- ----- Method: Canvas>>fillOval:fillStyle:borderWidth:borderColor: (in category 'drawing-ovals') -----
- fillOval: aRectangle fillStyle: aFillStyle borderWidth: bw borderColor: bc
- "Fill the given oval.
- Note: The default implementation does not recognize any enhanced fill styles"
- self fillOval: aRectangle color: aFillStyle asColor borderWidth: bw borderColor: bc!
Item was removed:
- ----- Method: Canvas>>fillRectangle:color: (in category 'drawing-rectangles') -----
- fillRectangle: r color: c
- "Fill the rectangle using the given color"
- ^self
- frameAndFillRectangle: r
- fillColor: c
- borderWidth: 0
- borderColor: Color transparent!
Item was removed:
- ----- Method: Canvas>>fillRectangle:fillStyle: (in category 'drawing-rectangles') -----
- fillRectangle: aRectangle fillStyle: aFillStyle
- "Fill the given rectangle.
- Note: The default implementation does not recognize any enhanced fill styles"
- self fillRectangle: aRectangle color: aFillStyle asColor.!
Item was removed:
- ----- Method: Canvas>>fillRectangle:fillStyle:borderStyle: (in category 'drawing-rectangles') -----
- fillRectangle: aRectangle fillStyle: aFillStyle borderStyle: aBorderStyle
- "For convenience and historical reasons only. Try to use the more explicit 'frameAndFill..' calls if you want to draw borders."
-
- self frameAndFillRectangle: aRectangle fillStyle: aFillStyle borderStyle: aBorderStyle.!
Item was removed:
- ----- Method: Canvas>>fillRoundRect:radius:fillStyle: (in category 'drawing-rectangles') -----
- fillRoundRect: aRectangle radius: radius fillStyle: fillStyle
-
- self
- fillRectangle: aRectangle
- fillStyle: fillStyle.!
Item was removed:
- ----- Method: Canvas>>fillRoundRect:radius:fillStyle:borderStyle: (in category 'drawing-rectangles') -----
- fillRoundRect: aRectangle radius: radius fillStyle: fillStyle borderStyle: borderStyle
- "For convenience only. Try to use 'frameAndFill...' messages."
-
- self
- frameAndFillRoundRect: aRectangle
- radius: radius
- fillStyle: fillStyle
- borderStyle: borderStyle.!
Item was removed:
- ----- Method: Canvas>>finish (in category 'initialization') -----
- finish
- "If there are any pending operations on the receiver complete them. Do not return before all modifications have taken effect."
- ^self flush!
Item was removed:
- ----- Method: Canvas>>finish: (in category 'initialization') -----
- finish: allDamage
- "If there are any pending operations on the receiver complete them.
- Do not return before all modifications have taken effect."
- ^self finish!
Item was removed:
- ----- Method: Canvas>>flush (in category 'initialization') -----
- flush!
Item was removed:
- ----- Method: Canvas>>flushDisplay (in category 'other') -----
- flushDisplay
- " Dummy ."!
Item was removed:
- ----- Method: Canvas>>forceToScreen: (in category 'other') -----
- forceToScreen:rect
- " dummy "
- !
Item was removed:
- ----- Method: Canvas>>form (in category 'accessing') -----
- form
-
- ^ Display
- !
Item was removed:
- ----- Method: Canvas>>frameAndFillRectangle:fillColor:borderWidth:borderColor: (in category 'drawing-rectangles') -----
- frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth borderColor: borderColor
- "Draw the rectangle using the given attributes"
- ^self subclassResponsibility!
Item was removed:
- ----- Method: Canvas>>frameAndFillRectangle:fillColor:borderWidth:topLeftColor:bottomRightColor: (in category 'drawing-rectangles') -----
- frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth topLeftColor: topLeftColor bottomRightColor: bottomRightColor
- "Draw the rectangle using the given attributes.
- Note: This is a *very* simple implementation"
- | bw pt |
- self frameAndFillRectangle: r
- fillColor: fillColor
- borderWidth: borderWidth
- borderColor: bottomRightColor.
- bottomRightColor = topLeftColor ifFalse: [
- bw := borderWidth asPoint.
- pt := r topLeft + (bw // 2).
- self line: pt to: pt + ((r extent x - bw x)@0) width: borderWidth color: topLeftColor.
- self line: pt to: pt + (0@(r extent y - bw y)) width: borderWidth color: topLeftColor.
- ].!
Item was removed:
- ----- Method: Canvas>>frameAndFillRectangle:fillStyle:borderStyle: (in category 'drawing-rectangles') -----
- frameAndFillRectangle: aRectangle fillStyle: aFillStyle borderStyle: aBorderStyle
-
- aFillStyle isTransparent ifFalse: [
- self fillRectangle: (aRectangle insetBy: aBorderStyle inset) fillStyle: aFillStyle].
-
- aBorderStyle width > 0 ifTrue: [
- self frameRectangle: aRectangle borderStyle: aBorderStyle].!
Item was removed:
- ----- Method: Canvas>>frameAndFillRoundRect:radius:fillStyle:borderStyle: (in category 'drawing-rectangles') -----
- frameAndFillRoundRect: aRectangle radius: cornerRadius fillStyle: fillStyle borderStyle: borderStyle
-
- self
- frameAndFillRoundRect: aRectangle
- radius: cornerRadius
- fillStyle: fillStyle
- borderWidth: borderStyle width
- borderColor: borderStyle color.!
Item was removed:
- ----- Method: Canvas>>frameAndFillRoundRect:radius:fillStyle:borderWidth:borderColor: (in category 'drawing-rectangles') -----
- frameAndFillRoundRect: aRectangle radius: cornerRadius fillStyle: fillStyle borderWidth: bw borderColor: bc
-
- self
- frameAndFillRectangle: aRectangle
- fillColor: fillStyle asColor
- borderWidth: bw
- borderColor: bc.!
Item was removed:
- ----- Method: Canvas>>frameOval:color: (in category 'drawing-ovals') -----
- frameOval: r color: c
-
- self fillOval: r color: Color transparent borderWidth: 1 borderColor: c.
- !
Item was removed:
- ----- Method: Canvas>>frameOval:width:color: (in category 'drawing-ovals') -----
- frameOval: r width: w color: c
-
- self fillOval: r color: Color transparent borderWidth: w borderColor: c.
- !
Item was removed:
- ----- Method: Canvas>>frameRectangle:borderStyle: (in category 'drawing-rectangles') -----
- frameRectangle: aRectangle borderStyle: aBorderStyle
- "Double dispatch."
-
- aBorderStyle frameRectangle: aRectangle on: self.!
Item was removed:
- ----- Method: Canvas>>frameRectangle:color: (in category 'drawing-rectangles') -----
- frameRectangle: r color: c
-
- self frameRectangle: r width: 1 color: c.
- !
Item was removed:
- ----- Method: Canvas>>frameRectangle:width:color: (in category 'drawing-rectangles') -----
- frameRectangle: r width: w color: c
- ^self frameAndFillRectangle: r fillColor: Color transparent borderWidth: w borderColor: c.!
Item was removed:
- ----- Method: Canvas>>frameRoundRect:radius:borderStyle: (in category 'drawing-rectangles') -----
- frameRoundRect: aRectangle radius: radius borderStyle: borderStyle
-
- self
- frameRoundRect: aRectangle
- radius: radius
- width: borderStyle width
- color: borderStyle color.!
Item was removed:
- ----- Method: Canvas>>frameRoundRect:radius:width:color: (in category 'drawing-rectangles') -----
- frameRoundRect: aRectangle radius: radius width: borderWidth color: borderColor
-
- self
- frameRectangle: aRectangle
- width: borderWidth
- color: borderColor.!
Item was removed:
- ----- Method: Canvas>>fullDraw: (in category 'drawing-general') -----
- fullDraw: anObject
- ^anObject fullDrawOn: self!
Item was removed:
- ----- Method: Canvas>>fullDrawMorph: (in category 'drawing-general') -----
- fullDrawMorph: aMorph
- self fullDraw: aMorph!
Item was removed:
- ----- Method: Canvas>>image:at:sourceRect:rule: (in category 'private') -----
- image: aForm at: aPoint sourceRect: sourceRect rule: rule
- "Note: The public use of this protocol is deprecated. It will become private. Nobody in the outside world must assume that a thing like a combination rule has any specific effect."
- ^self subclassResponsibility!
Item was removed:
- ----- Method: Canvas>>image:at:sourceRect:rule:alpha: (in category 'private') -----
- image: aForm at: aPoint sourceRect: sourceRect rule: rule alpha: sourceAlpha
- "Privately used for blending forms w/ constant alpha. Fall back to simpler case by defaul."
- ^self image: aForm at: aPoint sourceRect: sourceRect rule: rule!
Item was removed:
- ----- Method: Canvas>>isBalloonCanvas (in category 'testing') -----
- isBalloonCanvas
- ^false!
Item was removed:
- ----- Method: Canvas>>isPostscriptCanvas (in category 'testing') -----
- isPostscriptCanvas
- ^false!
Item was removed:
- ----- Method: Canvas>>isShadowDrawing (in category 'testing') -----
- isShadowDrawing
- ^false!
Item was removed:
- ----- Method: Canvas>>isVisible: (in category 'testing') -----
- isVisible: aRectangle
- "Return true if the given rectangle is (partially) visible"
- ^self clipRect intersects: aRectangle
- !
Item was removed:
- ----- Method: Canvas>>line:to:brushForm: (in category 'drawing') -----
- line: pt1 to: pt2 brushForm: brush
- "Obsolete - will be removed in the future"!
Item was removed:
- ----- Method: Canvas>>line:to:color: (in category 'drawing') -----
- line: pt1 to: pt2 color: c
-
- self line: pt1 to: pt2 width: 1 color: c.
- !
Item was removed:
- ----- Method: Canvas>>line:to:width:color: (in category 'drawing') -----
- line: pt1 to: pt2 width: w color: c
- "Draw a line using the given width and color"
- ^self subclassResponsibility!
Item was removed:
- ----- Method: Canvas>>line:to:width:color:dashLength:secondColor:secondDashLength:startingOffset: (in category 'drawing') -----
- line: pt1 to: pt2 width: width color: color1 dashLength: s1 secondColor: color2 secondDashLength: s2 startingOffset: startingOffset
- "Draw a line using the given width, colors and dash lengths.
- Originally written by Stephan Rudlof; tweaked by Dan Ingalls
- to use startingOffset for sliding offset as in 'ants' animations.
- Returns the sum of the starting offset and the length of this line."
-
- | dist deltaBig colors nextPhase segmentOffset phase segmentLength startPoint distDone endPoint segLens |
- dist := pt1 dist: pt2.
- dist = 0 ifTrue: [^startingOffset].
- s1 = 0 & (s2 = 0) ifTrue: [^startingOffset].
- deltaBig := pt2 - pt1.
- colors := {
- color1.
- color2}.
- segLens := {
- s1 asFloat.
- s2 asFloat}.
- nextPhase := {
- 2.
- 1}.
-
- "Figure out what phase we are in and how far, given startingOffset."
- segmentOffset := startingOffset \\ (s1 + s2).
- segmentLength := segmentOffset < s1
- ifTrue:
- [phase := 1.
- s1 - segmentOffset]
- ifFalse:
- [phase := 2.
- s1 + s2 - segmentOffset].
- startPoint := pt1.
- distDone := 0.0.
- [distDone < dist] whileTrue:
- [segmentLength := segmentLength min: dist - distDone.
- endPoint := startPoint + (deltaBig * segmentLength / dist).
- self
- line: startPoint truncated
- to: endPoint truncated
- width: width
- color: (colors at: phase).
- distDone := distDone + segmentLength.
- phase := nextPhase at: phase.
- startPoint := endPoint.
- segmentLength := segLens at: phase].
- ^startingOffset + dist!
Item was removed:
- ----- Method: Canvas>>line:to:width:color:stepWidth:secondWidth:secondColor:secondStepWidth: (in category 'drawing') -----
- line: pt1 to: pt2 width: w1 color: c1 stepWidth: s1 secondWidth: w2 secondColor: c2 secondStepWidth: s2
- "Draw a line using the given width, colors and steps; both steps can
- have different stepWidths (firstStep, secondStep), draw widths and
- colors."
- | bigSteps offsetPoint dist p1p2Vec deltaBig delta1 delta2 lastPoint bigStep |
- s1 = 0 & (s2 = 0) ifTrue: [^ self].
- dist := pt1 dist: pt2.
- dist = 0 ifTrue: [^ self].
- bigStep := s1 + s2.
- bigSteps := dist / bigStep.
- p1p2Vec := pt2 - pt1.
- deltaBig := p1p2Vec / bigSteps.
- delta1 := deltaBig * (s1 / bigStep).
- delta2 := deltaBig * (s2 / bigStep).
- dist <= s1
- ifTrue:
- [self
- line: pt1 rounded
- to: pt2 rounded
- width: w1
- color: c1.
- ^ self].
- 0 to: bigSteps truncated - 1 do:
- [:bigStepIx |
- self
- line: (pt1 + (offsetPoint := deltaBig * bigStepIx)) rounded
- to: (pt1 + (offsetPoint := offsetPoint + delta1)) rounded
- width: w1
- color: c1.
- self
- line: (pt1 + offsetPoint) rounded
- to: (pt1 + (offsetPoint + delta2)) rounded
- width: w2
- color: c2].
- "if there was no loop, offsetPoint is nil"
- lastPoint := pt1 + ((offsetPoint ifNil: [0 @ 0])
- + delta2).
- (lastPoint dist: pt2)
- <= s1
- ifTrue: [self
- line: lastPoint rounded
- to: pt2 rounded
- width: w1
- color: c1]
- ifFalse:
- [self
- line: lastPoint rounded
- to: (lastPoint + delta1) rounded
- width: w1
- color: c1.
- self
- line: (lastPoint + delta1) rounded
- to: pt2
- width: w1
- color: c2]!
Item was removed:
- ----- Method: Canvas>>origin (in category 'accessing') -----
- origin
- "Return the current origin for drawing operations"
- ^self subclassResponsibility!
Item was removed:
- ----- Method: Canvas>>paintImage:at: (in category 'drawing-images') -----
- paintImage: aForm at: aPoint
- "Draw the given Form, which is assumed to be a Form or ColorForm following the convention that zero is the transparent pixel value."
-
- self paintImage: aForm
- at: aPoint
- sourceRect: aForm boundingBox
- !
Item was removed:
- ----- Method: Canvas>>paintImage:at:sourceRect: (in category 'drawing-images') -----
- paintImage: aForm at: aPoint sourceRect: sourceRect
- "Draw the given Form, which is assumed to be a Form or ColorForm following the convention that zero is the transparent pixel value."
- self shadowColor ifNotNil:[
- ^self stencil: aForm at: aPoint sourceRect: sourceRect color: self shadowColor].
- ^self image: aForm
- at: aPoint
- sourceRect: sourceRect
- rule: Form paint!
Item was removed:
- ----- Method: Canvas>>paragraph:bounds:color: (in category 'drawing') -----
- paragraph: paragraph bounds: bounds color: c
- "Draw the given paragraph"
- ^self subclassResponsibility!
Item was removed:
- ----- Method: Canvas>>point:color: (in category 'drawing') -----
- point: p color: c
- "Obsolete - will be removed in the future"!
Item was removed:
- ----- Method: Canvas>>preserveStateDuring: (in category 'drawing-support') -----
- preserveStateDuring: aBlock
- "Preserve the full canvas state during the execution of aBlock"
- ^aBlock value: self copy!
Item was removed:
- ----- Method: Canvas>>render: (in category 'drawing') -----
- render: anObject
- "Do some 3D operations with the object if possible"!
Item was removed:
- ----- Method: Canvas>>reset (in category 'initialization') -----
- reset
- "Reset the canvas."
-
- super initWithTarget:self class defaultTarget.
- !
Item was removed:
- ----- Method: Canvas>>seesNothingOutside: (in category 'testing') -----
- seesNothingOutside: aRectangle
- "Return true if this canvas will not touch anything outside aRectangle"
- ^ aRectangle containsRect: self clipRect
- !
Item was removed:
- ----- Method: Canvas>>shadowColor (in category 'accessing') -----
- shadowColor
- "Return the current override color or nil if no such color exists"
- ^nil!
Item was removed:
- ----- Method: Canvas>>shadowColor: (in category 'accessing') -----
- shadowColor: aColor
- "Set a shadow color. If set this color overrides any client-supplied color."!
Item was removed:
- ----- Method: Canvas>>stencil:at:color: (in category 'drawing-images') -----
- stencil: stencilForm at: aPoint color: aColor
- "Flood this canvas with aColor wherever stencilForm has non-zero pixels"
- ^self stencil: stencilForm
- at: aPoint
- sourceRect: stencilForm boundingBox
- color: aColor!
Item was removed:
- ----- Method: Canvas>>stencil:at:sourceRect:color: (in category 'drawing-images') -----
- stencil: stencilForm at: aPoint sourceRect: sourceRect color: aColor
- "Flood this canvas with aColor wherever stencilForm has non-zero pixels"
- ^self subclassResponsibility!
Item was removed:
- ----- Method: Canvas>>text:at:font:color: (in category 'drawing-text') -----
- text: s at: pt font: fontOrNil color: c
- "OBSOLETE"
- ^ self drawString: s at: pt font: fontOrNil color: c!
Item was removed:
- ----- Method: Canvas>>text:bounds:font:color: (in category 'drawing-text') -----
- text: s bounds: boundsRect font: fontOrNil color: c
- "OBSOLETE"
- ^self drawString: s in: boundsRect font: fontOrNil color: c!
Item was removed:
- ----- Method: Canvas>>transform2By:clippingTo:during:smoothing: (in category 'Nebraska/embeddedWorlds') -----
- transform2By: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize
-
- "an attempt to use #displayInterpolatedOn: instead of WarpBlt."
-
- | patchRect subCanvas pureRect biggerPatch biggerClip interForm |
-
- self flag: #bob. "added to Canvas in hopes it will work for Nebraska"
- (aDisplayTransform isPureTranslation) ifTrue: [
- ^aBlock value: (self copyOffset: aDisplayTransform offset negated truncated
- clipRect: aClipRect)
- ].
- "Prepare an appropriate warp from patch to aClipRect"
- pureRect := (aDisplayTransform globalBoundsToLocal: aClipRect).
- patchRect := pureRect rounded.
- patchRect area = 0 ifTrue: [^self]. "oh, well!!"
- biggerPatch := patchRect expandBy: 1.
- biggerClip := (aDisplayTransform localBoundsToGlobal: biggerPatch) rounded.
-
- "Render the submorphs visible in the clipping rectangle, as patchForm"
- subCanvas := FormCanvas extent: biggerPatch extent depth: self depth.
- self isShadowDrawing ifTrue: [
- subCanvas shadowColor: self shadowColor
- ].
-
- "this biggerPatch/biggerClip is an attempt to improve positioning of the final image in high magnification conditions. Since we cannot grab fractional pixels from the source, take one extra and then take just the part we need from the expanded form"
-
- subCanvas
- translateBy: biggerPatch topLeft negated rounded
- during: aBlock.
- interForm := Form extent: biggerClip extent depth: self depth.
- subCanvas form
- displayInterpolatedIn: interForm boundingBox
- on: interForm.
- self
- drawImage: interForm
- at: aClipRect origin
- sourceRect: (aClipRect origin - biggerClip origin extent: aClipRect extent)
-
- !
Item was removed:
- ----- Method: Canvas>>transformBy:clippingTo:during: (in category 'drawing-support') -----
- transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock
- "Transform the receiver by the given display transformation during the execution of aBlock. The given clip rectangle defines the *global* (e.g., outer) rectangle against which the receiver should clip (which would be equivalent to 'self clipRect: aClipRect; transformBy: aDisplayTransform')."
- ^ self transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: 1
- !
Item was removed:
- ----- Method: Canvas>>transformBy:clippingTo:during:smoothing: (in category 'drawing-support') -----
- transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize
- "Transform the receiver by the given display transformation during the execution of aBlock. The given clip rectangle defines the *global* (e.g., outer) rectangle against which the receiver should clip (which would be equivalent to 'self clipRect: aClipRect; transformBy: aDisplayTransform')."
- ^ self subclassResponsibility!
Item was removed:
- ----- Method: Canvas>>translateBy:clippingTo:during: (in category 'other') -----
- translateBy:aPoint clippingTo:aRect during:aBlock
- ^aBlock value:(self copyOffset:aPoint clipRect:aRect).!
Item was removed:
- ----- Method: Canvas>>translateBy:during: (in category 'drawing-support') -----
- translateBy: delta during: aBlock
- "Set a translation only during the execution of aBlock."
- ^self subclassResponsibility!
Item was removed:
- ----- Method: Canvas>>translateTo:clippingTo:during: (in category 'drawing-support') -----
- translateTo: newOrigin clippingTo: aRectangle during: aBlock
- "Set a new origin and clipping rectangle only during the execution of aBlock."
- self translateBy: newOrigin - self origin
- clippingTo: (aRectangle translateBy: self origin negated)
- during: aBlock!
Item was removed:
- ----- Method: Canvas>>translucentImage:at: (in category 'drawing-images') -----
- translucentImage: aForm at: aPoint
- "Draw a translucent image using the best available way of representing translucency."
- self translucentImage: aForm
- at: aPoint
- sourceRect: aForm boundingBox!
Item was removed:
- ----- Method: Canvas>>translucentImage:at:sourceRect: (in category 'drawing-images') -----
- translucentImage: aForm at: aPoint sourceRect: sourceRect
- "Draw a translucent image using the best available way of representing translucency.
- Note: This will be fixed in the future."
- self shadowColor ifNotNil:[
- ^self stencil: aForm at: aPoint sourceRect: sourceRect color: self shadowColor].
- (self depth < 32 or:[aForm isTranslucent not])
- ifTrue:[^self paintImage: aForm at: aPoint sourceRect: sourceRect].
- self image: aForm
- at: aPoint
- sourceRect: sourceRect
- rule: Form blend!
Item was removed:
- ----- Method: Canvas>>warpImage:transform: (in category 'drawing-images') -----
- warpImage: aForm transform: aTransform
- "Warp the given form using aTransform"
- ^self warpImage: aForm transform: aTransform at: 0 at 0!
Item was removed:
- ----- Method: Canvas>>warpImage:transform:at: (in category 'drawing-images') -----
- warpImage: aForm transform: aTransform at: extraOffset
- "Warp the given form using aTransform.
- TODO: Use transform to figure out appropriate cell size"
- ^self warpImage: aForm transform: aTransform at: extraOffset sourceRect: aForm boundingBox cellSize: 1!
Item was removed:
- ----- Method: Canvas>>warpImage:transform:at:sourceRect:cellSize: (in category 'drawing-images') -----
- warpImage: aForm transform: aTransform at: extraOffset sourceRect: sourceRect cellSize: cellSize
- "Warp the given using the appropriate transform and offset."
- ^self subclassResponsibility!
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 'instance creation') -----
- newPin
- "Construct a pin for embedded attachment"
- "CircleMorph newPin openInHand"
- ^self new
- removeAllMorphs;
- extent: 18 at 18;
- hResizing: #rigid;
- vResizing: #rigid;
- layoutPolicy: nil;
- color: Color orange lighter;
- borderColor: Color orange darker;
- borderWidth: 2;
- name: 'Pin'!
Item was removed:
- ----- Method: CircleMorph class>>supplementaryPartsDescriptions (in category 'parts bin') -----
- supplementaryPartsDescriptions
- "Extra items for parts bins"
-
- ^ {DescriptionForPartsBin
- formalName: 'Circle' translatedNoop
- categoryList: {'Graphics' translatedNoop}
- documentation: 'A circular shape' translatedNoop
- globalReceiverSymbol: #CircleMorph
- nativitySelector: #newStandAlone}!
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 'rotate scale and flex') -----
- heading
- "Overwritten to store the angle in #forwardDirection."
-
- ^ self rotationDegrees!
Item was removed:
- ----- Method: CircleMorph>>heading: (in category 'rotate scale and flex') -----
- heading: newHeading
- "Overwritten to store the angle in #forwardDirection."
-
- self rotationDegrees: newHeading.!
Item was removed:
- ----- Method: CircleMorph>>initialize (in category 'parts bin') -----
- initialize
- super initialize.
- self extent: 40 at 40;
- color: Color green lighter!
Item was removed:
- ----- Method: CircleMorph>>initializeToStandAlone (in category 'parts bin') -----
- initializeToStandAlone
- ^super initializeToStandAlone
- extent: 40 at 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 'rotate scale and flex') -----
- referencePosition
- "Return the current reference position of the receiver"
- ^ self valueOfProperty: #referencePosition ifAbsent: [ self center ]
- !
Item was removed:
- ----- Method: CircleMorph>>rotationCenter (in category 'rotate scale and flex') -----
- 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 'rotate scale and flex') -----
- 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:
- RectangleMorph subclass: #ClickExerciser
- instanceVariableNames: 'buttons'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Demo'!
Item was removed:
- ----- Method: ClickExerciser class>>descriptionForPartsBin (in category 'parts bin') -----
- descriptionForPartsBin
- "ClickExerciser descriptionForPartsBin"
- ^ self partName: 'Exercise Click'
- categories: #('Demo')
- documentation: 'An exerciser for click, double-click, and drag-click in morphic'!
Item was removed:
- ----- Method: ClickExerciser>>allSelectors (in category 'accessing') -----
- allSelectors
- ^ #( #click: #doubleClick: #doubleClickTimeout: #startDrag:) !
Item was removed:
- ----- Method: ClickExerciser>>alternateBorderColor (in category 'accessing') -----
- alternateBorderColor
- "answer the alternate color/fill style for the receiver"
- ^ Color yellow!
Item was removed:
- ----- Method: ClickExerciser>>alternateColor (in category 'accessing') -----
- alternateColor
- "answer the alternate color/fill style for the receiver"
- ^ Color cyan!
Item was removed:
- ----- Method: ClickExerciser>>alternateSide (in category 'initialization') -----
- alternateSide
- "initial extent is square. We return an alternate height/width for drag to manipulate."
- ^ (self defaultSide asFloat * 1.618) rounded .
- !
Item was removed:
- ----- Method: ClickExerciser>>balloonText (in category 'accessing') -----
- balloonText
- ^ 'Double-click on me to change my color;
- single-click on me to change border color;
- hold mouse down within me and then move it to grow
- or shrink. When I time out my border changes width.
- Choose which of the above will work
- by selecting the boxes in the middle.
- See the boxes balloons.' translated!
Item was removed:
- ----- Method: ClickExerciser>>click: (in category 'event handling') -----
- click: evt
- self showBalloon: 'click' hand: evt hand.
- self borderColor: (self borderColor = self defaultBorderColor ifTrue: [self alternateBorderColor] ifFalse: [self defaultBorderColor])
- !
Item was removed:
- ----- Method: ClickExerciser>>defaultBorderColor (in category 'accessing') -----
- defaultBorderColor
- "answer the alternate color/fill style for the receiver"
- ^ Color black!
Item was removed:
- ----- Method: ClickExerciser>>defaultColor (in category 'accessing') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color red!
Item was removed:
- ----- Method: ClickExerciser>>defaultSide (in category 'initialization') -----
- defaultSide
- "initial extent is square. We return the default height/width."
- ^ 100 .
- !
Item was removed:
- ----- Method: ClickExerciser>>doubleClick: (in category 'event handling') -----
- doubleClick: evt
- self showBalloon: 'doubleClick' hand: evt hand.
- self color: ((color = self alternateColor ) ifTrue: [self defaultColor] ifFalse: [self alternateColor])
- !
Item was removed:
- ----- Method: ClickExerciser>>doubleClickTimeout: (in category 'event handling') -----
- doubleClickTimeout: evt
- self showBalloon: 'ClickTimeout' hand: evt hand.
- self borderWidth: self borderWidth \\ 11 + 2!
Item was removed:
- ----- Method: ClickExerciser>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: evt
- ^ true!
Item was removed:
- ----- Method: ClickExerciser>>initButtons (in category 'initialization') -----
- initButtons
- | aButton positions |
- aButton := ThreePhaseButtonMorph checkBox.
- positions := ((0 at 0) rect: aButton extent negated) corners + self center .
- buttons := positions collect: [ :p | ThreePhaseButtonMorph checkBox position: p; state: #on ] .
- buttons with: self allSelectors do: [ :b :s | b balloonText: s asString ] .
- self removeAllMorphs .
- self addAllMorphs: buttons .
- !
Item was removed:
- ----- Method: ClickExerciser>>initialize (in category 'initialization') -----
- initialize
- super initialize.
- self extent: self defaultSide asPoint.
- self initButtons .!
Item was removed:
- ----- Method: ClickExerciser>>mouseDown: (in category 'event handling') -----
- mouseDown: evt
- "Do nothing upon mouse-down except inform the hand to watch for a
- double-click; wait until an ensuing click:, doubleClick:, or drag:
- message gets dispatched"
- Preferences disable: #NewClickTest .
- evt hand
- waitForClicksOrDrag: self
- event: evt
- selectors: self selectors
- threshold: HandMorph dragThreshold!
Item was removed:
- ----- Method: ClickExerciser>>selectors (in category 'accessing') -----
- selectors
- ^ self allSelectors with: buttons collect: [ :s :b | b isOn ifTrue: [ s ] ifFalse: [nil ] ] .!
Item was removed:
- ----- Method: ClickExerciser>>startDrag: (in category 'event handling') -----
- startDrag: evt
- "We'll get a mouseDown first, some mouseMoves, and a mouseUp event last"
- | height width both |
- "evt isMouseDown ifTrue:
- [self showBalloon: 'drag (mouse down)' hand: evt hand.
- self world displayWorld.
- (Delay forMilliseconds: 750) wait].
- evt isMouseUp ifTrue:
- [self showBalloon: 'drag (mouse up)' hand: evt hand].
- (evt isMouseUp or: [evt isMouseDown]) ifFalse:
- [self showBalloon: 'drag (mouse still down)' hand: evt hand].
- (self containsPoint: evt cursorPoint)
- ifFalse: [^ self]."
- self showBalloon: 'drag (mouse down)' hand: evt hand.
-
- width := (self defaultSide max: self extent x) min: self alternateSide.
- height := (self defaultSide max: self extent y) min: self alternateSide.
- both := self defaultSide + self alternateSide.
-
- self extent:
- (((color = (self defaultColor)
- ifTrue:
- [ (both - height) @ width ]
- ifFalse:
- [ height @ (both - width) ])
- max: self defaultSide asPoint)
- min: self alternateSide asPoint )
-
- !
Item was removed:
- PluggableCanvas subclass: #ClippingCanvas
- instanceVariableNames: 'canvas clipRect'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Support'!
-
- !ClippingCanvas commentStamp: '<historical>' prior: 0!
- A modified canvas which clips all drawing commands.!
Item was removed:
- ----- Method: ClippingCanvas class>>canvas:clipRect: (in category 'instance creation') -----
- canvas: aCanvas clipRect: aRectangle
- ^self new canvas: aCanvas clipRect: aRectangle!
Item was removed:
- ----- Method: ClippingCanvas>>apply: (in category 'private') -----
- apply: aBlock
- "apply the given block to the inner canvas with clipRect as the clipping rectangle"
- canvas clipBy: clipRect during: aBlock!
Item was removed:
- ----- Method: ClippingCanvas>>canvas:clipRect: (in category 'initialization') -----
- canvas: aCanvas clipRect: aRectangle
- canvas := aCanvas.
- clipRect := aRectangle.!
Item was removed:
- ----- Method: ClippingCanvas>>clipRect (in category 'accessing') -----
- clipRect
- ^clipRect!
Item was removed:
- ----- Method: ClippingCanvas>>contentsOfArea:into: (in category 'accessing') -----
- contentsOfArea: aRectangle into: aForm
- self flag: #hack. "ignore the clipping specification for this command. This is purely so that CachingCanvas will work properly when clipped. There *has* to be a clean way to do this...."
- ^canvas contentsOfArea: aRectangle into: aForm!
Item was removed:
- ----- Method: ClippingCanvas>>form (in category 'accessing') -----
- form
- ^canvas form!
Item was removed:
- ----- Method: ClippingCanvas>>isBalloonCanvas (in category 'testing') -----
- isBalloonCanvas
- ^canvas isBalloonCanvas!
Item was removed:
- ----- Method: ClippingCanvas>>isShadowDrawing (in category 'testing') -----
- isShadowDrawing
- ^canvas isShadowDrawing!
Item was removed:
- ----- Method: ClippingCanvas>>shadowColor (in category 'accessing') -----
- shadowColor
- ^canvas shadowColor!
Item was removed:
- SystemWindow subclass: #CollapsedMorph
- instanceVariableNames: 'uncollapsedMorph'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
Item was removed:
- ----- Method: CollapsedMorph class>>createReplacementFor:in: (in category 'instance creation') -----
- createReplacementFor: aMorph in: anOwner
-
- ^ self new
- beReplacementFor: aMorph in: anOwner;
- yourself!
Item was removed:
- ----- Method: CollapsedMorph>>beReplacementFor: (in category 'collapse/expand') -----
- beReplacementFor: aMorph
- "Encapsulate aMorph with the CollapsedMorph and display the latter"
-
- | itsWorld |
- (itsWorld := aMorph world) ifNil: [^self].
- self beReplacementFor: aMorph in: itsWorld.!
Item was removed:
- ----- Method: CollapsedMorph>>beReplacementFor:in: (in category 'collapse/expand') -----
- beReplacementFor: aMorph in: anOwner
- "Encapsulate aMorph with the CollapsedMorph and display the latter in anOwner"
-
- | priorPosition |
- uncollapsedMorph := aMorph.
-
- self setLabel: aMorph externalName.
- aMorph delete.
- self privateOwner: anOwner. "lest RealEstateAgent fail at positioning me"
- self collapseOrExpand.
- anOwner addMorphFront: self.
- (priorPosition := aMorph valueOfProperty: #collapsedPosition ifAbsent: [nil])
- ifNotNil: [self position: priorPosition].!
Item was removed:
- ----- Method: CollapsedMorph>>buildWindowMenu (in category 'menu') -----
- buildWindowMenu
- "Answer the menu to be put up in response to the user's clicking on the window-menu control in the window title. Specialized for CollapsedMorphs."
-
- | aMenu |
- aMenu := MenuMorph new defaultTarget: self.
- aMenu add: 'change name...' translated action: #relabel.
- aMenu addLine.
- aMenu add: 'send to back' translated action: #sendToBack.
- aMenu add: 'make next-to-topmost' translated action: #makeSecondTopmost.
- aMenu addLine.
- self mustNotClose
- ifFalse:
- [aMenu add: 'make unclosable' translated action: #makeUnclosable]
- ifTrue:
- [aMenu add: 'make closable' translated action: #makeClosable].
- aMenu
- add: (self isSticky ifTrue: ['make draggable'] ifFalse: ['make undraggable']) translated
- action: #toggleStickiness.
- ^aMenu!
Item was removed:
- ----- Method: CollapsedMorph>>centerWithWrappees: (in category 'adjusting') -----
- centerWithWrappees: aPoint
-
- self center: aPoint.
- uncollapsedMorph center: aPoint.!
Item was removed:
- ----- Method: CollapsedMorph>>collapseOrExpand (in category 'resize/collapse') -----
- collapseOrExpand
- "Toggle the expand/collapsd state of the receiver. If expanding, copy the window title back to the name of the expanded morph"
-
- | aWorld |
- isCollapsed
- ifTrue:
- [uncollapsedMorph setProperty: #collapsedPosition toValue: self position.
- labelString ifNotNil: [uncollapsedMorph setNameTo: labelString].
- mustNotClose := false. "We're not closing but expanding"
- self delete.
- (aWorld := self currentWorld) addMorphFront: uncollapsedMorph.
- aWorld startSteppingSubmorphsOf: uncollapsedMorph]
- ifFalse:
- [super collapseOrExpand]!
Item was removed:
- ----- Method: CollapsedMorph>>uncollapseToHand (in category 'collapse/expand') -----
- uncollapseToHand
- "Hand the uncollapsedMorph to the user, placing it in her hand, after remembering appropriate state for possible future use"
-
- | nakedMorph |
- nakedMorph := uncollapsedMorph.
- uncollapsedMorph := nil.
- nakedMorph setProperty: #collapsedPosition toValue: self position.
- mustNotClose := false. "so the delete will succeed"
- self delete.
- self currentHand attachMorph: nakedMorph.!
Item was removed:
- ----- Method: CollapsedMorph>>uncollapsedMorph (in category 'accessing') -----
- uncollapsedMorph
-
- ^ uncollapsedMorph!
Item was removed:
- ----- Method: CollapsedMorph>>wantsExpandBox (in category 'resize/collapse') -----
- wantsExpandBox
- "Answer whether I'd like an expand box"
-
- ^ false!
Item was removed:
- ----- Method: Collection>>explorerContents (in category '*Morphic-Explorer') -----
- explorerContents
-
- ^self explorerContentsWithIndexCollect: [:value :index |
- ObjectExplorerWrapper
- with: value
- name: index printString
- model: self]!
Item was removed:
- ----- Method: Collection>>explorerContentsWithIndexCollect: (in category '*Morphic-Explorer') -----
- explorerContentsWithIndexCollect: twoArgBlock
-
- ^ self asOrderedCollection withIndexCollect: twoArgBlock
- !
Item was removed:
- ----- Method: Color>>asMorph (in category '*Morphic') -----
- asMorph
-
- ^(RectangleMorph new)
- fillStyle: self;
- borderWidth: 0;
- yourself!
Item was removed:
- ----- Method: Color>>iconOrThumbnailOfSize: (in category '*Morphic') -----
- iconOrThumbnailOfSize: aNumberOrPoint
- "Answer an appropiate form to represent the receiver"
- | form |
- form := Form extent: aNumberOrPoint asPoint asPoint depth: 32.
- form fillColor: self.
- ^ form!
Item was removed:
- Canvas subclass: #ColorMappingCanvas
- instanceVariableNames: 'myCanvas'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Support'!
Item was removed:
- ----- Method: ColorMappingCanvas class>>on: (in category 'instance creation') -----
- on: aCanvas
- ^self new on: aCanvas!
Item was removed:
- ----- Method: ColorMappingCanvas>>clipBy:during: (in category 'drawing-support') -----
- clipBy: aRectangle during: aBlock
- "Set a clipping rectangle active only during the execution of aBlock.
- Note: In the future we may want to have more general clip shapes - not just rectangles"
- | oldCanvas |
- oldCanvas := myCanvas.
- myCanvas clipBy: aRectangle during:[:newCanvas|
- myCanvas := newCanvas.
- aBlock value: self].
- myCanvas := oldCanvas!
Item was removed:
- ----- Method: ColorMappingCanvas>>clipRect (in category 'accessing') -----
- clipRect
- ^myCanvas clipRect!
Item was removed:
- ----- Method: ColorMappingCanvas>>depth (in category 'accessing') -----
- depth
- ^myCanvas depth!
Item was removed:
- ----- Method: ColorMappingCanvas>>drawPolygon:color:borderWidth:borderColor: (in category 'drawing-polygons') -----
- drawPolygon: vertices color: aColor borderWidth: bw borderColor: bc
- "Draw the given polygon."
- ^myCanvas
- drawPolygon: vertices
- color: aColor
- borderWidth: bw
- borderColor: (self mapColor: bc)!
Item was removed:
- ----- Method: ColorMappingCanvas>>drawString:from:to:in:font:color: (in category 'drawing-text') -----
- drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c
- "Draw the given string in the given font and color clipped to the given rectangle. If the font is nil, the default font is used."
- myCanvas
- drawString: s from: firstIndex to: lastIndex
- in: boundsRect
- font: fontOrNil
- color: (self mapColor: c)!
Item was removed:
- ----- Method: ColorMappingCanvas>>extent (in category 'accessing') -----
- extent
- ^myCanvas extent!
Item was removed:
- ----- Method: ColorMappingCanvas>>fillOval:color:borderWidth:borderColor: (in category 'drawing-ovals') -----
- fillOval: r color: c borderWidth: borderWidth borderColor: borderColor
- "Fill the given oval."
- myCanvas
- fillOval: r
- color: (self mapColor: c)
- borderWidth: borderWidth
- borderColor: (self mapColor: borderColor)!
Item was removed:
- ----- Method: ColorMappingCanvas>>flush (in category 'initialization') -----
- flush
- myCanvas flush.!
Item was removed:
- ----- Method: ColorMappingCanvas>>form (in category 'accessing') -----
- form
- ^myCanvas form!
Item was removed:
- ----- Method: ColorMappingCanvas>>frameAndFillRectangle:fillColor:borderWidth:borderColor: (in category 'drawing-rectangles') -----
- frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth borderColor: borderColor
- "Draw the rectangle using the given attributes"
- myCanvas
- frameAndFillRectangle: r
- fillColor: (self mapColor: fillColor)
- borderWidth: borderWidth
- borderColor: (self mapColor: borderColor)!
Item was removed:
- ----- Method: ColorMappingCanvas>>frameAndFillRectangle:fillColor:borderWidth:topLeftColor:bottomRightColor: (in category 'drawing-rectangles') -----
- frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth topLeftColor: topLeftColor bottomRightColor: bottomRightColor
- "Draw the rectangle using the given attributes"
- myCanvas
- frameAndFillRectangle: r
- fillColor: (self mapColor: fillColor)
- borderWidth: borderWidth
- topLeftColor: (self mapColor: topLeftColor)
- bottomRightColor: (self mapColor: bottomRightColor)!
Item was removed:
- ----- Method: ColorMappingCanvas>>frameAndFillRoundRect:radius:fillStyle:borderWidth:borderColor: (in category 'drawing-rectangles') -----
- frameAndFillRoundRect: aRectangle radius: cornerRadius fillStyle: fillStyle borderWidth: bw borderColor: bc
- "Draw the rectangle using the given attributes"
- myCanvas
- frameAndFillRoundRect: aRectangle
- radius: cornerRadius
- fillStyle: (self mapFillStyle: fillStyle)
- borderWidth: bw
- borderColor: (self mapColor: bc)
- !
Item was removed:
- ----- Method: ColorMappingCanvas>>image:at:sourceRect:rule: (in category 'private') -----
- image: aForm at: aPoint sourceRect: sourceRect rule: rule
- "Draw the given form. For the 'paint' combination rule use stenciling otherwise simply fill the source rectangle."
- ^myCanvas image: aForm at: aPoint sourceRect: sourceRect rule: rule.!
Item was removed:
- ----- Method: ColorMappingCanvas>>isShadowDrawing (in category 'testing') -----
- isShadowDrawing
- ^myCanvas isShadowDrawing!
Item was removed:
- ----- Method: ColorMappingCanvas>>line:to:width:color: (in category 'drawing') -----
- line: pt1 to: pt2 width: w color: c
- "Draw a line using the given width and color"
- myCanvas
- line: pt1
- to: pt2
- width: w
- color: (self mapColor: c).!
Item was removed:
- ----- Method: ColorMappingCanvas>>mapColor: (in category 'private') -----
- mapColor: aColor
- ^aColor!
Item was removed:
- ----- Method: ColorMappingCanvas>>mapFillStyle: (in category 'private') -----
- mapFillStyle: aFillStyle
-
- ^ aFillStyle isGradientFill
- ifFalse: [self mapColor: aFillStyle asColor]
- ifTrue: [aFillStyle copy colorRamp: (aFillStyle colorRamp collect: [:assoc | assoc key -> (self mapColor: assoc value)])].
- !
Item was removed:
- ----- Method: ColorMappingCanvas>>on: (in category 'initialization') -----
- on: aCanvas
- myCanvas := aCanvas.!
Item was removed:
- ----- Method: ColorMappingCanvas>>origin (in category 'accessing') -----
- origin
- ^myCanvas origin!
Item was removed:
- ----- Method: ColorMappingCanvas>>paragraph:bounds:color: (in category 'drawing') -----
- paragraph: paragraph bounds: bounds color: c
- "Draw the given paragraph"
- myCanvas
- paragraph: paragraph
- bounds: bounds
- color: (self mapColor: c)!
Item was removed:
- ----- Method: ColorMappingCanvas>>preserveStateDuring: (in category 'drawing-support') -----
- preserveStateDuring: aBlock
- "Preserve the full canvas state during the execution of aBlock"
- | oldCanvas result |
- oldCanvas := myCanvas.
- result := myCanvas preserveStateDuring:[:newCanvas|
- myCanvas := newCanvas.
- aBlock value: self].
- myCanvas := oldCanvas.
- ^result!
Item was removed:
- ----- Method: ColorMappingCanvas>>reset (in category 'initialization') -----
- reset
- myCanvas reset.!
Item was removed:
- ----- Method: ColorMappingCanvas>>stencil:at:color: (in category 'drawing-images') -----
- stencil: aForm at: aPoint color: aColor
- myCanvas
- stencil: aForm
- at: aPoint
- color: (self mapColor: aColor)!
Item was removed:
- ----- Method: ColorMappingCanvas>>stencil:at:sourceRect:color: (in category 'drawing-images') -----
- stencil: aForm at: aPoint sourceRect: aRect color: aColor
- myCanvas
- stencil: aForm
- at: aPoint
- sourceRect: aRect
- color: (self mapColor: aColor)!
Item was removed:
- ----- Method: ColorMappingCanvas>>transformBy:clippingTo:during:smoothing: (in category 'drawing-support') -----
- transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize
-
- "Transform the receiver by the given display transformation during the execution of aBlock. The given clip rectangle defines the *global* (e.g., outer) rectangle against which the receiver should clip (which would be equivalent to 'self clipRect: aClipRect; transformBy: aDisplayTransform')."
- | oldCanvas |
- oldCanvas := myCanvas.
- myCanvas transformBy: aDisplayTransform
- clippingTo: aClipRect
- during: [:newCanvas |
- myCanvas := newCanvas.
- aBlock value: self]
- smoothing: cellSize.
- myCanvas := oldCanvas.!
Item was removed:
- ----- Method: ColorMappingCanvas>>translateBy:clippingTo:during: (in category 'other') -----
- translateBy: delta clippingTo: aRectangle during: aBlock
- "Set a translation and clipping rectangle only during the execution of aBlock."
- | oldCanvas |
- oldCanvas := myCanvas.
- myCanvas translateBy: delta clippingTo: aRectangle during:[:newCanvas|
- myCanvas := newCanvas.
- aBlock value: self].
- myCanvas := oldCanvas.!
Item was removed:
- ----- Method: ColorMappingCanvas>>translateBy:during: (in category 'drawing-support') -----
- translateBy: delta during: aBlock
- "Set a translation only during the execution of aBlock."
- | oldCanvas |
- oldCanvas := myCanvas.
- myCanvas translateBy: delta during:[:newCanvas|
- myCanvas := newCanvas.
- aBlock value: self].
- myCanvas := oldCanvas.!
Item was removed:
- ----- Method: ColorMappingCanvas>>translateTo:clippingTo:during: (in category 'drawing-support') -----
- translateTo: newOrigin clippingTo: aRectangle during: aBlock
- "Set a new origin and clipping rectangle only during the execution of aBlock."
- | oldCanvas |
- oldCanvas := myCanvas.
- myCanvas translateTo: newOrigin clippingTo: aRectangle during:[:newCanvas|
- myCanvas := newCanvas.
- aBlock value: self].
- myCanvas := oldCanvas.!
Item was removed:
- FormCanvas subclass: #ColorPatchCanvas
- instanceVariableNames: 'stopMorph foundMorph doStop'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Support'!
-
- !ColorPatchCanvas commentStamp: '<historical>' prior: 0!
- I generate patches of Morphic worlds that views below certain Morphs. This facility is used for the end-user scripting system.!
Item was removed:
- ----- Method: ColorPatchCanvas>>clipBy:during: (in category 'drawing-support') -----
- clipBy: aRectangle during: aBlock
- "Set a clipping rectangle active only during the execution of aBlock.
- Note: In the future we may want to have more general clip shapes - not just rectangles"
- | tempCanvas |
- tempCanvas := (self copyClipRect: aRectangle).
- aBlock value: tempCanvas.
- foundMorph := tempCanvas foundMorph.!
Item was removed:
- ----- Method: ColorPatchCanvas>>doStop (in category 'accessing') -----
- doStop
- ^doStop!
Item was removed:
- ----- Method: ColorPatchCanvas>>doStop: (in category 'accessing') -----
- doStop: aBoolean
- doStop := aBoolean!
Item was removed:
- ----- Method: ColorPatchCanvas>>foundMorph (in category 'accessing') -----
- foundMorph
- ^foundMorph!
Item was removed:
- ----- Method: ColorPatchCanvas>>foundMorph: (in category 'accessing') -----
- foundMorph: aBoolean
- foundMorph := aBoolean!
Item was removed:
- ----- Method: ColorPatchCanvas>>fullDrawMorph: (in category 'drawing-general') -----
- fullDrawMorph: aMorph
- (foundMorph and:[doStop]) ifTrue:[^self]. "Found it and should stop"
- aMorph == stopMorph ifTrue:[
- "Never draw the stopMorph"
- foundMorph := true.
- ^self].
- ^super fullDrawMorph: aMorph.!
Item was removed:
- ----- Method: ColorPatchCanvas>>preserveStateDuring: (in category 'drawing-support') -----
- preserveStateDuring: aBlock
- "Preserve the full canvas state during the execution of aBlock.
- Note: This does *not* include the state in the receiver (e.g., foundMorph)."
- | tempCanvas result |
- tempCanvas := self copy.
- result := aBlock value: tempCanvas.
- foundMorph := tempCanvas foundMorph.
- ^result!
Item was removed:
- ----- Method: ColorPatchCanvas>>reset (in category 'initialization') -----
- reset
- "Initialize the receiver to act just as a FormCanvas"
- super reset.
- foundMorph := false.
- doStop := false.
- stopMorph := nil.!
Item was removed:
- ----- Method: ColorPatchCanvas>>setForm: (in category 'private') -----
- setForm: aForm
- "Initialize the receiver to act just as a FormCanvas"
- super setForm: aForm.
- stopMorph := nil.
- doStop := false.
- foundMorph := false.!
Item was removed:
- ----- Method: ColorPatchCanvas>>stopMorph (in category 'accessing') -----
- stopMorph
- ^stopMorph!
Item was removed:
- ----- Method: ColorPatchCanvas>>stopMorph: (in category 'accessing') -----
- stopMorph: aMorph
- stopMorph := aMorph!
Item was removed:
- ----- Method: ColorPatchCanvas>>transformBy:clippingTo:during:smoothing: (in category 'drawing-support') -----
- transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize
- "Note: This method has been originally copied from TransformationMorph."
- | innerRect patchRect sourceQuad warp start subCanvas |
- aDisplayTransform isPureTranslation ifTrue: [
- ^ self
- translateBy: (aDisplayTransform localPointToGlobal: 0 at 0) truncated
- clippingTo: aClipRect
- during: aBlock].
- "Prepare an appropriate warp from patch to innerRect"
- innerRect := aClipRect.
- patchRect := aDisplayTransform globalBoundsToLocal:
- (self clipRect intersect: innerRect).
- sourceQuad := (aDisplayTransform sourceQuadFor: innerRect)
- collect: [:p | p - patchRect topLeft].
- warp := self warpFrom: sourceQuad toRect: innerRect.
- warp cellSize: cellSize.
-
- "Render the submorphs visible in the clipping rectangle, as patchForm"
- start := (self depth = 1 and: [self isShadowDrawing not])
- "If this is true B&W, then we need a first pass for erasure."
- ifTrue: [1] ifFalse: [2].
- start to: 2 do:
- [:i | "If i=1 we first make a shadow and erase it for opaque whites in B&W"
- subCanvas := ColorPatchCanvas extent: patchRect extent depth: self depth.
- subCanvas stopMorph: stopMorph.
- subCanvas foundMorph: foundMorph.
- subCanvas doStop: doStop.
- i=1 ifTrue: [subCanvas shadowColor: Color black.
- warp combinationRule: Form erase]
- ifFalse: [self isShadowDrawing ifTrue:
- [subCanvas shadowColor: self shadowColor].
- warp combinationRule: Form paint].
- subCanvas
- translateBy: patchRect topLeft negated
- during: aBlock.
- i = 2 ifTrue:[foundMorph := subCanvas foundMorph].
- warp sourceForm: subCanvas form; warpBits.
- warp sourceForm: nil. subCanvas := nil "release space for next loop"]
- !
Item was removed:
- ----- Method: ColorPatchCanvas>>translateBy:clippingTo:during: (in category 'other') -----
- translateBy: delta clippingTo: aRectangle during: aBlock
- "Set a translation and clipping rectangle only during the execution of aBlock."
- | tempCanvas |
- tempCanvas := self copyOffset: delta clipRect: aRectangle.
- aBlock value: tempCanvas.
- foundMorph := tempCanvas foundMorph.!
Item was removed:
- ----- Method: ColorPatchCanvas>>translateBy:during: (in category 'drawing-support') -----
- translateBy: delta during: aBlock
- "Set a translation only during the execution of aBlock."
- | tempCanvas |
- tempCanvas := self copyOffset: delta.
- aBlock value: tempCanvas.
- foundMorph := tempCanvas foundMorph.!
Item was removed:
- ----- Method: ColorPatchCanvas>>translateTo:clippingTo:during: (in category 'drawing-support') -----
- translateTo: newOrigin clippingTo: aRectangle during: aBlock
- "Set a new origin and clipping rectangle only during the execution of aBlock."
- | tempCanvas |
- tempCanvas := self copyOrigin: newOrigin clipRect: aRectangle.
- aBlock value: tempCanvas.
- foundMorph := tempCanvas foundMorph.!
Item was removed:
- SketchMorph subclass: #ColorPickerMorph
- instanceVariableNames: 'selectedColor sourceHand deleteOnMouseUp updateContinuously target selector argument originalColor theSelectorDisplayMorph command isModal clickedTranslucency noChart'
- classVariableNames: 'ColorChart DragBox FeedbackBox RevertBox TransText TransparentBox'
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !ColorPickerMorph commentStamp: 'kfr 10/27/2003 16:16' prior: 0!
- A gui for setting color and transparency. Behaviour can be changed with the Preference modalColorPickers.!
Item was removed:
- ----- Method: ColorPickerMorph class>>colorPaletteForDepth:extent: (in category 'class initialization') -----
- colorPaletteForDepth: depth extent: chartExtent
- "Display a palette of colors sorted horizontally by hue and vertically by lightness. Useful for eyeballing the color gamut of the display, or for choosing a color interactively."
- "Note: It is slow to build this palette, so it should be cached for quick access."
- "(Color colorPaletteForDepth: 16 extent: 190 at 60) display"
-
- | startHue palette transHt vSteps transCaption grayWidth hSteps y c x |
- palette := Form extent: chartExtent depth: depth.
- transCaption := "(DisplayText text: 'no color' asText textStyle: (TextConstants at: #ComicPlain)) form storeString"
- (Form extent: 34 at 9 depth: 1
- fromArray: #(0 0 256 0 256 0 3808663859 2147483648 2491688266 2147483648 2491688266 0 2491688266 0 2466486578 0 0 0)
- offset: 0 at 0).
- transHt := transCaption height.
- palette fillWhite: (0 at 0 extent: palette width at transHt).
- palette fillBlack: (0 at transHt extent: palette width at 1).
- transCaption displayOn: palette at: palette boundingBox topCenter - ((transCaption width // 2)@0).
- grayWidth := 10.
- startHue := 338.0.
- vSteps := palette height - transHt // 2.
- hSteps := palette width - grayWidth.
- x := 0.
- startHue to: startHue + 360.0 by: 360.0/hSteps do: [:h | | basicHue |
- basicHue := Color h: h asFloat s: 1.0 v: 1.0.
- y := transHt+1.
- 0 to: vSteps do: [:n |
- c := basicHue mixed: (n asFloat / vSteps asFloat) with: Color white.
- palette fill: (x at y extent: 1 at 1) fillColor: c.
- y := y + 1].
- 1 to: vSteps do: [:n |
- c := Color black mixed: (n asFloat / vSteps asFloat) with: basicHue.
- palette fill: (x at y extent: 1 at 1) fillColor: c.
- y := y + 1].
- x := x + 1].
- y := transHt + 1.
- 1 to: vSteps * 2 do: [:n |
- c := Color black mixed: (n asFloat / (vSteps*2) asFloat) with: Color white.
- palette fill: (x at y extent: 10 at 1) fillColor: c.
- y := y + 1].
- ^ palette
- !
Item was removed:
- ----- Method: ColorPickerMorph class>>initialize (in category 'class initialization') -----
- initialize
- "ColorPickerMorph initialize"
-
- ColorChart := ColorPickerMorph colorPaletteForDepth: 16 extent: 190 at 60.
- DragBox := (11 at 0) extent: 9 at 8.
- RevertBox := (ColorChart width - 20)@1 extent: 9 at 8.
- FeedbackBox := (ColorChart width - 10)@1 extent: 9 at 8.
- TransparentBox := DragBox topRight corner: RevertBox bottomLeft.
-
- ColorChart fillBlack: ((DragBox left - 1)@0 extent: 1 at 9).
- ColorChart fillBlack: ((TransparentBox left)@0 extent: 1 at 9).
- ColorChart fillBlack: ((FeedbackBox left - 1)@0 extent: 1 at 9).
- ColorChart fillBlack: ((RevertBox left - 1)@0 extent: 1 at 9).
- (Form dotOfSize: 5) displayOn: ColorChart at: DragBox center + (0 at 1).
-
- self localeChanged.!
Item was removed:
- ----- Method: ColorPickerMorph class>>localeChanged (in category 'class initialization') -----
- localeChanged
- | formTranslator |
- formTranslator := NaturalLanguageFormTranslator localeID: Locale current localeID.
- TransText := formTranslator translate: 'translucent'.
- TransText
- ifNil: [TransText := Form
- extent: 63 @ 8
- depth: 1
- fromArray: #(4194306 1024 4194306 1024 15628058 2476592640 4887714 2485462016 1883804850 2486772764 4756618 2485462016 4748474 1939416064 0 0 )
- offset: 0 @ 0].
- TransText := ColorForm mappingWhiteToTransparentFrom: TransText!
Item was removed:
- ----- Method: ColorPickerMorph class>>noColorCaption (in category 'class initialization') -----
- noColorCaption
- | formTranslator |
- formTranslator := NaturalLanguageFormTranslator localeID: Locale current localeID.
- ^ (formTranslator translate: 'no color')
- ifNil: [Form
- extent: 34 @ 9
- depth: 1
- fromArray: #(0 0 256 0 256 0 3808663859 2147483648 2491688266 2147483648 2491688266 0 2491688266 0 2466486578 0 0 0 )
- offset: 0 @ 0]
- !
Item was removed:
- ----- Method: ColorPickerMorph class>>perniciousBorderColor (in category 'constants') -----
- perniciousBorderColor
- "Answer the color of the border lines of a color picker; this color gets reported as you drag the mouse through from the translucent box to the true color area, for example, and can cause some difficulties in some special cases, so it is faithfully reported here in this hard-coded fashion in order that energetic clients wishing to handle it as special-case it can do so."
-
- ^ Color r: 0.0 g: 0.0 b: 0.032!
Item was removed:
- ----- Method: ColorPickerMorph>>addCustomMenuItems:hand: (in category 'menu') -----
- addCustomMenuItems: aCustomMenu hand: aHandMorph
-
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- deleteOnMouseUp
- ifTrue: [aCustomMenu add: 'stay up' translated action: #toggleDeleteOnMouseUp]
- ifFalse: [aCustomMenu add: 'do not stay up' translated action: #toggleDeleteOnMouseUp].
- updateContinuously
- ifTrue: [aCustomMenu add: 'update only at end' translated action: #toggleUpdateContinuously]
- ifFalse: [aCustomMenu add: 'update continuously' translated action: #toggleUpdateContinuously].
- !
Item was removed:
- ----- Method: ColorPickerMorph>>addToWorld:near: (in category 'other') -----
- addToWorld: world near: box
- | goodLocation |
- goodLocation := self bestPositionNear: box inWorld: world.
- world allMorphsDo:
- [:p | (p isMemberOf: ColorPickerMorph) ifTrue:
- [(p ~~ self and: [p owner notNil and: [p target == target]]) ifTrue:
- [(p selector == selector and: [p argument == argument])
- ifTrue: [^ p comeToFront "uncover existing picker"]
- ifFalse: ["place second picker relative to first"
- goodLocation := self bestPositionNear: p bounds inWorld: world]]]].
- self position: goodLocation.
- world addMorphFront: self.
- self changed
- !
Item was removed:
- ----- Method: ColorPickerMorph>>anchorAndRunModeless: (in category 'private') -----
- anchorAndRunModeless: aHand
- "If user clicks on the drag-dot of a modal picker,
- anchor it, and change to modeless operation."
-
- aHand showTemporaryCursor: nil. "revert to normal cursor"
- self initializeModal: false; originalColor: originalColor. "reset as modeless"
- aHand flushEvents. "Drop any events gathered during modal loop"
- aHand position: Sensor cursorPoint; grabMorph: self. "Slip into drag operation"
- !
Item was removed:
- ----- Method: ColorPickerMorph>>argument (in category 'accessing') -----
- argument
- ^argument!
Item was removed:
- ----- Method: ColorPickerMorph>>argument: (in category 'accessing') -----
- argument: anObject
- argument := anObject!
Item was removed:
- ----- Method: ColorPickerMorph>>argumentsWith: (in category 'private') -----
- argumentsWith: aColor
- "Return an argument array appropriate to this action selector"
-
- | nArgs |
- nArgs := selector ifNil:[0] ifNotNil:[selector numArgs].
- nArgs = 0 ifTrue:[^#()].
- nArgs = 1 ifTrue:[^ {aColor}].
- nArgs = 2 ifTrue:[^ {aColor. sourceHand}].
- nArgs = 3 ifTrue:[^ {aColor. argument. sourceHand}].
- !
Item was removed:
- ----- Method: ColorPickerMorph>>bestPositionNear:inWorld: (in category 'other') -----
- bestPositionNear: box inWorld: world
- | points b |
- points := #(topCenter rightCenter bottomCenter leftCenter). "possible anchors"
- 1 to: 4 do:
- [:i | "Try the four obvious anchor points"
- b := self bounds align: (self bounds perform: (points at: i))
- with: (box perform: (points atWrap: i + 2)).
- (world viewBox containsRect: b) ifTrue:
- [^ b topLeft" Yes, it fits"]].
-
- ^ 20 at 20 "when all else fails"
- !
Item was removed:
- ----- Method: ColorPickerMorph>>buildChartForm (in category 'initialization') -----
- buildChartForm
- | chartForm |
- chartForm := ColorChart deepCopy asFormOfDepth: Display depth.
- chartForm fill: ((TransparentBox left + 9)@0 extent: 1 at 9) fillColor: Color lightGray.
- chartForm fill: ((TransparentBox right - 10)@0 extent: 1 at 9) fillColor: Color lightGray.
- TransText displayOn: chartForm at: 62 at 0.
- Display depth = 32 ifTrue:
- ["Set opaque bits for 32-bit display"
- chartForm fill: chartForm boundingBox rule: Form under
- fillColor: (Color r: 0.0 g: 0.0 b: 0.0 alpha: 1.0)].
- chartForm borderWidth: 1.
- self form: chartForm.
- selectedColor ifNotNil: [self updateAlpha: selectedColor alpha].
- self updateSelectorDisplay.
-
- !
Item was removed:
- ----- Method: ColorPickerMorph>>choseModalityFromPreference (in category 'initialization') -----
- choseModalityFromPreference
- "Decide whether to be modal or not by consulting the prevailing preference"
-
- self initializeModal: Preferences modalColorPickers!
Item was removed:
- ----- Method: ColorPickerMorph>>containsPoint: (in category 'geometry testing') -----
- containsPoint: aPoint
- ^ (super containsPoint: aPoint)
- or: [RevertBox containsPoint: aPoint - self topLeft]!
Item was removed:
- ----- Method: ColorPickerMorph>>delete (in category 'submorphs - add/remove') -----
- delete
- "The moment of departure has come.
- If the receiver has an affiliated command, finalize it and have the system remember it.
- In any case, delete the receiver"
-
- (selector isNil or: [ target isNil ]) ifFalse: [
- self rememberCommand:
- (Command new
- cmdWording: 'color change' translated;
- undoTarget: target selector: selector arguments: (self argumentsWith: originalColor);
- redoTarget: target selector: selector arguments: (self argumentsWith: selectedColor)).
- ].
- super delete!
Item was removed:
- ----- Method: ColorPickerMorph>>deleteAllBalloons (in category 'private') -----
- deleteAllBalloons
-
- self submorphsDo: [:m | m deleteBalloon].
- !
Item was removed:
- ----- Method: ColorPickerMorph>>deleteOnMouseUp (in category 'accessing') -----
- deleteOnMouseUp
-
- ^ deleteOnMouseUp
- !
Item was removed:
- ----- Method: ColorPickerMorph>>deleteOnMouseUp: (in category 'accessing') -----
- deleteOnMouseUp: aBoolean
-
- deleteOnMouseUp := aBoolean.
- !
Item was removed:
- ----- Method: ColorPickerMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- aCanvas depth = 1 ifTrue: [aCanvas fillRectangle: self bounds color: Color white].
- Display depth = originalForm depth ifFalse: [self buildChartForm].
- super drawOn: aCanvas!
Item was removed:
- ----- Method: ColorPickerMorph>>getColorFromKedamaWorldIfPossible: (in category 'kedama') -----
- getColorFromKedamaWorldIfPossible: aGlobalPoint
-
- self world submorphs do: [:sub |
- (sub isKedamaMorph) ifTrue: [
- sub morphsAt: aGlobalPoint unlocked: false do: [:e |
- ^ e colorAt: (aGlobalPoint - e topLeft).
- ].
- ].
- ].
- ^ nil.
- !
Item was removed:
- ----- Method: ColorPickerMorph>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: evt
-
- ^ true
- !
Item was removed:
- ----- Method: ColorPickerMorph>>indicateColorUnderMouse (in category 'other') -----
- indicateColorUnderMouse
- "Track the mouse with the special eyedropper cursor, and accept whatever color is under the mouse as the currently-chosen color; reflect that choice in the feedback box, and return that color."
-
- | pt |
- self pickColorAt: (pt := Sensor cursorPoint).
- isModal ifTrue:
- [self activeHand position: pt.
- self world displayWorldSafely; runStepMethods].
- ^ selectedColor !
Item was removed:
- ----- Method: ColorPickerMorph>>inhibitDragging (in category 'event handling') -----
- inhibitDragging
-
- ^self hasProperty: #noDraggingThisPicker!
Item was removed:
- ----- Method: ColorPickerMorph>>initialize (in category 'initialization') -----
- initialize
- "Initialize the receiver. Obey the modalColorPickers preference when deciding how to configure myself. This is not quite satisfactory -- we'd like to have explicit calls tell us things like whether whether to be modal, whether to allow transparency, but for the moment, in grand Morphic fashion, this is rather inflexibly all housed right here"
-
- super initialize.
- self clipSubmorphs: true.
- self buildChartForm.
-
- selectedColor := Color white.
- sourceHand := nil.
- deleteOnMouseUp := false.
- clickedTranslucency := false.
- updateContinuously := true.
- selector := nil.
- target := nil!
Item was removed:
- ----- Method: ColorPickerMorph>>initializeForPropertiesPanel (in category 'initialization') -----
- initializeForPropertiesPanel
- "Initialize the receiver. If beModal is true, it will be a modal color picker, else not"
-
- isModal := false.
- self removeAllMorphs.
- self setProperty: #noDraggingThisPicker toValue: true.
-
- self addMorph: ((Morph newBounds: (RevertBox translateBy: self topLeft))
- color: Color transparent; setCenteredBalloonText: 'restore original color' translated).
- self addMorph: ((Morph newBounds: (FeedbackBox translateBy: self topLeft))
- color: Color transparent; setCenteredBalloonText: 'shows selected color' translated).
- self addMorph: ((Morph newBounds: (TransparentBox translateBy: self topLeft))
- color: Color transparent; setCenteredBalloonText: 'adjust translucency' translated).
-
- self buildChartForm.
-
- selectedColor ifNil: [selectedColor := Color white].
- sourceHand := nil.
- deleteOnMouseUp := false.
- updateContinuously := true.
- !
Item was removed:
- ----- Method: ColorPickerMorph>>initializeModal: (in category 'initialization') -----
- initializeModal: beModal
- "Initialize the receiver. If beModal is true, it will be a modal color picker, else not"
-
- isModal := beModal.
- self removeAllMorphs.
- isModal ifFalse:
- [theSelectorDisplayMorph := AlignmentMorph newRow
- color: Color white;
- borderWidth: 1;
- borderColor: Color red;
- hResizing: #shrinkWrap;
- vResizing: #shrinkWrap;
- addMorph: (StringMorph contents: 'theSelector' translated).
- self addMorph: theSelectorDisplayMorph.
-
- self addMorph: (SimpleButtonMorph new borderWidth: 0;
- label: 'x' font: nil; color: Color transparent;
- actionSelector: #delete; target: self; useSquareCorners;
- position: self topLeft - (0 at 3); extent: 10 at 12;
- setCenteredBalloonText: 'dismiss color picker' translated)].
-
- self addMorph: ((Morph newBounds: (DragBox translateBy: self topLeft))
- color: Color transparent; setCenteredBalloonText: 'put me somewhere' translated).
- self addMorph: ((Morph newBounds: (RevertBox translateBy: self topLeft))
- color: Color transparent; setCenteredBalloonText: 'restore original color' translated).
- self addMorph: ((Morph newBounds: (FeedbackBox translateBy: self topLeft))
- color: Color transparent; setCenteredBalloonText: 'shows selected color' translated).
- self addMorph: ((Morph newBounds: (TransparentBox translateBy: self topLeft))
- color: Color transparent; setCenteredBalloonText: 'adjust translucency' translated).
-
- self buildChartForm.
-
- selectedColor ifNil: [selectedColor := Color white].
- sourceHand := nil.
- deleteOnMouseUp := false.
- updateContinuously := true.
- !
Item was removed:
- ----- Method: ColorPickerMorph>>isLikelyRecipientForMouseOverHalos (in category 'halos and balloon help') -----
- isLikelyRecipientForMouseOverHalos
- ^ false!
Item was removed:
- ----- Method: ColorPickerMorph>>locationIndicator (in category 'accessing') -----
- locationIndicator
-
- ^self valueOfProperty: #locationIndicator ifAbsent:[ | loc |
- loc := EllipseMorph new.
- loc color: Color transparent;
- borderWidth: 1;
- borderColor: Color red;
- extent: 6 at 6.
- self setProperty: #locationIndicator toValue: loc.
- self addMorphFront: loc.
- loc]!
Item was removed:
- ----- Method: ColorPickerMorph>>modalBalloonHelpAtPoint: (in category 'private') -----
- modalBalloonHelpAtPoint: cursorPoint
- self flag: #arNote. "Throw this away. There needs to be another way."
- self submorphsDo:
- [:m |
- m wantsBalloon
- ifTrue:
- [(m valueOfProperty: #balloon) isNil
- ifTrue:
- [(m containsPoint: cursorPoint) ifTrue: [m showBalloon: m balloonText at: (m topCenter ).
- m setProperty: #balloon toValue: true]]
- ifFalse: [(m containsPoint: cursorPoint) ifFalse: [self deleteBalloon.
- m setProperty: #balloon toValue:nil]]]]!
Item was removed:
- ----- Method: ColorPickerMorph>>mouseDown: (in category 'event handling') -----
- mouseDown: evt
- | localPt |
- localPt := evt cursorPoint - self topLeft.
- self deleteAllBalloons.
- clickedTranslucency := TransparentBox containsPoint: localPt.
- self inhibitDragging ifFalse: [
- (DragBox containsPoint: localPt)
- ifTrue: [^ evt hand grabMorph: self].
- ].
- (RevertBox containsPoint: localPt)
- ifTrue: [^ self updateColor: originalColor feedbackColor: originalColor].
- self inhibitDragging ifFalse: [self comeToFront].
- sourceHand := evt hand.
- self startStepping.
- !
Item was removed:
- ----- Method: ColorPickerMorph>>mouseUp: (in category 'event handling') -----
- mouseUp: evt
-
- | c |
- self stopStepping.
- sourceHand := nil.
- deleteOnMouseUp ifTrue: [self delete].
- c := self getColorFromKedamaWorldIfPossible: evt cursorPoint.
- c ifNotNil: [selectedColor := c].
- self updateTargetColor.
- !
Item was removed:
- ----- Method: ColorPickerMorph>>originalColor: (in category 'accessing') -----
- originalColor: colorOrSymbol
- "Set the receiver's original color. It is at this point that a command is launched to represent the action of the picker, in support of Undo."
-
- originalColor := (colorOrSymbol isColor)
- ifTrue: [colorOrSymbol]
- ifFalse: [Color lightGreen].
- originalForm fill: RevertBox fillColor: originalColor.
- selectedColor := originalColor.
- self updateAlpha: originalColor alpha.
- self locationIndicator
- center: self topLeft + (self positionOfColor: originalColor)!
Item was removed:
- ----- Method: ColorPickerMorph>>pickColorAt: (in category 'private') -----
- pickColorAt: aGlobalPoint
-
- | alpha selfRelativePoint pickedColor c |
- clickedTranslucency ifNil: [clickedTranslucency := false].
- selfRelativePoint := (self globalPointToLocal: aGlobalPoint) - self topLeft.
- (FeedbackBox containsPoint: selfRelativePoint) ifTrue: [^ self].
- (RevertBox containsPoint: selfRelativePoint)
- ifTrue: [^ self updateColor: originalColor feedbackColor: originalColor].
-
- "check for transparent color and update using appropriate feedback color "
- (TransparentBox containsPoint: selfRelativePoint) ifTrue:
- [clickedTranslucency ifFalse: [^ self]. "Can't wander into translucency control"
- alpha := (selfRelativePoint x - TransparentBox left - 10) asFloat /
- (TransparentBox width - 20)
- min: 1.0 max: 0.0.
- "(alpha roundTo: 0.01) printString , ' ' displayAt: 0 at 0." " -- debug"
- self
- updateColor: (selectedColor alpha: alpha)
- feedbackColor: (selectedColor alpha: alpha).
- ^ self].
-
- "pick up color, either inside or outside this world"
- clickedTranslucency ifTrue: [^ self]. "Can't wander out of translucency control"
- self locationIndicator visible: false. self refreshWorld.
- pickedColor := Display colorAt: aGlobalPoint.
- c := self getColorFromKedamaWorldIfPossible: aGlobalPoint.
- c ifNotNil: [pickedColor := c].
- self locationIndicator visible: true. self refreshWorld.
- self
- updateColor: (
- (selectedColor isColor and: [selectedColor isTranslucentColor])
- ifTrue: [pickedColor alpha: selectedColor alpha]
- ifFalse: [pickedColor]
- )
- feedbackColor: pickedColor!
Item was removed:
- ----- Method: ColorPickerMorph>>pickUpColorFor: (in category 'menu') -----
- pickUpColorFor: aMorph
- "Show the eyedropper cursor, and modally track the mouse through a mouse-down and mouse-up cycle"
-
- | aHand localPt c |
- aHand := aMorph ifNil: [self activeHand] ifNotNil: [aMorph activeHand].
- aHand ifNil: [aHand := self currentHand].
- self addToWorld: aHand world near: (aMorph ifNil: [aHand world]) fullBounds.
- self owner ifNil: [^ self].
-
- aHand showTemporaryCursor: (ScriptingSystem formAtKey: #Eyedropper)
- hotSpotOffset: 2 at 14. "<<<< the form was changed a bit??"
-
- self updateContinuously: false.
- [Sensor anyButtonPressed]
- whileFalse:
- [self trackColorUnderMouse].
- self deleteAllBalloons.
-
- localPt := Sensor cursorPoint - self topLeft.
- self inhibitDragging ifFalse: [
- (DragBox containsPoint: localPt) ifTrue:
- ["Click or drag the drag-dot means to anchor as a modeless picker"
- ^ self anchorAndRunModeless: aHand].
- ].
- (clickedTranslucency := TransparentBox containsPoint: localPt)
- ifTrue: [selectedColor := originalColor].
-
- self updateContinuously: true.
- [Sensor anyButtonPressed]
- whileTrue:
- [self updateTargetColorWith: self indicateColorUnderMouse].
- c := self getColorFromKedamaWorldIfPossible: Sensor cursorPoint.
- c ifNotNil: [selectedColor := c].
- aHand newMouseFocus: nil;
- showTemporaryCursor: nil;
- flushEvents.
- self delete.
-
- !
Item was removed:
- ----- Method: ColorPickerMorph>>positionOfColor: (in category 'private') -----
- positionOfColor: aColor
- "Compute the position of the given color in the color chart form"
- | rgbRect x y h s v |
- rgbRect := (0 at 0 extent: originalForm boundingBox extent) insetBy: (1 at 10 corner: 11 at 1).
- h := aColor hue.
- s := aColor saturation.
- v := aColor brightness.
- h = 0.0 ifTrue:["gray"
- ^(rgbRect right + 6) @ (rgbRect height * (1.0 - v) + rgbRect top)].
- x := (h + 22 \\ 360 / 360.0 * rgbRect width) rounded.
- y := 0.5.
- s < 1.0 ifTrue:[y := y - (1.0 - s * 0.5)].
- v < 1.0 ifTrue:[y := y + (1.0 - v * 0.5)].
- y := (y * rgbRect height) rounded.
- ^x at y + (1 at 10)!
Item was removed:
- ----- Method: ColorPickerMorph>>putUpFor:near: (in category 'other') -----
- putUpFor: aMorph near: aRectangle
- "Put the receiver up on the screen. Note highly variant behavior depending on the setting of the #modalColorPickers preference"
- | layerNumber |
- aMorph isMorph ifTrue: [
- layerNumber := aMorph morphicLayerNumber.
- aMorph allOwnersDo:[:m|
- layerNumber := layerNumber min: m morphicLayerNumber].
- self morphicLayerNumber: layerNumber - 0.1
- ].
-
- isModal == true "backward compatibility"
- ifTrue:
- [self pickUpColorFor: aMorph]
- ifFalse:
- [self addToWorld:
- ((aMorph notNil and: [aMorph world notNil])
- ifTrue:
- [aMorph world]
- ifFalse:
- [self currentWorld])
- near:
- (aRectangle ifNil:
- [aMorph ifNil: [100 at 100 extent: 1 at 1] ifNotNil: [aMorph fullBoundsInWorld]])]!
Item was removed:
- ----- Method: ColorPickerMorph>>selectedColor (in category 'accessing') -----
- selectedColor
-
- ^ selectedColor
- !
Item was removed:
- ----- Method: ColorPickerMorph>>selector (in category 'accessing') -----
- selector
-
- ^ selector
- !
Item was removed:
- ----- Method: ColorPickerMorph>>selector: (in category 'accessing') -----
- selector: aSymbol
- "Set the selector to be associated with the receiver. Store it in the receiver's command, if appropriate"
-
- selector := aSymbol.
- self updateSelectorDisplay!
Item was removed:
- ----- Method: ColorPickerMorph>>sourceHand (in category 'accessing') -----
- sourceHand
-
- ^ sourceHand
- !
Item was removed:
- ----- Method: ColorPickerMorph>>sourceHand: (in category 'accessing') -----
- sourceHand: aHand
-
- sourceHand := aHand.
- !
Item was removed:
- ----- Method: ColorPickerMorph>>step (in category 'stepping and presenter') -----
- step
-
- sourceHand ifNotNil:
- [self pickColorAt: sourceHand position].
- !
Item was removed:
- ----- Method: ColorPickerMorph>>stepTime (in category 'stepping and presenter') -----
- stepTime
-
- ^ 50
- !
Item was removed:
- ----- Method: ColorPickerMorph>>target (in category 'accessing') -----
- target
-
- ^ target
- !
Item was removed:
- ----- Method: ColorPickerMorph>>target: (in category 'accessing') -----
- target: anObject
- target := anObject.
- selectedColor := (target respondsTo: #color)
- ifTrue: [target color]
- ifFalse: [Color white]!
Item was removed:
- ----- Method: ColorPickerMorph>>toggleDeleteOnMouseUp (in category 'menu') -----
- toggleDeleteOnMouseUp
-
- deleteOnMouseUp := deleteOnMouseUp not.
- !
Item was removed:
- ----- Method: ColorPickerMorph>>toggleUpdateContinuously (in category 'menu') -----
- toggleUpdateContinuously
-
- updateContinuously := updateContinuously not.
- !
Item was removed:
- ----- Method: ColorPickerMorph>>trackColorAt: (in category 'private') -----
- trackColorAt: aGlobalPoint
- "Before the mouse comes down in a modal color picker, track the color under the cursor, and show it in the feedback box, but do not make transparency changes"
-
- | selfRelativePoint pickedColor |
- selfRelativePoint := (self globalPointToLocal: aGlobalPoint) - self topLeft.
- (FeedbackBox containsPoint: selfRelativePoint) ifTrue: [^ self].
- (RevertBox containsPoint: selfRelativePoint)
- ifTrue: [^ self updateColor: originalColor feedbackColor: originalColor].
-
- "check for transparent color and update using appropriate feedback color "
- (TransparentBox containsPoint: selfRelativePoint) ifTrue: [^ self].
-
- "pick up color, either inside or outside this world"
- pickedColor := Display colorAt: aGlobalPoint.
- self updateColor: (pickedColor alpha: originalColor alpha)
- feedbackColor: pickedColor!
Item was removed:
- ----- Method: ColorPickerMorph>>trackColorUnderMouse (in category 'other') -----
- trackColorUnderMouse
- "Track the mouse with the special eyedropper cursor, and accept whatever color is under the mouse as the currently-chosen color; reflect that choice in the feedback box, and return that color."
-
- | pt |
- selectedColor := originalColor.
- self trackColorAt: (pt := Sensor cursorPoint).
- isModal ifTrue:
- [self activeHand position: pt.
- self world displayWorldSafely; runStepMethods.
- self modalBalloonHelpAtPoint: pt].
- ^ selectedColor !
Item was removed:
- ----- Method: ColorPickerMorph>>updateAlpha: (in category 'private') -----
- updateAlpha: alpha
- | sliderRect |
- sliderRect := (TransparentBox left + 10)@1 corner: (TransparentBox right - 9)@9.
- originalForm fill: (sliderRect withRight: sliderRect left + (alpha*sliderRect width))
- fillColor: Color lightGray.
- originalForm fillWhite: (sliderRect withLeft: sliderRect left + (alpha*sliderRect width)).
- originalForm fill: ((TransparentBox right - 9)@1 extent: 8 at 8)
- fillColor: (alpha < 1.0 ifTrue: [Color white] ifFalse: [Color lightGray]).
- TransText displayOn: originalForm at: 62 at 1 rule: Form paint.
- !
Item was removed:
- ----- Method: ColorPickerMorph>>updateColor:feedbackColor: (in category 'private') -----
- updateColor: aColor feedbackColor: feedbackColor
- "Set my selected color to the given color if it is different. Give user feedback. Inform the target of the change if the target and selector are not nil."
-
- selectedColor = aColor ifTrue: [^ self]. "do nothing if color doesn't change"
-
- self updateAlpha: aColor alpha.
- originalForm fill: FeedbackBox fillColor: feedbackColor.
- self form: originalForm.
- selectedColor := aColor.
- updateContinuously ifTrue: [self updateTargetColor].
- self locationIndicator center: self topLeft + (self positionOfColor: feedbackColor).!
Item was removed:
- ----- Method: ColorPickerMorph>>updateContinuously (in category 'accessing') -----
- updateContinuously
-
- ^ updateContinuously
- !
Item was removed:
- ----- Method: ColorPickerMorph>>updateContinuously: (in category 'accessing') -----
- updateContinuously: aBoolean
-
- updateContinuously := aBoolean.
- !
Item was removed:
- ----- Method: ColorPickerMorph>>updateSelectorDisplay (in category 'initialization') -----
- updateSelectorDisplay
- theSelectorDisplayMorph ifNil: [^self].
- theSelectorDisplayMorph position: self bottomLeft.
- theSelectorDisplayMorph firstSubmorph contents: selector asString , ' ' , selectedColor printString!
Item was removed:
- ----- Method: ColorPickerMorph>>updateTargetColor (in category 'private') -----
- updateTargetColor
- | nArgs |
- (target notNil and: [selector notNil])
- ifTrue:
- [self updateSelectorDisplay.
- nArgs := selector numArgs.
- nArgs = 1 ifTrue: [^target perform: selector with: selectedColor].
- nArgs = 2
- ifTrue:
- [^target
- perform: selector
- with: selectedColor
- with: sourceHand].
- nArgs = 3
- ifTrue:
- [^target
- perform: selector
- with: selectedColor
- with: argument
- with: sourceHand]]!
Item was removed:
- ----- Method: ColorPickerMorph>>updateTargetColorWith: (in category 'private') -----
- updateTargetColorWith: aColor
- "Update the target so that it reflects aColor as the color choice"
-
- (target notNil and: [selector notNil])
- ifTrue:
- [self updateSelectorDisplay.
- ^target perform: selector withArguments: (self argumentsWith: aColor)]!
Item was removed:
- MorphicModel subclass: #ColorPresenterMorph
- instanceVariableNames: 'contentMorph labelMorph solidLabelMorph getColorSelector'
- classVariableNames: 'HatchForm'
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !ColorPresenterMorph commentStamp: 'gvc 5/18/2007 13:38' prior: 0!
- Displays a colour with alpha against a white, hatched and black background.!
Item was removed:
- ----- Method: ColorPresenterMorph class>>hatchForm (in category 'graphics constants') -----
- hatchForm
- "Answer a form showing a grid hatch pattern."
-
- ^HatchForm ifNil: [HatchForm := self newHatchForm]!
Item was removed:
- ----- Method: ColorPresenterMorph class>>newHatchForm (in category 'graphics constants') -----
- newHatchForm
- "Answer a new hatch form."
-
- ^(Form
- extent: 8 at 8
- depth: 1
- fromArray: #( 4026531840 4026531840 4026531840 4026531840 251658240 251658240 251658240 251658240)
- offset: 0 at 0)!
Item was removed:
- ----- Method: ColorPresenterMorph class>>on:color: (in category 'instance creation') -----
- on: anObject color: getSel
- "Answer a new instance of the receiver on the given model using
- the given selectors as the interface."
-
- "(ColorPresenterMorph on: (BorderedMorph new) color: #color) openInWorld"
-
- ^self new
- on: anObject
- color: getSel!
Item was removed:
- ----- Method: ColorPresenterMorph>>contentMorph (in category 'accessing') -----
- contentMorph
- "The outer, containing Morph."
- ^ contentMorph!
Item was removed:
- ----- Method: ColorPresenterMorph>>contentMorph: (in category 'accessing') -----
- contentMorph: aMorph
- "The outer, containing Morph."
- contentMorph := aMorph!
Item was removed:
- ----- Method: ColorPresenterMorph>>getColorSelector (in category 'accessing') -----
- getColorSelector
- "The selector symbol used to retrieve the color from my model."
- ^ getColorSelector!
Item was removed:
- ----- Method: ColorPresenterMorph>>getColorSelector: (in category 'accessing') -----
- getColorSelector: aSymbol
- "The selector symbol used to retrieve the color from my model."
- getColorSelector := aSymbol!
Item was removed:
- ----- Method: ColorPresenterMorph>>initialize (in category 'initializing') -----
- initialize
- "Initialize the receiver."
-
- super initialize.
- self
- borderWidth: 0;
- changeTableLayout;
- labelMorph: self newLabelMorph;
- solidLabelMorph: self newLabelMorph;
- contentMorph: self newContentMorph;
- addMorphBack: self contentMorph!
Item was removed:
- ----- Method: ColorPresenterMorph>>labelMorph (in category 'accessing') -----
- labelMorph
- "The morph that renders the actual color being presented."
- ^ labelMorph!
Item was removed:
- ----- Method: ColorPresenterMorph>>labelMorph: (in category 'accessing') -----
- labelMorph: aMorph
- "The morph that renders the actual color being presented."
- labelMorph := aMorph!
Item was removed:
- ----- Method: ColorPresenterMorph>>newContentMorph (in category 'initializing') -----
- newContentMorph
- "Answer a new content morph"
-
- ^Morph new
- color: Color transparent;
- changeTableLayout;
- borderStyle: (BorderStyle inset width: 1);
- vResizing: #spaceFill;
- hResizing: #spaceFill;
- addMorph: self newHatchMorph;
- yourself!
Item was removed:
- ----- Method: ColorPresenterMorph>>newHatchMorph (in category 'initializing') -----
- newHatchMorph
- "Answer a new morph showing the three backgrounds; white, hatch pattern, and black, against which my labelMorph is displayed."
- ^ Morph new
- color: Color transparent ;
- changeProportionalLayout ;
- vResizing: #spaceFill ;
- hResizing: #spaceFill ;
- minWidth: 48 ;
- minHeight: 12 ;
-
- addMorph: (Morph new color: Color white)
- fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 0.3 @ 1)) ;
-
- addMorph: (Morph new fillStyle: (InfiniteForm with: self class hatchForm))
- fullFrame: (LayoutFrame fractions: (0.3 @ 0 corner: 0.7 @ 1)) ;
-
- addMorph: self solidLabelMorph
- fullFrame: (LayoutFrame fractions: (0.7 @ 0 corner: 1 @ 1)) ;
-
- addMorph: self labelMorph
- fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1))!
Item was removed:
- ----- Method: ColorPresenterMorph>>newLabelMorph (in category 'initializing') -----
- newLabelMorph
- "Answer a new label morph"
-
- ^Morph new!
Item was removed:
- ----- Method: ColorPresenterMorph>>on:color: (in category 'initializing') -----
- on: anObject color: getColSel
- "Set the receiver to the given model parameterized by the given message selectors."
-
- self
- model: anObject;
- getColorSelector: getColSel;
- updateColor!
Item was removed:
- ----- Method: ColorPresenterMorph>>setColor: (in category 'initializing') -----
- setColor: aColor
- "Update the colour of the labels."
-
- self labelMorph color: aColor.
- self solidLabelMorph color: aColor asNontranslucentColor!
Item was removed:
- ----- Method: ColorPresenterMorph>>solidLabelMorph (in category 'accessing') -----
- solidLabelMorph
- "Answer the value of solidLabelMorph"
-
- ^ solidLabelMorph!
Item was removed:
- ----- Method: ColorPresenterMorph>>solidLabelMorph: (in category 'accessing') -----
- solidLabelMorph: anObject
- "Set the value of solidLabelMorph"
-
- solidLabelMorph := anObject!
Item was removed:
- ----- Method: ColorPresenterMorph>>update: (in category 'initializing') -----
- update: aSymbol
- "Refer to the comment in View|update:."
-
- aSymbol == self getColorSelector ifTrue:
- [self updateColor.
- ^ self]!
Item was removed:
- ----- Method: ColorPresenterMorph>>updateColor (in category 'initializing') -----
- updateColor
- "Update the color state."
-
- |col|
- self getColorSelector ifNotNil: [
- col := (self model perform: self getColorSelector) ifNil: [Color transparent].
- self setColor: col]!
Item was removed:
- ----- Method: CompiledCode>>explorerContents (in category '*Morphic-Explorer') -----
- explorerContents
- "(CompiledCode compiledMethodAt: #explorerContents) explore"
-
- ^Array streamContents:
- [:s| | tokens |
- tokens := Scanner new scanTokens: (self headerDescription readStream skipTo: $"; upTo: $").
- s nextPut: (ObjectExplorerWrapper
- with: ((0 to: tokens size by: 2) collect:
- [:i| i = 0 ifTrue: [self header] ifFalse: [{tokens at: i - 1. tokens at: i}]])
- name: 'header'
- model: self).
- (1 to: self numLiterals) do:
- [:key|
- s nextPut: (ObjectExplorerWrapper
- with: (self literalAt: key)
- name: ('literal', key printString contractTo: 32)
- model: self)].
- self isQuick
- ifTrue: [s nextPut: (ObjectExplorerWrapper
- with: self symbolic
- name: #symbolic
- model: self)]
- ifFalse:
- [self symbolicLinesDo:
- [:pc :line|
- pc <= 1
- ifTrue:
- [s nextPut: (ObjectExplorerWrapper
- with: line
- name: 'pragma'
- model: self)]
- ifFalse:
- [s nextPut: (ObjectExplorerWrapper
- with: line
- name: pc printString
- model: self)]]].
- "should be self numLiterals + 1 * Smalltalk wordSize + 1"
- self endPC + 1
- to: self basicSize
- do: [:key|
- s nextPut: (ObjectExplorerWrapper
- with: (self basicAt: key)
- name: key printString
- model: self)]]!
Item was removed:
- SimpleBorder subclass: #ComplexBorder
- instanceVariableNames: 'style colors lineStyles'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Borders'!
-
- !ComplexBorder commentStamp: 'nice 3/24/2010 07:36' prior: 0!
- see BorderedMorph.
-
- poly := polygon250
-
- baseColor := Color blue twiceLighter.
- border := (ComplexBorder framed: 10) baseColor: poly color.
- border frameRectangle: ((100 at 100 extent: 200 at 200) insetBy: -5) on: Display getCanvas.
- baseColor := Color red twiceLighter.
- border := (ComplexBorder framed: 10) baseColor: baseColor.
- border drawPolygon: {100 at 100. 300 at 100. 300 at 300. 100 at 300} on: Display getCanvas.
-
- border drawPolyPatchFrom: 100 at 200 via: 100 at 100 via: 200 at 100 to: 200 at 200 on: Display getCanvas.
- border drawPolyPatchFrom: 100 at 100 via: 200 at 100 via: 200 at 200 to: 100 at 200 on: Display getCanvas.
- border drawPolyPatchFrom: 200 at 100 via: 200 at 200 via: 100 at 200 to: 100 at 100 on: Display getCanvas.
- border drawPolyPatchFrom: 200 at 200 via: 100 at 200 via: 100 at 100 to: 200 at 100 on: Display getCanvas.
-
- border := (ComplexBorder raised: 10) baseColor: poly color.
- border drawPolygon: poly getVertices on: Display getCanvas
-
- 360 / 16.0 22.5
- points := (0 to: 15) collect:[:i| (Point r: 100 degrees: i*22.5) + 200].
- Display getCanvas fillOval: (100 at 100 extent: 200 at 200) color: baseColor.
- border drawPolygon: points on: Display getCanvas.
-
- -1 to: points size + 1 do:[:i|
- border drawPolyPatchFrom: (points atWrap: i) via: (points atWrap: i+1) via: (points atWrap: i+2) to: (points atWrap: i+3) on: Display getCanvas.
- ].
-
- Display getCanvas fillOval: (100 at 100 extent: 200 at 200) color: baseColor.
- 0 to: 36 do:[:i|
- border drawLineFrom: (Point r: 100 degrees: i*10) + 200 to: (Point r: 100 degrees: i+1*10) + 200
- on: Display getCanvas.
- ].
- drawPolygon:
- Point r: 1.0 degrees: 10
- MessageTally spyOn:[
- Display deferUpdates: true.
- t1 := [1 to: 1000 do:[:i|
- border drawLineFrom: (100 at 100) to: (300 at 100) on: Display getCanvas.
- border drawLineFrom: (300 at 100) to: (300 at 300) on: Display getCanvas.
- border drawLineFrom: (300 at 300) to: (100 at 300) on: Display getCanvas.
- border drawLineFrom: (100 at 300) to: (100 at 100) on: Display getCanvas]] timeToRun.
- Display deferUpdates: false.
- ].
-
- MessageTally spyOn:[
- Display deferUpdates: true.
- t2 := [1 to: 1000 do:[:i|
- border drawLine2From: (100 at 100) to: (300 at 100) on: Display getCanvas.
- border drawLine2From: (300 at 100) to: (300 at 300) on: Display getCanvas.
- border drawLine2From: (300 at 300) to: (100 at 300) on: Display getCanvas.
- border drawLine2From: (100 at 300) to: (100 at 100) on: Display getCanvas]] timeToRun.
- Display deferUpdates: false.
- ].
-
- !
Item was removed:
- ----- Method: ComplexBorder class>>style: (in category 'instance creation') -----
- style: aSymbol
- ^self new style: aSymbol!
Item was removed:
- ----- Method: ComplexBorder>>colors (in category 'accessing') -----
- colors
- ^colors ifNil:[colors := self computeColors].!
Item was removed:
- ----- Method: ComplexBorder>>colorsForDirection: (in category 'private') -----
- colorsForDirection: direction
- "Return an array of colors describing the receiver in the given direction"
-
- | colorArray dT cc |
- cc := self colors.
- direction x * direction y <= 0
- ifTrue:
- ["within up->right or down->left transition; no color blend needed"
-
- colorArray := (direction x > 0 or: [direction y < 0])
- ifTrue:
- ["up->right"
- cc copyFrom: 1 to: width]
- ifFalse:
- ["down->left"
- "colors are stored in reverse direction when following a line"
- (cc copyFrom: width + 1 to: cc size) reversed]]
- ifFalse:
- ["right->down or left->up transition; need color blend"
-
- colorArray := Array new: width.
- dT := direction x asFloat / (direction x + direction y).
- (direction x > 0 or: [direction y >= 0])
- ifTrue:
- ["top-right"
-
- 1 to: width
- do:
- [:i |
- colorArray at: i put: ((cc at: i) mixed: dT with: (cc at: cc size - i + 1))]]
- ifFalse:
- ["bottom-left"
-
- 1 to: width
- do:
- [:i |
- colorArray at: i put: ((cc at: cc size - i + 1) mixed: dT with: (cc at: i))]]].
- ^colorArray!
Item was removed:
- ----- Method: ComplexBorder>>computeAltFramedColors (in category 'private') -----
- computeAltFramedColors
- | base light dark w hw colorArray param |
- base := self color asColor.
- light := Color white.
- dark := Color black.
- w := self width isPoint ifTrue:[self width x max: self width y] ifFalse:[self width].
- w := w asInteger.
- w = 1 ifTrue:[^{base mixed: 0.5 with: light. base mixed: 0.5 with: dark}].
- colorArray := Array new: w.
- hw := w // 2.
- "brighten"
- 0 to: hw-1 do:[:i|
- param := 0.5 + (i asFloat / hw * 0.5).
- colorArray at: i+1 put: (base mixed: param with: dark). "brighten"
- colorArray at: w-i put: (base mixed: param with: light). "darken"
- ].
- w odd ifTrue:[colorArray at: hw+1 put: base].
- ^colorArray, colorArray!
Item was removed:
- ----- Method: ComplexBorder>>computeAltInsetColors (in category 'private') -----
- computeAltInsetColors
- | base light dark w colorArray param hw |
- base := self color asColor.
- light := Color white.
- dark := Color black.
- w := self width isPoint
- ifTrue: [self width x max: self width y]
- ifFalse: [self width].
- w := w asInteger.
- colorArray := Array new: w * 2.
- hw := 0.5 / w.
- 0 to: w - 1
- do:
- [:i |
- param := false
- ifTrue:
- ["whats this ???!! false ifTrue:[]"
-
- 0.5 + (hw * i)]
- ifFalse: [0.5 + (hw * (w - i))].
- colorArray at: i + 1 put: (base mixed: param with: dark). "darken"
- colorArray at: colorArray size - i put: (base mixed: param with: light) "brighten"].
- ^colorArray!
Item was removed:
- ----- Method: ComplexBorder>>computeAltRaisedColors (in category 'private') -----
- computeAltRaisedColors
- | base light dark w colorArray param hw |
- base := self color asColor.
- light := Color white.
- dark := Color black.
- w := self width isPoint
- ifTrue: [self width x max: self width y]
- ifFalse: [self width].
- w := w asInteger.
- colorArray := Array new: w * 2.
- hw := 0.5 / w.
- 0 to: w - 1
- do:
- [:i | "again !! false ifTrue:[] ?!!"
- param := false ifTrue: [0.5 + (hw * i)] ifFalse: [0.5 + (hw * (w - i))].
- colorArray at: i + 1 put: (base mixed: param with: light). "brighten"
- colorArray at: colorArray size - i put: (base mixed: param with: dark) "darken"].
- ^colorArray!
Item was removed:
- ----- Method: ComplexBorder>>computeColors (in category 'private') -----
- computeColors
- width = 0 ifTrue:[^colors := #()].
- style == #complexFramed ifTrue:[^self computeFramedColors].
- style == #complexAltFramed ifTrue:[^self computeAltFramedColors].
- style == #complexRaised ifTrue:[^self computeRaisedColors].
- style == #complexAltRaised ifTrue:[^self computeAltRaisedColors].
- style == #complexInset ifTrue:[^self computeInsetColors].
- style == #complexAltInset ifTrue:[^self computeAltInsetColors].
- self error:'Unknown border style: ', style printString.!
Item was removed:
- ----- Method: ComplexBorder>>computeFramedColors (in category 'private') -----
- computeFramedColors
- | base light dark w hw colorArray param |
- base := self color asColor.
- light := Color white.
- dark := Color black.
- w := self width isPoint ifTrue:[self width x max: self width y] ifFalse:[self width].
- w := w asInteger.
- w = 1 ifTrue:[^{base mixed: 0.5 with: light. base mixed: 0.5 with: dark}].
- colorArray := Array new: w.
- hw := w // 2.
- "brighten"
- 0 to: hw-1 do:[:i|
- param := 0.5 + (i asFloat / hw * 0.5).
- colorArray at: i+1 put: (base mixed: param with: light). "brighten"
- colorArray at: w-i put: (base mixed: param with: dark). "darken"
- ].
- w odd ifTrue:[colorArray at: hw+1 put: base].
- ^colorArray, colorArray!
Item was removed:
- ----- Method: ComplexBorder>>computeInsetColors (in category 'private') -----
- computeInsetColors
- | base light dark w colorArray param hw |
- base := self color asColor.
- light := Color white.
- dark := Color black.
- w := self width isPoint
- ifTrue: [self width x max: self width y]
- ifFalse: [self width].
- w := w asInteger.
- colorArray := Array new: w * 2.
- hw := 0.5 / w.
- 0 to: w - 1
- do:
- [:i |
- param := true
- ifTrue: [ 0.5 + (hw * i)]
- ifFalse: [0.5 + (hw * (w - i))].
- colorArray at: i + 1 put: (base mixed: param with: dark). "darken"
- colorArray at: colorArray size - i put: (base mixed: param with: light) "brighten"].
- ^colorArray!
Item was removed:
- ----- Method: ComplexBorder>>computeRaisedColors (in category 'private') -----
- computeRaisedColors
- | base light dark w colorArray param hw |
- base := self color asColor.
- light := Color white.
- dark := Color black.
- w := self width isPoint
- ifTrue: [self width x max: self width y]
- ifFalse: [self width].
- w := w asInteger.
- colorArray := Array new: w * 2.
- hw := 0.5 / w.
- 0 to: w - 1
- do:
- [:i |
- param := true ifTrue: [0.5 + (hw * i)] ifFalse: [0.5 + (hw * (w - i))].
- colorArray at: i + 1 put: (base mixed: param with: light). "brighten"
- colorArray at: colorArray size - i put: (base mixed: param with: dark) "darken"].
- ^colorArray!
Item was removed:
- ----- Method: ComplexBorder>>drawLineFrom:to:on: (in category 'drawing') -----
- drawLineFrom: startPoint to: stopPoint on: aCanvas
- "Here we're using the balloon engine since this is much faster than BitBlt w/ brushes."
-
- | delta length dir cos sin tfm w h w1 w2 h1 h2 fill |
- width isPoint
- ifTrue:
- [w := width x.
- h := width y]
- ifFalse: [w := h := width].
- w1 := w // 2.
- w2 := w - w1.
- h1 := h // 2.
- h2 := h - h1.
- "Compute the rotational transform from (0 at 0) -> (1 at 0) to startPoint -> stopPoint"
- delta := stopPoint - startPoint.
- length := delta r.
- dir := length > 1.0e-10 ifTrue: [delta / length] ifFalse: [ 1 @ 0].
- cos := dir dotProduct: 1 @ 0.
- sin := dir crossProduct: 1 @ 0.
- tfm := (MatrixTransform2x3 new)
- a11: cos;
- a12: sin;
- a21: sin negated;
- a22: cos.
- "Install the start point offset"
- tfm offset: startPoint.
- "Now get the fill style appropriate for the given direction"
- fill := self fillStyleForDirection: dir.
- "And draw..."
- aCanvas asBalloonCanvas transformBy: tfm
- during:
- [:cc |
- cc drawPolygon: {
- (0 - w1) @ (0 - h1). "top left"
- (length + w2) @ (0 - h1). "top right"
- (length + w2) @ h2. "bottom right"
- (0 - w1) @ h2 "bottom left"}
- fillStyle: fill]!
Item was removed:
- ----- Method: ComplexBorder>>drawPolyPatchFrom:to:on:usingEnds: (in category 'drawing') -----
- drawPolyPatchFrom: startPoint to: stopPoint on: aCanvas usingEnds: endsArray
-
- | cos sin tfm fill dir fsOrigin fsDirection points x y |
- dir := (stopPoint - startPoint) normalized.
- "Compute the rotational transform from (0 at 0) -> (1 at 0) to startPoint -> stopPoint"
- cos := dir dotProduct: (1 at 0).
- sin := dir crossProduct: (1 at 0).
- "Now get the fill style appropriate for the given direction"
- fill := self fillStyleForDirection: dir.
- false ifTrue:[
- "Transform the fill appropriately"
- fill := fill shallowCopy.
- "Note: Code below is inlined from tfm transformPoint:/transformDirection:"
- x := fill origin x. y := fill origin y.
- fsOrigin := ((x * cos) + (y * sin) + startPoint x) @
- ((y * cos) - (x * sin) + startPoint y).
- x := fill direction x. y := fill direction y.
- fsDirection := ((x * cos) + (y * sin)) @ ((y * cos) - (x * sin)).
- fill origin: fsOrigin;
- direction: fsDirection rounded; "NOTE: This is a bug in the balloon engine!!!!!!"
- normal: nil.
- aCanvas asBalloonCanvas drawPolygon: endsArray fillStyle: fill.
- ] ifFalse:[
- "Transform the points rather than the fills"
- tfm := (MatrixTransform2x3 new) a11: cos; a12: sin; a21: sin negated; a22: cos.
- "Install the start point offset"
- tfm offset: startPoint.
- points := endsArray collect:[:pt| tfm invertPoint: pt].
- aCanvas asBalloonCanvas transformBy: tfm during:[:cc|
- cc drawPolygon: points fillStyle: fill.
- ].
- ].!
Item was removed:
- ----- Method: ComplexBorder>>fillStyleForDirection: (in category 'private') -----
- fillStyleForDirection: direction
- "Fill the given form describing the receiver's look at a particular direction"
- | index fill dir |
- index := direction degrees truncated // 10 + 1.
- lineStyles ifNotNil:[
- fill := lineStyles at: index.
- fill ifNotNil:[^fill].
- ].
- dir := Point r: 1.0 degrees: index - 1 * 10 + 5.
- fill := GradientFillStyle colors: (self colorsForDirection: dir).
- fill direction: 0 @ width asPoint y; radial: false.
- fill origin: ((width asPoint x // 2) @ (width asPoint y // 2)) negated.
- fill pixelRamp: (fill computePixelRampOfSize: 16).
- fill isTranslucent. "precompute"
- lineStyles ifNil:[lineStyles := Array new: 37].
- lineStyles at: index put: fill.
- ^fill!
Item was removed:
- ----- Method: ComplexBorder>>framePolygon2:on: (in category 'drawing') -----
- framePolygon2: vertices on: aCanvas
- | dir1 dir2 dir3 nrm1 nrm2 nrm3 point1 point2 point3
- cross1 cross2 pointA pointB pointC pointD w p1 p2 p3 p4 balloon ends |
- balloon := aCanvas asBalloonCanvas.
- balloon == aCanvas ifFalse:[balloon deferred: true].
- ends := Array new: 4.
- w := width * 0.5.
- pointA := nil.
- 1 to: vertices size do:[:i|
- p1 := vertices atWrap: i.
- p2 := vertices atWrap: i+1.
- p3 := vertices atWrap: i+2.
- p4 := vertices atWrap: i+3.
-
- dir1 := p2 - p1.
- dir2 := p3 - p2.
- dir3 := p4 - p3.
-
- i = 1 ifTrue:[
- "Compute the merge points of p1->p2 with p2->p3"
- cross1 := dir2 crossProduct: dir1.
- nrm1 := dir1 normalized. nrm1 := (nrm1 y * w) @ (0 - nrm1 x * w).
- nrm2 := dir2 normalized. nrm2 := (nrm2 y * w) @ (0 - nrm2 x * w).
- cross1 < 0 ifTrue:[nrm1 := nrm1 negated. nrm2 := nrm2 negated].
- point1 := (p1 x + nrm1 x) @ (p1 y + nrm1 y).
- point2 := (p2 x + nrm2 x) @ (p2 y + nrm2 y).
- pointA := self intersectFrom: point1 with: dir1 to: point2 with: dir2.
- point1 := (p1 x - nrm1 x) @ (p1 y - nrm1 y).
- point2 := (p2 x - nrm2 x) @ (p2 y - nrm2 y).
- pointB := self intersectFrom: point1 with: dir1 to: point2 with: dir2.
- pointB ifNotNil:[
- (pointB x - p2 x) abs + (pointB y - p2 y) abs > (4*w) ifTrue:[pointA := pointB := nil].
- ].
- ].
-
- "Compute the merge points of p2->p3 with p3->p4"
- cross2 := dir3 crossProduct: dir2.
- nrm2 := dir2 normalized. nrm2 := (nrm2 y * w) @ (0 - nrm2 x * w).
- nrm3 := dir3 normalized. nrm3 := (nrm3 y * w) @ (0 - nrm3 x * w).
- cross2 < 0 ifTrue:[nrm2 := nrm2 negated. nrm3 := nrm3 negated].
- point2 := (p2 x + nrm2 x) @ (p2 y + nrm2 y).
- point3 := (p3 x + nrm3 x) @ (p3 y + nrm3 y).
- pointC := self intersectFrom: point2 with: dir2 to: point3 with: dir3.
- point2 := (p2 x - nrm2 x) @ (p2 y - nrm2 y).
- point3 := (p3 x - nrm3 x) @ (p3 y - nrm3 y).
- pointD := self intersectFrom: point2 with: dir2 to: point3 with: dir3.
- pointD ifNotNil:[
- (pointD x - p3 x) abs + (pointD y - p3 y) abs > (4*w) ifTrue:[pointC := pointD := nil].
- ].
- cross1 * cross2 < 0.0 ifTrue:[
- point1 := pointA.
- pointA := pointB.
- pointB := point1.
- cross1 := 0.0 - cross1].
- ends at: 1 put: pointA; at: 2 put: pointB; at: 3 put: pointD; at: 4 put: pointC.
- pointA ifNil:["degenerate and slow"
- nrm2 := dir2 normalized. nrm2 := (nrm2 y * w) @ (0 - nrm2 x * w).
- cross1 < 0 ifTrue:[nrm2 := nrm2 negated].
- point2 := (p2 x + nrm2 x) @ (p2 y + nrm2 y).
- ends at: 1 put: point2].
- pointB ifNil:["degenerate and slow"
- nrm2 := dir2 normalized. nrm2 := (nrm2 y * w) @ (0 - nrm2 x * w).
- cross1 < 0 ifTrue:[nrm2 := nrm2 negated].
- point2 := (p2 x - nrm2 x) @ (p2 y - nrm2 y).
- ends at: 2 put: point2].
- pointC ifNil:["degenerate and slow"
- nrm2 := dir2 normalized. nrm2 := (nrm2 y * w) @ (0 - nrm2 x * w).
- cross2 < 0 ifTrue:[nrm2 := nrm2 negated].
- point2 := (p3 x + nrm2 x) @ (p3 y + nrm2 y).
- ends at: 4 put: point2].
- pointD ifNil:["degenerate and slow"
- nrm2 := dir2 normalized. nrm2 := (nrm2 y * w) @ (0 - nrm2 x * w).
- cross2 < 0 ifTrue:[nrm2 := nrm2 negated].
- point2 := (p3 x - nrm2 x) @ (p3 y - nrm2 y).
- ends at: 3 put: point2].
-
- self drawPolyPatchFrom: p2 to: p3 on: balloon usingEnds: ends.
- pointA := pointC.
- pointB := pointD.
- cross1 := cross2.
- ].
- balloon == aCanvas ifFalse:[balloon flush].!
Item was removed:
- ----- Method: ComplexBorder>>framePolygon:on: (in category 'drawing') -----
- framePolygon: vertices on: aCanvas
- | dir1 dir2 dir3 nrm1 nrm2 nrm3 point1 point2 point3
- cross1 cross2 pointA pointB pointC pointD w p1 p2 p3 p4 balloon ends pointE pointF |
- balloon := aCanvas asBalloonCanvas.
- balloon == aCanvas ifFalse:[balloon deferred: true].
- ends := Array new: 6.
- w := width * 0.5.
- pointA := nil.
- 1 to: vertices size do:[:i|
- p1 := vertices atWrap: i.
- p2 := vertices atWrap: i+1.
- p3 := vertices atWrap: i+2.
- p4 := vertices atWrap: i+3.
-
- dir1 := p2 - p1.
- dir2 := p3 - p2.
- dir3 := p4 - p3.
-
- (i = 1 | true) ifTrue:[
- "Compute the merge points of p1->p2 with p2->p3"
- cross1 := dir2 crossProduct: dir1.
- nrm1 := dir1 normalized. nrm1 := (nrm1 y * w) @ (0 - nrm1 x * w).
- nrm2 := dir2 normalized. nrm2 := (nrm2 y * w) @ (0 - nrm2 x * w).
- cross1 < 0 ifTrue:[nrm1 := nrm1 negated. nrm2 := nrm2 negated].
- point1 := (p1 x + nrm1 x) @ (p1 y + nrm1 y).
- point2 := (p2 x + nrm2 x) @ (p2 y + nrm2 y).
- pointA := self intersectFrom: point1 with: dir1 to: point2 with: dir2.
- point1 := (p1 x - nrm1 x) @ (p1 y - nrm1 y).
- point2 := (p2 x - nrm2 x) @ (p2 y - nrm2 y).
- pointB := point1 + dir1 + point2 * 0.5.
- pointB := p2 + ((pointB - p2) normalized * w).
- pointC := point2.
- ].
-
- "Compute the merge points of p2->p3 with p3->p4"
- cross2 := dir3 crossProduct: dir2.
- nrm2 := dir2 normalized. nrm2 := (nrm2 y * w) @ (0 - nrm2 x * w).
- nrm3 := dir3 normalized. nrm3 := (nrm3 y * w) @ (0 - nrm3 x * w).
- cross2 < 0 ifTrue:[nrm2 := nrm2 negated. nrm3 := nrm3 negated].
- point2 := (p2 x + nrm2 x) @ (p2 y + nrm2 y).
- point3 := (p3 x + nrm3 x) @ (p3 y + nrm3 y).
- pointD := self intersectFrom: point2 with: dir2 to: point3 with: dir3.
- point2 := (p2 x - nrm2 x) @ (p2 y - nrm2 y).
- point3 := (p3 x - nrm3 x) @ (p3 y - nrm3 y).
- pointF := point2 + dir2.
- pointE := pointF + point3 * 0.5.
- pointE := p3 + ((pointE - p3) normalized * w).
- cross1 * cross2 < 0.0 ifTrue:[
- ends
- at: 1 put: pointA;
- at: 2 put: pointB;
- at: 3 put: pointC;
- at: 4 put: pointD;
- at: 5 put: pointE;
- at: 6 put: pointF.
- ] ifFalse:[
- ends
- at: 1 put: pointA;
- at: 2 put: pointB;
- at: 3 put: pointC;
- at: 4 put: pointF;
- at: 5 put: pointE;
- at: 6 put: pointD.
- ].
- self drawPolyPatchFrom: p2 to: p3 on: balloon usingEnds: ends.
- pointA := pointD.
- pointB := pointE.
- pointC := pointF.
- cross1 := cross2.
- ].
- balloon == aCanvas ifFalse:[balloon flush].!
Item was removed:
- ----- Method: ComplexBorder>>frameRectangle:on: (in category 'drawing') -----
- frameRectangle: aRectangle on: aCanvas
- "Note: This uses BitBlt since it's roughly a factor of two faster for rectangles"
- | w h r |
- self colors ifNil:[^super frameRectangle: aRectangle on: aCanvas].
- w := self width.
- w isPoint ifTrue:[h := w y. w := w x] ifFalse:[h := w].
- 1 to: h do:[:i| "top/bottom"
- r := (aRectangle topLeft + (i-1)) extent: (aRectangle width - (i-1*2))@1. "top"
- aCanvas fillRectangle: r color: (colors at: i).
- r := (aRectangle bottomLeft + (i @ (0-i))) extent: (aRectangle width - (i-1*2) - 1)@1. "bottom"
- aCanvas fillRectangle: r color: (colors at: colors size - i + 1).
- ].
- 1 to: w do:[:i| "left/right"
- r := (aRectangle topLeft + (i-1)) extent: 1@(aRectangle height - (i-1*2)). "left"
- aCanvas fillRectangle: r color: (colors at: i).
- r := aRectangle topRight + ((0-i)@i) extent: 1@(aRectangle height - (i-1*2) - 1). "right"
- aCanvas fillRectangle: r color: (colors at: colors size - i + 1).
- ].!
Item was removed:
- ----- Method: ComplexBorder>>intersectFrom:with:to:with: (in category 'private') -----
- intersectFrom: startPt with: startDir to: endPt with: endDir
- "Compute the intersection of two lines. Return nil if either
- * the intersection does not exist, or
- * the intersection is 'before' startPt, or
- * the intersection is 'after' endPt
- "
- | det deltaPt alpha beta |
- det := (startDir x * endDir y) - (startDir y * endDir x).
- det = 0.0 ifTrue:[^nil]. "There's no solution for it"
- deltaPt := endPt - startPt.
- alpha := (deltaPt x * endDir y) - (deltaPt y * endDir x).
- beta := (deltaPt x * startDir y) - (deltaPt y * startDir x).
- alpha := alpha / det.
- beta := beta / det.
- alpha < 0 ifTrue:[^nil].
- beta > 1.0 ifTrue:[^nil].
- "And compute intersection"
- ^(startPt x + (alpha * startDir x)) @ (startPt y + (alpha * startDir y))!
Item was removed:
- ----- Method: ComplexBorder>>isComplex (in category 'testing') -----
- isComplex
- ^true!
Item was removed:
- ----- Method: ComplexBorder>>releaseCachedState (in category 'initialize') -----
- releaseCachedState
- colors := nil.
- lineStyles := nil.!
Item was removed:
- ----- Method: ComplexBorder>>style (in category 'accessing') -----
- style
- ^style!
Item was removed:
- ----- Method: ComplexBorder>>style: (in category 'accessing') -----
- style: newStyle
- style == newStyle ifTrue:[^self].
- style := newStyle.
- self releaseCachedState.!
Item was removed:
- ----- Method: ComplexBorder>>trackColorFrom: (in category 'color tracking') -----
- trackColorFrom: aMorph
- baseColor isTransparent ifTrue:[self color: aMorph raisedColor].!
Item was removed:
- ----- Method: ComplexBorder>>veryDeepInner: (in category 'copying') -----
- veryDeepInner: aDeepCopier
- super veryDeepInner: aDeepCopier.
- style := style veryDeepCopyWith: aDeepCopier.
- colors := colors veryDeepCopyWith: aDeepCopier.
- lineStyles := lineStyles veryDeepCopyWith: aDeepCopier.!
Item was removed:
- Object subclass: #ComplexProgressIndicator
- instanceVariableNames: 'formerWorld targetMorph estimate prevData formerProcess translucentMorph userSuppliedMorph specificHistory historyCategory cumulativeStageTime formerProject newRatio stageCompleted start'
- classVariableNames: 'History'
- poolDictionaries: ''
- category: 'Morphic-Windows'!
-
- !ComplexProgressIndicator commentStamp: '<historical>' prior: 0!
- Note: in an effort to remove the progress indicator if a walkback occurs, #withProgressDo: must be sent from the current uiProcess. Hopefully we can relax this restriction in the future. !
Item was removed:
- ----- Method: ComplexProgressIndicator class>>historyReport (in category 'reports') -----
- historyReport
- "
- ComplexProgressIndicator historyReport
- "
- | answer |
- History ifNil: [^Beeper beep].
- answer := String streamContents: [ :strm |
- (History keys asArray sort: [ :a :b | a asString <= b asString]) do: [ :k |
- | data |
- strm nextPutAll: k printString; cr.
- data := History at: k.
- (data keys asArray sort: [ :a :b | a asString <= b asString]) do: [ :dataKey |
- strm tab; nextPutAll: dataKey printString,' ',
- (data at: dataKey) asArray printString; cr.
- ].
- strm cr.
- ].
- ].
- StringHolder new
- contents: answer contents;
- openLabel: 'Progress History'!
Item was removed:
- ----- Method: ComplexProgressIndicator>>addProgressDecoration: (in category 'private') -----
- 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 isString)
- ifTrue:
- [targetMorph
- submorphsDo: [:mm | (mm isKindOf: StringMorph) ifTrue: [mm delete]].
- m := StringMorph contents: extraParam translated.
- m align: m fullBounds bottomCenter + (0 @ 8)
- with: targetMorph bounds bottomCenter.
- targetMorph addMorph: m.
- ^self]!
Item was removed:
- ----- Method: ComplexProgressIndicator>>backgroundWorldDisplay (in category 'private') -----
- backgroundWorldDisplay
-
- | world |
- self flag: #bob. "really need a better way to do this"
-
- "World displayWorldSafely."
-
- "ugliness to try to track down a possible error"
-
- world := Project current world.
- [world displayWorld] ifError: [ :a :b |
- | f |
- stageCompleted := 999.
- f := FileDirectory default fileNamed: 'bob.errors'.
- f nextPutAll: a printString,' ',b printString; cr; cr.
- f nextPutAll: 'worlds equal ',(formerWorld == world) printString; cr; cr.
- f nextPutAll: thisContext longStack; cr; cr.
- f nextPutAll: formerProcess suspendedContext longStack; cr; cr.
- f close. Beeper beep.
- ].
- !
Item was removed:
- ----- Method: ComplexProgressIndicator>>forkProgressWatcher (in category 'private - background process') -----
- forkProgressWatcher
-
- [
- | currentWorld killTarget |
- currentWorld := Project current world.
- [stageCompleted < 999 and:
- [formerProject == Project current and:
- [formerWorld == currentWorld and:
- [translucentMorph world notNil and:
- [formerProcess suspendedContext notNil and:
- [Project uiProcess == formerProcess]]]]]] whileTrue: [
-
- translucentMorph setProperty: #revealTimes toValue:
- {(Time millisecondClockValue - start max: 1). (estimate * newRatio max: 1)}.
- translucentMorph changed.
- translucentMorph owner addMorphInLayer: translucentMorph.
- (Time millisecondClockValue - WorldState lastCycleTime) abs > 500 ifTrue: [
- self backgroundWorldDisplay
- ].
- (Delay forMilliseconds: 100) wait.
- ].
- translucentMorph removeProperty: #revealTimes.
- self loadingHistoryAt: 'total' add: (Time millisecondClockValue - start max: 1).
- killTarget := targetMorph ifNotNil: [
- targetMorph valueOfProperty: #deleteOnProgressCompletion
- ].
- formerWorld == currentWorld ifTrue: [
- translucentMorph delete.
- killTarget ifNotNil: [killTarget delete].
- ] ifFalse: [
- translucentMorph privateDeleteWithAbsolutelyNoSideEffects.
- killTarget ifNotNil: [killTarget privateDeleteWithAbsolutelyNoSideEffects].
- ].
- ] forkAt: Processor lowIOPriority.!
Item was removed:
- ----- Method: ComplexProgressIndicator>>historyCategory: (in category 'configuration') -----
- historyCategory: aKey
-
- History ifNil: [History := Dictionary new].
- specificHistory := History
- at: aKey
- ifAbsentPut: [Dictionary new].
- ^specificHistory
- !
Item was removed:
- ----- Method: ComplexProgressIndicator>>loadingHistoryAt:add: (in category 'private') -----
- loadingHistoryAt: aKey add: aNumber
-
- (self loadingHistoryDataForKey: aKey) add: aNumber.
-
- !
Item was removed:
- ----- Method: ComplexProgressIndicator>>loadingHistoryDataForKey: (in category 'private') -----
- loadingHistoryDataForKey: anObject
-
- | answer |
- answer := specificHistory
- at: anObject
- ifAbsentPut: [OrderedCollection new].
- answer size > 50 ifTrue: [
- answer := answer copyFrom: 25 to: answer size.
- specificHistory at: anObject put: answer.
- ].
- ^answer
-
- !
Item was removed:
- ----- Method: ComplexProgressIndicator>>targetMorph: (in category 'configuration') -----
- targetMorph: aMorph
-
- targetMorph := aMorph!
Item was removed:
- ----- Method: ComplexProgressIndicator>>withProgressDo: (in category 'configuration') -----
- withProgressDo: aBlock
-
- | safetyFactor totals trialRect delta |
-
- Smalltalk isMorphic ifFalse: [^aBlock value].
- formerProject := Project current.
- formerWorld := formerProject world.
- formerProcess := Processor activeProcess.
- targetMorph
- ifNil: [targetMorph := ProgressTargetRequestNotification signal].
- targetMorph ifNil: [
- trialRect := Rectangle center: Sensor cursorPoint extent: 80 at 80.
- delta := trialRect amountToTranslateWithin: formerWorld bounds.
- trialRect := trialRect translateBy: delta.
- translucentMorph := TranslucentProgessMorph new
- opaqueBackgroundColor: Color white;
- bounds: trialRect;
- openInWorld: formerWorld.
- ] ifNotNil: [
- translucentMorph := TranslucentProgessMorph new
- morphicLayerNumber: targetMorph morphicLayerNumber - 0.1;
- bounds: targetMorph boundsInWorld;
- openInWorld: targetMorph world.
- ].
- stageCompleted := 0.
- safetyFactor := 1.1. "better to guess high than low"
- translucentMorph setProperty: #progressStageNumber toValue: 1.
- translucentMorph hide.
- totals := self loadingHistoryDataForKey: 'total'.
- newRatio := 1.0.
- estimate := totals size < 2 ifTrue: [
- 15000 "be a pessimist"
- ] ifFalse: [
- (totals sum - totals max) / (totals size - 1 max: 1) * safetyFactor.
- ].
- start := Time millisecondClockValue.
- self forkProgressWatcher.
-
- [
- aBlock
- on: ProgressInitiationException
- do: [ :ex |
- ex sendNotificationsTo: [ :min :max :curr |
- "ignore this as it is inaccurate"
- ].
- ].
- ] on: ProgressNotification do: [ :note | | stageCompletedString |
- translucentMorph show.
- note extraParam ifNotNil:[self addProgressDecoration: note extraParam].
- stageCompletedString := (note messageText findTokens: ' ') first.
- stageCompleted := (stageCompletedString copyUpTo: $:) asNumber.
- cumulativeStageTime := Time millisecondClockValue - start max: 1.
- prevData := self loadingHistoryDataForKey: stageCompletedString.
- prevData isEmpty ifFalse: [
- newRatio := (cumulativeStageTime / (prevData average max: 1)) asFloat.
- ].
- self
- loadingHistoryAt: stageCompletedString
- add: cumulativeStageTime.
- translucentMorph
- setProperty: #progressStageNumber
- toValue: stageCompleted + 1.
- note resume.
- ].
-
- stageCompleted := 999. "we may or may not get here"
-
- !
Item was removed:
- AbstractResizerMorph subclass: #CornerGripMorph
- instanceVariableNames: 'target'
- classVariableNames: 'DrawCornerResizeHandles DrawEdgeResizeHandles'
- poolDictionaries: ''
- category: 'Morphic-Windows'!
-
- !CornerGripMorph commentStamp: 'jmv 1/29/2006 17:15' prior: 0!
- I am the superclass of a hierarchy of morph specialized in allowing the user to resize windows.!
Item was removed:
- ----- Method: CornerGripMorph class>>drawCornerResizeHandles (in category 'preferences') -----
- drawCornerResizeHandles
- <preference: 'Draw Corner Resize Handles'
- categoryList: #(windows Accessibility)
- description: 'Set whether the resize handles on windows should be drawn on the window frame. This does not enable nor disable the resizing function'
- type: #Boolean>
- ^ DrawCornerResizeHandles ifNil: [ false ]!
Item was removed:
- ----- Method: CornerGripMorph class>>drawCornerResizeHandles: (in category 'preferences') -----
- drawCornerResizeHandles: aBoolean
-
- DrawCornerResizeHandles := aBoolean.
- Project current restoreDisplay.!
Item was removed:
- ----- Method: CornerGripMorph class>>drawEdgeResizeHandles (in category 'preferences') -----
- drawEdgeResizeHandles
- <preference: 'Draw Edge Resize Handles'
- categoryList: #(windows Accessibility)
- description: 'Set whether the resize handles on windows should be drawn on the window frame. This does not enable nor disable the resizing function.'
- type: #Boolean>
- ^ DrawEdgeResizeHandles ifNil: [ false ]!
Item was removed:
- ----- Method: CornerGripMorph class>>drawEdgeResizeHandles: (in category 'preferences') -----
- drawEdgeResizeHandles: aBoolean
-
- DrawEdgeResizeHandles := aBoolean.
- Project current restoreDisplay.!
Item was removed:
- ----- Method: CornerGripMorph>>backupAndHideTargetDropShadows (in category 'private') -----
- backupAndHideTargetDropShadows
-
- self target fastFramingOn ifFalse: [
- self setProperty: #targetHadDropShadow toValue: target hasDropShadow.
- self target hasDropShadow: false].!
Item was removed:
- ----- Method: CornerGripMorph>>defaultHeight (in category 'accessing') -----
- defaultHeight
-
- ^ self class handleLength!
Item was removed:
- ----- Method: CornerGripMorph>>defaultWidth (in category 'accessing') -----
- defaultWidth
-
- ^ self class handleLength!
Item was removed:
- ----- Method: CornerGripMorph>>drawCornerResizeHandles (in category 'accessing') -----
- drawCornerResizeHandles
- ^ self valueOfProperty: #drawCornerResizeHandles ifAbsent: [self class drawCornerResizeHandles]!
Item was removed:
- ----- Method: CornerGripMorph>>drawCornerResizeHandles: (in category 'accessing') -----
- drawCornerResizeHandles: aBoolean
- self setProperty: #drawCornerResizeHandles toValue: aBoolean.
- self changed.!
Item was removed:
- ----- Method: CornerGripMorph>>handleInset (in category 'accessing') -----
- handleInset
-
- ^ (handleInset notNil or: [self owner isNil])
- ifTrue: [handleInset ifNil: [1]]
- ifFalse: [self owner borderWidth max: 1]!
Item was removed:
- ----- Method: CornerGripMorph>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: anEvent
- ^ true!
Item was removed:
- ----- Method: CornerGripMorph>>handlesMouseOver: (in category 'event handling') -----
- handlesMouseOver: anEvent
- ^true!
Item was removed:
- ----- Method: CornerGripMorph>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
- self extent: self defaultWidth @ self defaultHeight.
- self layoutFrame: self gripLayoutFrame.!
Item was removed:
- ----- Method: CornerGripMorph>>mouseDown: (in category 'event handling') -----
- mouseDown: anEvent
- "Disable drop shadow to improve performance while resizing."
-
- super mouseDown: anEvent.
-
- self target ifNil: [^ self].
- self backupAndHideTargetDropShadows.!
Item was removed:
- ----- Method: CornerGripMorph>>mouseMove: (in category 'event handling') -----
- mouseMove: anEvent
-
- | delta |
- self target ifNil: [^ self].
- (self hasProperty: #targetHadDropShadow) ifFalse: [
- "When dragging resizing an inactive system window, the shadow will be added after sending #mouseDown: on the receiver by the event filter on SystemWindow. Take a second chance to remove the expensive drop shadow temporarily."
- self backupAndHideTargetDropShadows].
- self target fastFramingOn
- ifTrue: [delta := self target doFastWindowReframe: self ptName]
- ifFalse: [
- delta := anEvent position - (self referencePoint + self position).
- self apply: delta.
- self bounds: (self bounds origin + delta extent: self bounds extent)].!
Item was removed:
- ----- Method: CornerGripMorph>>mouseUp: (in category 'event handling') -----
- mouseUp: anEvent
- "Restore target drop shadow if there was one. See #mouseDown:."
-
- self target ifNil: [^ self].
- self target fastFramingOn ifFalse: [
- ((self removeProperty: #targetHadDropShadow) ifNil: [false])
- ifTrue: [self target hasDropShadow: true]].!
Item was removed:
- ----- Method: CornerGripMorph>>showHandle (in category 'accessing') -----
- showHandle
-
- ^ showHandle ifNil: [self class drawCornerResizeHandles]!
Item was removed:
- ----- Method: CornerGripMorph>>target (in category 'accessing') -----
- target
-
- ^ target!
Item was removed:
- ----- Method: CornerGripMorph>>target: (in category 'accessing') -----
- target: aMorph
-
- target := aMorph!
Item was removed:
- Array variableSubclass: #Cubic
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Collections-Arrayed'!
-
- !Cubic commentStamp: 'pre 12/13/2018 20:14' prior: 0!
- I am a segment between two points. In the form of a cubic polynomial that can be evaluated between 0..1 to obtain the end points and intermediate values.
- !
Item was removed:
- ----- Method: Cubic>>bestSegments (in category 'cubic support') -----
- bestSegments
- "Return the smallest integer number of segments that give the
- best curve."
- ^ self honeIn: self calcEnoughSegments!
Item was removed:
- ----- Method: Cubic>>calcEnoughSegments (in category 'cubic support') -----
- calcEnoughSegments
- "Find the power of two that represents a sufficient number of
- segments for this cubic.
- The measure is the sum of distances for the segments.
- We want this to be close enough not affect the straightness of
- the drawn lines. Which means within one pixel."
- "^ self
- enough: 2
- withMeasure: (self measureFor: 1)
- withIn: self leeway
- This ran into a problem when the curve was an s-curve with
- inflections. Besides honeIn will check to see if 1 is better than
- two so we lose nothing by starting a little higher."
- ^ self
- enough: 4
- withMeasure: (self measureFor: 2)
- withIn: self leeway!
Item was removed:
- ----- Method: Cubic>>enough:withMeasure:withIn: (in category 'cubic support') -----
- enough: nTry withMeasure: lastMeasure withIn: closeEnough
- "See comment in calcEnoughSegments for which I am a helper"
- | measure |
- measure := self measureFor: nTry.
- measure > (lastMeasure + closeEnough)
- ifFalse: [^ nTry // 2].
- ^ self
- enough: 2 * nTry
- withMeasure: measure
- withIn: closeEnough!
Item was removed:
- ----- Method: Cubic>>honeIn: (in category 'cubic support') -----
- honeIn: enough
- "Find if there is a smaller n than enough that give the same
- measure for n."
-
- enough < 2 ifTrue: [ ^enough].
- ^ self
- honeIn: enough
- step: enough // 2
- measure: (self measureFor: enough)
- withIn: self leeway!
Item was removed:
- ----- Method: Cubic>>honeIn:step:measure:withIn: (in category 'cubic support') -----
- honeIn: centerN step: step measure: measure withIn: closeEnough
- "Pick the best n by binary search."
- | nTry |
- step < 1
- ifTrue: [^ centerN].
- nTry := centerN - step.
- ^ measure > (closeEnough
- + (self measureFor: nTry))
- ifTrue: [self
- honeIn: centerN
- step: step // 2
- measure: measure
- withIn: closeEnough]
- ifFalse: [self
- honeIn: nTry
- step: step // 2
- measure: measure
- withIn: closeEnough]!
Item was removed:
- ----- Method: Cubic>>leeway (in category 'cubic support') -----
- leeway
- "How close can measure be"
- ^ 0.1!
Item was removed:
- ----- Method: Cubic>>measureFor: (in category 'cubic support') -----
- measureFor: n
- "Return a distance measure for cubic curve with n segments.
- For convienence and accuracy we use the sum of the
- distances. "
- "first point is poly of 0."
- | p1 measure |
- p1 := self at: 1.
- measure := 0.
- 1 to: n do: [ :i |
- | x p2 |
- x := i asFloat / n.
- p2 := self polynomialEval: x @ x.
- measure := measure + (p2 dist: p1).
- p1 := p2 ].
- ^measure!
Item was removed:
- PolygonMorph subclass: #CurveMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Basic'!
-
- !CurveMorph commentStamp: '<historical>' prior: 0!
- This is really only a shell for creating Shapes with smooth outlines.!
Item was removed:
- ----- Method: CurveMorph class>>arrowPrototype (in category 'instance creation') -----
- arrowPrototype
-
- | aa |
- aa := PolygonMorph vertices: (Array with: 5 at 40 with: 5 at 8 with: 35 at 8 with: 35 at 40)
- color: Color black
- borderWidth: 2
- borderColor: Color black.
- aa beSmoothCurve; makeOpen; makeForwardArrow. "is already open"
- aa dashedBorder: {10. 10. Color red}.
- "A dash spec is a 3- or 5-element array with
- { length of normal border color.
- length of alternate border color.
- alternate border color}"
- aa computeBounds.
- ^ aa!
Item was removed:
- ----- Method: CurveMorph class>>descriptionForPartsBin (in category 'parts bin') -----
- descriptionForPartsBin
- ^ self partName: 'Curve'
- categories: #('Graphics' 'Basic')
- documentation: 'A smooth wiggly curve, or a curved solid. Shift-click to get handles and move the points.'!
Item was removed:
- ----- Method: CurveMorph>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
- self beSmoothCurve.
- !
Item was removed:
- ----- Method: CurveMorph>>initializeToStandAlone (in category 'parts bin') -----
- initializeToStandAlone
-
- super initializeToStandAlone.
- self beSmoothCurve.
- !
Item was removed:
- ----- Method: CurveMorph>>isCurvier (in category 'testing') -----
- isCurvier
- "Test used by smoothing routines. If true use true closed curve splines for closed curves. If not mimic old stodgy curveMorph curves with one sharp bend. Curve overrides this test for backward compatability.."
- ^ (false)!
Item was removed:
- PolygonMorph subclass: #CurvierMorph
- instanceVariableNames: ''
- classVariableNames: 'DrawCurvier SlopeConstantsCache'
- poolDictionaries: ''
- category: 'Morphic-Basic-NewCurve'!
-
- !CurvierMorph commentStamp: '<historical>' prior: 0!
- I want to be merged into PolygonMorph.
- I implement Closed Cubic Curves and restructured routines to ease maintence and development.
-
-
-
- New way to calculate curves.
-
- cVariables
- SlopeConstantsCache anArray size 2 indexed by nVerts \\2 .
- Each element is an array of integers. The integers represent the constants for
- calculating slopes for closed cubic curves from the vertices.
-
-
-
-
- Class Variable SlopeConstantsCache holds a pair of arrays for even and odd number of vertices( aka knots).
- Each array holds a series of constants in Integer form.
- This allows slopes to be calculated directly from the array of knots.
- Wonderfully it turns out that only two arrays are needed.
- By matching up the knots equidistant from the point in question;
- Summing the weighted differences of the pairs the unscaled slope can be arrived at.
- The scale needed to get the slopes needed is trice the reciprical of the next integer in the series.
- We leave the division til last to get the full benifit of the integer arithmetic.
-
- Rounding the vertices before calculation is recommended.
-
-
- Instead of calculating the number of curve subsegments in lineSegDo we add a ninth array to curve state to allow the number to be precalculated.
- Getting better looking curves motivates finding a better way of guessing n. So this provides a framework for trying.
-
- For the first pass we just used the constant 12 for every thing.
- In the second pass we judge the number of segments by starting with two and doubling the number until the distance of the curve no longer increases.
- Then we hone in using a binary search to find the smallest number of segments with that same curve length.
-
-
- We have changed some assumptions. Previously curves were figured by solving for the second derivative first and using the results to determine the slope and the third derivative. So lineSegDo counted on the last second deriv being a number it could use in its calculation of the number of subsegments.
-
- Currently we just solve for slopes and the second and third derivs are derived from that.
- Also the derivation for the second and third derivs only assume C(1) (first derivitive continuity). The calculations for the slopes are the only calcs using C(2) continuity. Therefore the slopes can alternately be chosen to fit some other chriteria and the resulting curves will still be smooth to the first degree.
- A useful variant of closed slopes is to scale them by a constant.
-
-
- Also the last of each element of curvestate always reflects a closing segment. And we don't add an extra row for closed curves anymore.
- That is now lineSegDo's responsibility to be aware of as it was already doing with segmented curves. So the last n does not track its old value.
-
- Preferences:
- A Preference has been added to toggle between the old (ugly) closed curves based on natural cubic slopes and the new smooth algorythim. This doesn't make much difference while newcurves are a subclass of polygons but the ambition is for newcurves to supercede polygons. This will allow backwards compatibility.
-
- Shapes: With closed curves a smooth oval results from rectagular or diamond vertices. So two menuitems have been added (to PolygonMorph) that allow the vertices to be set to these shapes using the current bounds of the polygon. The former state of vertices will be lost but it seems useful to lose a complicated shape and start fresh with a simple symmetrical one.
-
- Furthur on: Modify curveState to only contain slope and higher deriv information. Let the information about the knots only be held only in the vertices of the polygon. Once that is done curvestate will not have to be recalcutaled each time the polygon is moved but only when its shape changes.
-
- There is also some possible speed up to be had by refining or experimenting with other number of segment calculating schemes but not as much as preserving curvestate over a move.
-
- Furthur furthur on: Figure out how to combine straight and curved segments into a single shape in a pleasing way.
-
-
-
-
-
-
-
-
-
- !
Item was removed:
- ----- Method: CurvierMorph class>>descriptionForPartsBin (in category 'parts bin') -----
- descriptionForPartsBin
- "We are very much like curve only better looking."
- ^ self
- partName: 'Curvier'
- categories: #('Graphics' 'Basic' )
- documentation: 'A smooth wiggly curve, or a smooth curved solid without bends. Shift-click to get handles and move the points.'!
Item was removed:
- ----- Method: CurvierMorph class>>drawCurvier (in category 'class initialization') -----
- drawCurvier
- <preference: 'Curvier'
- category: 'morphic'
- description: 'If true, closed CurvierMorphs will be smoother and more symmetrical all about. If false they will mimic the old curve shapes with the one sharp bend.'
- type: #Boolean>
- ^DrawCurvier ifNil: [true]!
Item was removed:
- ----- Method: CurvierMorph class>>drawCurvier: (in category 'class initialization') -----
- drawCurvier: aBoolean
- DrawCurvier := aBoolean.!
Item was removed:
- ----- Method: CurvierMorph class>>initialize (in category 'class initialization') -----
- initialize
- "CurvierMorph initialize"
- self registerInFlapsRegistry!
Item was removed:
- ----- Method: CurvierMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
- registerInFlapsRegistry
- "Register the receiver in the system's flaps registry"
- self environment
- at: #Flaps
- ifPresent: [:cl |
- cl registerQuad: #(#CurvierMorph #authoringPrototype 'Curvier' 'A curve' ) forFlapNamed: 'PlugIn Supplies'.
- cl registerQuad: #(#CurvierMorph #authoringPrototype 'Curvier' 'A curve' ) forFlapNamed: 'Supplies']!
Item was removed:
- ----- Method: CurvierMorph>>initialize (in category 'initialization') -----
- initialize
- "We use an oval shape because we wear it well."
- super initialize.
- self beSmoothCurve.
- self diamondOval!
Item was removed:
- ----- Method: CustomMenu>>startUp:withCaption:at: (in category '*Morphic-invocation') -----
- startUp: initialSelection withCaption: caption at: aPoint
- "Build and invoke this menu with the given initial selection and caption.
- Answer the selection associated with the menu item chosen by the user
- or nil if none is chosen."
- self build.
- initialSelection notNil
- ifTrue: [self preSelect: initialSelection].
- ^ super startUpWithCaption: caption at: aPoint!
Item was removed:
- ----- Method: CustomMenu>>startUpWithCaption:at: (in category '*Morphic-invocation') -----
- startUpWithCaption: caption at: aPoint
- "Build and invoke this menu with no initial selection. Answer the
- selection associated with the menu item chosen by the user or nil if
- none is chosen; use the provided caption"
- ^ self startUp: nil withCaption: caption at: aPoint!
Item was removed:
- Object subclass: #DamageRecorder
- instanceVariableNames: 'invalidRects totalRepaint'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Support'!
Item was removed:
- ----- Method: DamageRecorder class>>new (in category 'instance creation') -----
- new
-
- ^ super new reset
- !
Item was removed:
- ----- Method: DamageRecorder>>doFullRepaint (in category 'recording') -----
- doFullRepaint
- "Record that a full redisplay is needed. No further damage rectangles will be recorded until after the next reset."
-
- ^ totalRepaint := true.
- !
Item was removed:
- ----- Method: DamageRecorder>>invalidRectsFullBounds: (in category 'recording') -----
- invalidRectsFullBounds: aRectangle
- "Return a collection of damaged rectangles for the given canvas. If a total repaint has been requested, return the given rectangle."
-
- totalRepaint
- ifTrue: [^ Array with: aRectangle]
- ifFalse: [^ invalidRects copy].
-
- !
Item was removed:
- ----- Method: DamageRecorder>>recordInvalidRect: (in category 'recording') -----
- recordInvalidRect: newRect
- "Record the given rectangle in my damage list, a list of rectangular areas of the display that should be redraw on the next display cycle."
- "Details: Damaged rectangles are often identical or overlap significantly. In these cases, we merge them to reduce the number of damage rectangles that must be processed when the display is updated. Moreover, above a certain threshold, we ignore the individual rectangles completely, and simply do a complete repaint on the next cycle."
-
- | mergeRect |
- totalRepaint ifTrue: [^ self]. "planning full repaint; don't bother collecting damage"
-
- invalidRects do:
- [:rect |
- | a |
- ((a := (rect intersect: newRect) area) > 40
- and: ["Avoid combining a vertical and horizontal rects.
- Can make a big diff and we only test when likely."
- a > (newRect area // 4) or: [a > (rect area // 4)]])
- ifTrue:
- ["merge rectangle in place (see note below) if there is significant overlap"
- rect setOrigin: (rect origin min: newRect origin) truncated
- corner: (rect corner max: newRect corner) truncated.
- ^ self]].
-
-
- invalidRects size >= 15 ifTrue:
- ["if there are too many separate areas, merge them all"
- mergeRect := Rectangle merging: invalidRects.
- self reset.
- invalidRects addLast: mergeRect].
-
- "add the given rectangle to the damage list"
- "Note: We make a deep copy of all rectangles added to the damage list,
- since rectangles in this list may be extended in place."
- invalidRects addLast:
- (newRect topLeft truncated corner: newRect bottomRight truncated).
- !
Item was removed:
- ----- Method: DamageRecorder>>reset (in category 'initialization') -----
- reset
- "Clear the damage list."
-
- invalidRects := OrderedCollection new: 15.
- totalRepaint := false
- !
Item was removed:
- ----- Method: DamageRecorder>>updateIsNeeded (in category 'testing') -----
- updateIsNeeded
- "Return true if the display needs to be updated."
-
- ^totalRepaint or: [invalidRects notEmpty]!
Item was removed:
- SimpleBorder subclass: #DashedBorder
- instanceVariableNames: 'dashLength gapLength gapColor offset'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Borders'!
Item was removed:
- ----- Method: DashedBorder>>dashLength (in category 'accessing') -----
- dashLength
-
- ^ dashLength!
Item was removed:
- ----- Method: DashedBorder>>dashLength: (in category 'accessing') -----
- dashLength: anObject
-
- dashLength := anObject.!
Item was removed:
- ----- Method: DashedBorder>>frameRectangle:on: (in category 'drawing') -----
- frameRectangle: aRectangle on: aCanvas
-
- {
- aRectangle topLeft. aRectangle topRight - (1 at 0).
- aRectangle topRight - (1 at 0). aRectangle bottomRight - (1 at 1).
- aRectangle bottomRight - (1 at 1). aRectangle bottomLeft - (0 at 1).
- aRectangle bottomLeft - (0 at 1). aRectangle topLeft.
- } pairsDo: [:startPoint :endPoint |
- aCanvas
- line: startPoint to: endPoint
- width: self width
- color: self color
- dashLength: self dashLength
- secondColor: self gapColor
- secondDashLength: self gapLength
- startingOffset: self offset]!
Item was removed:
- ----- Method: DashedBorder>>gapColor (in category 'accessing') -----
- gapColor
-
- ^ gapColor!
Item was removed:
- ----- Method: DashedBorder>>gapColor: (in category 'accessing') -----
- gapColor: anObject
-
- gapColor := anObject.!
Item was removed:
- ----- Method: DashedBorder>>gapLength (in category 'accessing') -----
- gapLength
-
- ^ gapLength!
Item was removed:
- ----- Method: DashedBorder>>gapLength: (in category 'accessing') -----
- gapLength: anObject
-
- gapLength := anObject.!
Item was removed:
- ----- Method: DashedBorder>>initialize (in category 'initialize-release') -----
- initialize
-
- super initialize.
-
- dashLength := 10.
-
- gapLength := 4.
- gapColor := Color transparent.
-
- offset := 0.!
Item was removed:
- ----- Method: DashedBorder>>offset (in category 'accessing') -----
- offset
-
- ^ offset!
Item was removed:
- ----- Method: DashedBorder>>offset: (in category 'accessing') -----
- offset: anObject
-
- offset := anObject.!
Item was removed:
- Morph subclass: #DialogWindow
- instanceVariableNames: 'titleMorph messageMorph paneMorph buttonRow result selectedButton cancelButton timeout preferredPosition keyMap exclusive filter filterEnabled filterMorph autoCancel'
- classVariableNames: 'GradientDialog IncludeCloseButton IncludeControlMenu RoundedDialogCorners UseWiggleAnimation'
- poolDictionaries: ''
- category: 'Morphic-Windows'!
-
- !DialogWindow commentStamp: '<historical>' prior: 0!
- A DialogBoxMorph is Morph used in simple yes/no/confirm dialogs. Strongly modal.!
Item was removed:
- ----- Method: DialogWindow class>>gradientDialog (in category 'preferences') -----
- gradientDialog
-
- <preference: 'gradientDialog'
- category: 'dialogs'
- description: 'If true, dialogs will have a gradient look.'
- type: #Boolean>
- ^ GradientDialog ifNil: [true]
- !
Item was removed:
- ----- Method: DialogWindow class>>gradientDialog: (in category 'preferences') -----
- gradientDialog: aBoolean
-
- aBoolean = GradientDialog ifTrue: [^ self].
- GradientDialog := aBoolean.
- self refreshAllDialogs.!
Item was removed:
- ----- Method: DialogWindow class>>includeCloseButton (in category 'preferences') -----
- includeCloseButton
-
- <preference: 'include dialog close button'
- category: #dialogs
- description: 'If true, user dialogs include a close button.'
- type: #Boolean>
- ^IncludeCloseButton ifNil: [true]!
Item was removed:
- ----- Method: DialogWindow class>>includeCloseButton: (in category 'preferences') -----
- includeCloseButton: aBoolean
-
- IncludeCloseButton := aBoolean!
Item was removed:
- ----- Method: DialogWindow class>>includeControlMenu (in category 'preferences') -----
- includeControlMenu
-
- <preference: 'include dialog control menu'
- category: #dialogs
- description: 'If true, user dialogs include a control menu.'
- type: #Boolean>
- ^IncludeControlMenu ifNil: [true]!
Item was removed:
- ----- Method: DialogWindow class>>includeControlMenu: (in category 'preferences') -----
- includeControlMenu: aBoolean
- IncludeControlMenu := aBoolean!
Item was removed:
- ----- Method: DialogWindow class>>refreshAllDialogs (in category 'preferences') -----
- refreshAllDialogs
-
- self allSubInstances do: [:instance | instance setDefaultParameters; setTitleParameters].!
Item was removed:
- ----- Method: DialogWindow class>>roundedDialogCorners (in category 'preferences') -----
- roundedDialogCorners
- <preference: 'Rounded Dialog Corners'
- categoryList: #(windows dialogs)
- description: 'If true, dialog windows will have rounded corners'
- type: #Boolean>
- ^ RoundedDialogCorners ifNil: [ true ]!
Item was removed:
- ----- Method: DialogWindow class>>roundedDialogCorners: (in category 'preferences') -----
- roundedDialogCorners: aBoolean
-
- RoundedDialogCorners = aBoolean ifTrue: [^ self].
- RoundedDialogCorners := aBoolean.
- self refreshAllDialogs.!
Item was removed:
- ----- Method: DialogWindow class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ super themeProperties, {
- { #borderColor. 'Colors'. 'Color of the dialogs''s border.' }.
- { #borderWidth. 'Borders'. 'Width of the dialogs''s border.' }.
- { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }.
- { #color. 'Colors'. 'Background color of the dialog.' }.
- { #font. 'Fonts'. 'Font for dialog messages.' }.
- { #textColor. 'Colors'. 'Color for dialog messages.' }.
-
- { #titleBorderColor. 'Colors'. 'Color of the dialogs title border.' }.
- { #titleBorderWidth. 'Geometry'. 'Width of the dialog title border.' }.
- { #titleBorderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset for the title.' }.
- { #titleColor. 'Colors'. 'Background color of the dialogs'' title.' }.
- { #titleFont. 'Fonts'. 'Font for dialog title.' }.
- { #titleTextColor. 'Colors'. 'Color for the dialog title label.' }.
-
- { #okColor. 'Colors'. 'Color for the OK button.' }.
- { #cancelColor. 'Colors'. 'Color for the Cancel button.' }.
- { #buttonColor. 'Colors'. 'Color for a normal button.' }.
- { #selectionModifier. 'Colors'. 'How to convert the color of a selected button?' }.
- }!
Item was removed:
- ----- Method: DialogWindow class>>useWiggleAnimation (in category 'preferences') -----
- useWiggleAnimation
-
- <preference: 'Use Wiggle Animation in Modal Dialogs'
- categoryList: #(Morphic windows dialogs)
- description: 'In order to indicate that a modal dialog is waiting for a user''s input, wiggle instead of flash.'
- type: #Boolean>
- ^ UseWiggleAnimation ifNil: [true]!
Item was removed:
- ----- Method: DialogWindow class>>useWiggleAnimation: (in category 'preferences') -----
- useWiggleAnimation: aBoolean
-
- UseWiggleAnimation := aBoolean.!
Item was removed:
- ----- Method: DialogWindow>>addPaneMorph: (in category 'constructing') -----
- addPaneMorph: aMorph
-
- self paneMorph addMorphBack: aMorph.!
Item was removed:
- ----- Method: DialogWindow>>applyUserInterfaceTheme (in category 'updating') -----
- applyUserInterfaceTheme
-
- super applyUserInterfaceTheme.
-
- self
- setDefaultParameters;
- setTitleParameters;
- setMessageParameters.
-
- "Update all buttons."
- selectedButton in: [:sb |
- self buttons do: [:ea |
- ea setProperty: #normalColor toValue: self defaultButtonColor.
- self deselectButton: ea].
- sb ifNotNil: [self selectButton: sb]].!
Item was removed:
- ----- Method: DialogWindow>>autoCancel (in category 'accessing') -----
- autoCancel
- "Whether to automatically cancel and close this dialog if the user clicks outside it. Like dismissing a pop-up menu."
-
- ^ autoCancel!
Item was removed:
- ----- Method: DialogWindow>>autoCancel: (in category 'accessing') -----
- autoCancel: aBoolean
-
- autoCancel := aBoolean.!
Item was removed:
- ----- Method: DialogWindow>>browseInvocation (in category 'running') -----
- browseInvocation
- "Browse the first meaningful invocation method of the receiver."
-
- self exclusive: false.
-
- (thisContext findContextSuchThat: self invocationContextPredicate) method browse.!
Item was removed:
- ----- Method: DialogWindow>>buttonRowMorph (in category 'accessing - ui') -----
- buttonRowMorph
- ^ buttonRow!
Item was removed:
- ----- Method: DialogWindow>>buttons (in category 'accessing - ui') -----
- buttons
-
- ^buttonRow submorphs!
Item was removed:
- ----- Method: DialogWindow>>cancelButton (in category 'accessing - ui') -----
- cancelButton
- ^ cancelButton!
Item was removed:
- ----- Method: DialogWindow>>cancelDialog (in category 'running') -----
- cancelDialog
-
- self cancelButton
- ifNil: [self closeDialog: nil]
- ifNotNil: [:btn | btn performAction]. !
Item was removed:
- ----- Method: DialogWindow>>closeDialog (in category 'running') -----
- closeDialog
-
- self selectedButton
- ifNil: [self closeDialog: nil]
- ifNotNil: [:btn | btn performAction]. !
Item was removed:
- ----- Method: DialogWindow>>closeDialog: (in category 'running') -----
- closeDialog: returnValue
- result := returnValue.
- self delete.!
Item was removed:
- ----- Method: DialogWindow>>createAcceptButton (in category 'constructing') -----
- createAcceptButton
-
- ^ self
- createButton: 'Accept' translated
- value: true
- color: (self userInterfaceTheme okColor ifNil: [Color r: 0.49 g: 0.749 b: 0.49])!
Item was removed:
- ----- Method: DialogWindow>>createBody (in category 'initialization') -----
- createBody
-
- | body |
- body := Morph new
- name: 'Body';
- changeTableLayout;
- hResizing: #shrinkWrap;
- vResizing: #shrinkWrap;
- rubberBandCells: true;
- listDirection: #topToBottom;
- layoutInset: ((10 at 5 * RealEstateAgent scaleFactor) rounded corner: (10 at 10 * RealEstateAgent scaleFactor) rounded);
- cellGap: (5 * RealEstateAgent scaleFactor) rounded;
- color: Color transparent;
- yourself.
- body addAllMorphs: {self createMessage: ''. self createPane. self createButtonRow. self createFilter}.
- self addMorphBack: body.!
Item was removed:
- ----- Method: DialogWindow>>createButton: (in category 'constructing') -----
- createButton: buttonLabel
-
- ^ self
- createButton: buttonLabel
- value: self buttonRow submorphs size + 1
- color: self defaultButtonColor!
Item was removed:
- ----- Method: DialogWindow>>createButton:value: (in category 'constructing') -----
- createButton: buttonLabel value: buttonValue
-
- ^ self
- createButton: buttonLabel
- value: buttonValue
- color: self defaultButtonColor!
Item was removed:
- ----- Method: DialogWindow>>createButton:value:color: (in category 'constructing') -----
- createButton: buttonLabel value: buttonValue color: buttonColor
-
- | button |
- button := PluggableButtonMorphPlus new
- label: buttonLabel ;
- action: [ self closeDialog: buttonValue ] ;
- setProperty: #normalColor toValue: buttonColor ;
- setProperty: #normalLabel toValue: buttonLabel ;
- hResizing: #rigid;
- vResizing: #rigid;
- yourself.
-
- self deselectButton: button.
- buttonRow addMorphBack: button.
- self updateButtonExtent.
-
- ^ button!
Item was removed:
- ----- Method: DialogWindow>>createButtonRow (in category 'initialization') -----
- createButtonRow
-
- ^ buttonRow := Morph new
- name: 'Buttons';
- color: Color transparent;
- changeTableLayout;
- vResizing: #shrinkWrap;
- hResizing: #shrinkWrap;
- listDirection: #leftToRight;
- listCentering: #center;
- cellGap: (5 * RealEstateAgent scaleFactor) rounded;
- yourself!
Item was removed:
- ----- Method: DialogWindow>>createCancelButton (in category 'constructing') -----
- createCancelButton
-
- ^ cancelButton := self
- createButton: 'Cancel' translated
- value: false
- color: (self userInterfaceTheme cancelColor ifNil: [Color r: 1 g: 0.6 b: 0.588])!
Item was removed:
- ----- Method: DialogWindow>>createCancelButton:value: (in category 'constructing') -----
- createCancelButton: label value: result
-
- ^ cancelButton := self
- createButton: label
- value: result!
Item was removed:
- ----- Method: DialogWindow>>createFilter (in category 'initialization') -----
- createFilter
- "This is an invisible morph that catches keystrokes to filter content in multiple widgets at once. Needs #filterEnabled to be true."
-
- filterMorph := '' asText asMorph lock.
- filterMorph
- name: 'Filter';
- visible: false;
- disableLayout: true.
- ^ filterMorph!
Item was removed:
- ----- Method: DialogWindow>>createMessage: (in category 'initialization') -----
- createMessage: aString
-
- messageMorph := aString asText asMorph.
- messageMorph
- name: 'Message';
- readOnly: true;
- hResizing: #shrinkWrap; vResizing: #shrinkWrap;
- averageLineLength: 45;
- setProperty: #indicateKeyboardFocus toValue: #never;
- handlesKeyboardOnlyOnFocus: true. "If user presses enter while only hovering the text, we want to process the stroke to close the dialog."
- self setMessageParameters.
- ^ messageMorph!
Item was removed:
- ----- Method: DialogWindow>>createPane (in category 'initialization') -----
- createPane
-
- ^ paneMorph := BorderedMorph new
- name: 'Content';
- changeProportionalLayout;
- hResizing: #rigid;
- vResizing: #rigid;
- layoutInset: (0 at 0 corner: 0@ (TextStyle pointsToPixels: 5) truncated);
- color: Color transparent;
- borderWidth: 0;
- yourself.!
Item was removed:
- ----- Method: DialogWindow>>createTitle: (in category 'initialization') -----
- createTitle: aString
- "Mimick behavior of MenuMorph title creation."
-
- | box closeButton menuButton |
- box := Morph new
- name: #title;
- changeTableLayout;
- listDirection: #leftToRight;
- yourself.
-
- titleMorph := aString asText asMorph lock.
-
- closeButton := SystemWindowButton new
- color: Color transparent;
- target: self;
- extent: 12 at 12;
- actionSelector: #cancelDialog;
- balloonText: 'Cancel this dialog' translated;
- borderWidth: 0;
- visible: self class includeCloseButton;
- yourself.
- SystemWindow closeBoxImage scaleIconToDisplay in: [:icon |
- closeButton labelGraphic: icon; extent: icon extent].
-
- menuButton := SystemWindowButton new
- color: Color transparent;
- target: self;
- actionSelector: #offerDialogMenu;
- balloonText: 'Dialog menu' translated;
- actWhen: #buttonDown;
- borderWidth: 0;
- visible: self class includeControlMenu;
- yourself.
- SystemWindow menuBoxImage scaleIconToDisplay in: [:icon |
- menuButton labelGraphic: icon; extent: icon extent].
-
- box addAllMorphs: {closeButton. titleMorph. menuButton}.
-
- self addMorphBack: box.
- self setTitleParameters.!
Item was removed:
- ----- Method: DialogWindow>>debugInvocation (in category 'running') -----
- debugInvocation
- "Bring up a debugger on the active process, displaying the invocation of the receiver. Strip off irrelevant stack frames that are an implementation detail of the invocation."
-
- self exclusive: false.
-
- ^ Processor
- debugContextThat: self invocationContextPredicate
- title: 'Dialog invocation' translated
- full: true!
Item was removed:
- ----- Method: DialogWindow>>defaultButtonColor (in category 'accessing') -----
- defaultButtonColor
-
- ^ self userInterfaceTheme buttonColor ifNil: [(Color r: 0.658 g: 0.678 b: 0.78) twiceLighter]!
Item was removed:
- ----- Method: DialogWindow>>defaultFocusMorph (in category 'accessing') -----
- defaultFocusMorph
-
- (preferredPosition isMorph and: [preferredPosition wantsKeyboardFocus]) ifTrue: [^ preferredPosition].
-
- ^ self!
Item was removed:
- ----- Method: DialogWindow>>deselectButton: (in category 'selection') -----
- deselectButton: aButton
-
- aButton ifNil: [^ self].
- aButton offColor: (aButton valueOfProperty: #normalColor).
- aButton == selectedButton ifTrue: [selectedButton := nil].!
Item was removed:
- ----- Method: DialogWindow>>drawOverlayOn: (in category 'drawing') -----
- drawOverlayOn: aCanvas
-
- | title inset |
- super drawOverlayOn: aCanvas.
-
- title := self submorphs first.
-
- self wantsRoundedCorners ifTrue: [
- inset := (self class roundedDialogCorners and: [self class gradientDialog])
- "This check compensates a bug in balloon."
- ifTrue: [0 at 0 corner: 0@ -1] ifFalse: [self borderWidth @ 0].
-
- "Overdraw lower part of title bar to hide bottom corners."
- aCanvas
- fillRectangle:( (title bottomLeft - (0 @ self submorphs first cornerRadius) corner: title bottomRight) insetBy: inset)
- color: self color].
-
- "Draw a line between the title and the contents."
- self borderWidth > 0 ifTrue: [
- "Redraw the border all around. Needed because rounded borders do not align very well."
- self wantsRoundedCorners
- ifTrue: [ aCanvas frameRoundRect: self bounds radius: self cornerRadius width: self borderStyle width color: self borderStyle color]
- ifFalse: [aCanvas frameRectangle: self bounds width: self borderStyle width color: self borderStyle color]].!
Item was removed:
- ----- Method: DialogWindow>>ensureSelectedButton (in category 'selection') -----
- ensureSelectedButton
-
- self buttons ifEmpty: [^ self].
- self selectedButton ifNil: [self selectButton: self buttons first].
- self selectedButton enabled ifFalse: [self selectNextButton].!
Item was removed:
- ----- Method: DialogWindow>>exclusive (in category 'accessing') -----
- exclusive
-
- ^ exclusive!
Item was removed:
- ----- Method: DialogWindow>>exclusive: (in category 'accessing') -----
- exclusive: aBoolean
-
- exclusive := aBoolean.
-
- exclusive
- ifTrue: [self activeHand newMouseFocus: self]
- ifFalse: [self activeHand releaseMouseFocus: self].!
Item was removed:
- ----- Method: DialogWindow>>filter (in category 'accessing') -----
- filter
- ^ filter ifNil: ['']!
Item was removed:
- ----- Method: DialogWindow>>filter: (in category 'accessing') -----
- filter: aString
- filter := aString.
- self updateFilter.!
Item was removed:
- ----- Method: DialogWindow>>filterEnabled (in category 'accessing') -----
- filterEnabled
- ^ filterEnabled ifNil: [false]!
Item was removed:
- ----- Method: DialogWindow>>filterEnabled: (in category 'accessing') -----
- filterEnabled: aBoolean
-
- filterEnabled := aBoolean.
- self updateFilter.!
Item was removed:
- ----- Method: DialogWindow>>flash (in category 'running') -----
- flash
- "Flash me"
- Beeper beepPrimitive.
-
- self class useWiggleAnimation ifTrue: [
- #(-2 4 -6 8 -4) do: [:i |
- self left: self left + i.
- self refreshWorld.
- ] separatedBy: [(Delay forMilliseconds: 50) wait]
- ] ifFalse: [
- 1 to: 2 do:[:i|
- self color: Color black.
- self world doOneCycleNow.
- (Delay forMilliseconds: 50) wait.
- self color: Color white.
- self world doOneCycleNow.
- (Delay forMilliseconds: 50) wait] ]!
Item was removed:
- ----- Method: DialogWindow>>getUserResponse (in category 'running') -----
- getUserResponse
-
- | hand world |
- self message ifEmpty: [messageMorph delete]. "Do not waste space."
- self paneMorph submorphs
- ifEmpty: ["Do not waste space and avoid strange button-row wraps."
- self paneMorph delete.
- self buttonRowMorph wrapDirection: #none].
-
- hand := self currentHand.
- world := self currentWorld.
-
- self fullBounds.
- self morphicLayerNumber: self class dialogLayer.
- self moveToPreferredPosition.
- self openInWorld: world.
-
- hand showTemporaryCursor: nil. "Since we are out of context, reset the cursor."
-
- hand keyboardFocus in: [:priorKeyboardFocus |
- hand mouseFocus in: [:priorMouseFocus |
- self exclusive ifTrue: [hand newMouseFocus: self].
- hand newKeyboardFocus: self defaultFocusMorph.
-
- [[self isInWorld] whileTrue: [world doOneSubCycle]]
- ifCurtailed: [self cancelDialog].
-
- hand newKeyboardFocus: priorKeyboardFocus.
-
- self flag: #discuss. "Since 2016 we are having this *ping pong* between (a) restoring the prior mouse focus and (b) just clearing it globally. The former solution makes more sense while the latter fixes issues with some modal dialogs. We have to investigate this further."
- hand releaseMouseFocus.
- "hand newMouseFocus: priorMouseFocus."]].
-
- ^ result!
Item was removed:
- ----- Method: DialogWindow>>getUserResponseAfter: (in category 'running') -----
- getUserResponseAfter: seconds
-
- timeout := seconds + 1.
-
- self ensureSelectedButton.
- self step.
- self updateButtonExtent.
-
- ^ self getUserResponse!
Item was removed:
- ----- Method: DialogWindow>>getUserResponseAtHand (in category 'running') -----
- getUserResponseAtHand
- "Remove unnecessary widgets."
- self message ifEmpty: [ messageMorph delete ].
- self paneMorph submorphs ifEmpty: [ self paneMorph delete ].
- "Modal dialogs must be as convenient as possible, put default button directly under hand."
- self
- ensureSelectedButton ;
- preferredPosition: self selectedButton.
- ^ self getUserResponse!
Item was removed:
- ----- Method: DialogWindow>>handleMouseDown: (in category 'events') -----
- handleMouseDown: event
- "Always bring me to the front since I am modal"
-
- self comeToFront.
- ^ super handleMouseDown: event!
Item was removed:
- ----- Method: DialogWindow>>handleMouseUp: (in category 'events') -----
- handleMouseUp: event
-
- super handleMouseUp: event.
- self exclusive ifTrue: [event hand newMouseFocus: self].!
Item was removed:
- ----- Method: DialogWindow>>handlesKeyboard: (in category 'events') -----
- handlesKeyboard: evt
-
- ^true!
Item was removed:
- ----- Method: DialogWindow>>handlesMouseDown: (in category 'events') -----
- handlesMouseDown: evt
-
- ^ true!
Item was removed:
- ----- Method: DialogWindow>>initialExtent (in category 'initialization') -----
- initialExtent
- "Scale here because dialogs -- unlike SystemWindow -- will not use the RealEstateAgent to open (i.e., #openInWorld:)."
-
- ^ ((200 at 150) * RealEstateAgent scaleFactor) truncated!
Item was removed:
- ----- Method: DialogWindow>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
-
- self
- changeTableLayout;
- listDirection: #topToBottom;
- hResizing: #shrinkWrap;
- vResizing: #shrinkWrap;
- rubberBandCells: true;
- disableLayout: true;
- setProperty: #indicateKeyboardFocus toValue: #never.
-
- self createTitle: 'Dialog'.
- self createBody.
-
- self setDefaultParameters.
-
- keyMap := Dictionary new.
- exclusive := true.
- autoCancel := false.
- preferredPosition := self currentWorld center.!
Item was removed:
- ----- Method: DialogWindow>>invocationContextPredicate (in category 'private') -----
- invocationContextPredicate
-
- | searchPhase hiddenCategories |
- self flag: #todo. "ct: Currently, this might cut away a few contexts too much when a dialog window is opened from Morphic code (e.g., SystemWindow>>relabel) directly. With the introduction of UserNotifications, however, this problem will be solved because there will be always an external context between the client and the receiver. See http://forum.world.st/Discussion-Warning-vs-Halt-or-quot-Why-is-a-warning-a-notification-quot-td5106457.html#a5106605 and others."
-
- searchPhase := true.
- hiddenCategories := #('Morphic-Windows' 'ToolBuilder-Kernel' 'ToolBuilder-Morphic' 'ToolBuilder-Morphic-Tools').
- ^ [:ctx |
- searchPhase
- ifTrue: [ "search invocation context"
- (ctx isMethodContext and: [ctx method selector = #getUserResponse])
- ifTrue: [searchPhase := false].
- false]
- ifFalse: [ "filter out irrelevant contexts"
- (hiddenCategories includes: ctx receiver class category) not]]!
Item was removed:
- ----- Method: DialogWindow>>justDroppedInto:event: (in category 'dropping/grabbing') -----
- justDroppedInto: aMorph event: event
-
- "Restore drop shadow if necessary."
- self hasDropShadow: Preferences menuAppearance3d.
-
- self exclusive ifTrue: [
- "aggressively preserve focus"
- event hand newMouseFocus: self].!
Item was removed:
- ----- Method: DialogWindow>>keyStroke: (in category 'events') -----
- keyStroke: evt
- | char |
- self stopAutoTrigger.
- char := evt keyCharacter.
-
- char = Character escape ifTrue: [ ^ self cancelDialog ].
- (char = Character cr or: [char = Character enter]) ifTrue: [ ^ self closeDialog ].
-
- ((char = Character arrowLeft or: [char = Character arrowUp])
- or: [ evt shiftPressed and: [ char = Character tab ] ])
- ifTrue: [ ^ self selectPreviousButton ].
- ((char = Character arrowRight or: [char = Character arrowDown])
- or: [ char = Character tab ])
- ifTrue: [ ^ self selectNextButton ].
-
- self filterEnabled ifTrue: [
- char = Character backspace ifTrue: [self filter: (self filter ifEmpty: [''] ifNotEmpty: [:f | f allButLast])].
- (char isAlphaNumeric or: [char = Character space])
- ifTrue: [self filter: self filter, char asString]].
-
- keyMap
- at: char asLowercase
- ifPresent: [ : foundButton | foundButton performAction ]
- ifAbsent: [ "do nothing" ].!
Item was removed:
- ----- Method: DialogWindow>>message (in category 'accessing') -----
- message
- ^messageMorph contents!
Item was removed:
- ----- Method: DialogWindow>>message: (in category 'accessing') -----
- message: aStringOrText
-
- aStringOrText size > 900 ifTrue: [
- "NOTE THAT this is an awkward compromise for clients misusing the medium of a dialog window. Because of a dialog's rather short lifespan, users should only be presented with compact content and a concise message. If you notice that your dialog is getting too tall or -- in this case -- wider than usual, please consider rewriting its message."
- self messageMorph averageLineLength: 65].
-
- messageMorph contents: aStringOrText.
- self setMessageParameters.!
Item was removed:
- ----- Method: DialogWindow>>messageMorph (in category 'accessing - ui') -----
- messageMorph
- ^ messageMorph!
Item was removed:
- ----- Method: DialogWindow>>mouseDown: (in category 'events') -----
- mouseDown: event
-
- self stopAutoTrigger.
-
- (self containsPoint: event position) ifFalse: [
- ^ self autoCancel
- ifTrue: [self cancelDialog]
- ifFalse: [self flash]].
-
- event hand
- waitForClicksOrDrag: self
- event: event
- selectors: { nil. nil. nil. #startDrag: }
- threshold: HandMorph dragThreshold.!
Item was removed:
- ----- Method: DialogWindow>>mouseUp: (in category 'events') -----
- mouseUp: event
- self stopAutoTrigger.
- !
Item was removed:
- ----- Method: DialogWindow>>moveToHand (in category 'position') -----
- moveToHand
-
- self moveToHand: self currentHand.!
Item was removed:
- ----- Method: DialogWindow>>moveToHand: (in category 'position') -----
- moveToHand: aHand
- self preferredPosition: aHand position!
Item was removed:
- ----- Method: DialogWindow>>moveToPreferredPosition (in category 'initialization') -----
- moveToPreferredPosition
- "Moves the dialog window to its preferred position, which can be a point on the screen or a named widget in the dialog's central pane. Ensure that the dialog is fully visible in the world. Also see #positionOverWidgetNamed:."
-
- | visibleArea decorationOffset |
- self fullBounds. "Compute new layout to have updated bounds."
- visibleArea := self currentWorld visibleClearArea.
- decorationOffset := self extent - self paneMorph extent.
- self paneMorph extent:
- (self paneMorph extent min: visibleArea extent - decorationOffset).
- self fullBounds. "Compute new layout to have updated bounds."
- self center:
- (preferredPosition isPoint
- ifTrue: [ preferredPosition ]
- ifFalse: [ self center + self currentHand position - preferredPosition center ]).
- self bounds:
- (self bounds translatedToBeWithin: visibleArea).!
Item was removed:
- ----- Method: DialogWindow>>offerDialogMenu (in category 'running') -----
- offerDialogMenu
-
- | menu |
- menu := MenuMorph new defaultTarget: self.
- menu
- add: (exclusive == true ifTrue: ['<yes>'] ifFalse: ['<no>']), 'be modally exclusive' translated
- action: #toggleExclusive;
- addLine;
- add: 'browse invocation' translated
- action: #browseInvocation;
- add: 'debug invocation' translated
- action: #debugInvocation.
-
- menu popUpEvent: self currentEvent in: self world.
-
- [menu isInWorld] whileTrue: [self world doOneSubCycle].
- self exclusive ifTrue: [self activeHand newMouseFocus: self].!
Item was removed:
- ----- Method: DialogWindow>>paneMorph (in category 'accessing - ui') -----
- paneMorph
- ^ paneMorph!
Item was removed:
- ----- Method: DialogWindow>>positionOverWidgetNamed: (in category 'initialization') -----
- positionOverWidgetNamed: nameSymbol
- self allMorphsDo:
- [ : each | each knownName = nameSymbol ifTrue: [ self preferredPosition: each ] ]!
Item was removed:
- ----- Method: DialogWindow>>preferredPosition: (in category 'position') -----
- preferredPosition: aPointOrMorph
- "Specify that the dialog should be positioned at an absolute Point on the screen, or the particular Morph widget which should be positioned under the hand."
- preferredPosition := aPointOrMorph!
Item was removed:
- ----- Method: DialogWindow>>processFocusEvent:using: (in category 'events') -----
- processFocusEvent: evt using: dispatcher
-
- ^ dispatcher dispatchFocusEventFully: evt with: self!
Item was removed:
- ----- Method: DialogWindow>>registerKeyboardShortcutFor: (in category 'constructing') -----
- registerKeyboardShortcutFor: button
- "Take the first alpha-numeric character that is not already used as a shortcut, and use it as a shortcut."
-
- (button valueOfProperty: #normalLabel) asString in: [:normalLabel | normalLabel do: [:char |
- char isAlphaNumeric ifTrue: [ keyMap
- at: char asLowercase
- ifPresent: [:ea | "Ignore"]
- ifAbsent: [
- button setProperty: #normalLabel toValue: ('{1} ({2})' format: {normalLabel. char asLowercase}).
- button label: (button valueOfProperty: #normalLabel).
- ^ keyMap at: char asLowercase put: button ] ] ] ]!
Item was removed:
- ----- Method: DialogWindow>>registerKeyboardShortcuts (in category 'constructing') -----
- registerKeyboardShortcuts
-
- self buttons do: [:ea | self registerKeyboardShortcutFor: ea].!
Item was removed:
- ----- Method: DialogWindow>>selectButton: (in category 'selection') -----
- selectButton: aButton
-
- | buttonColor |
- buttonColor := ((self userInterfaceTheme selectionModifier ifNil: [ [:c | c muchLighter] ]) value: (aButton valueOfProperty: #normalColor)).
- self deselectButton: selectedButton.
- aButton offColor: buttonColor.
- selectedButton := aButton.!
Item was removed:
- ----- Method: DialogWindow>>selectNextButton (in category 'selection') -----
- selectNextButton
-
- self selectedButton ifNil: [^ self].
- (self buttons anySatisfy: [:ea | ea enabled]) ifFalse: [^ self].
-
- self selectedButtonIndex: self selectedButtonIndex \\ self buttons size + 1.
- self selectedButton enabled ifFalse: [self selectNextButton].!
Item was removed:
- ----- Method: DialogWindow>>selectPreviousButton (in category 'selection') -----
- selectPreviousButton
-
- self selectedButton ifNil: [^ self].
- (self buttons anySatisfy: [:ea | ea enabled]) ifFalse: [^ self].
-
- self selectedButtonIndex: self selectedButtonIndex - 2 \\ self buttons size + 1.
- self selectedButton enabled ifFalse: [self selectPreviousButton].!
Item was removed:
- ----- Method: DialogWindow>>selectedButton (in category 'accessing') -----
- selectedButton
- ^ selectedButton!
Item was removed:
- ----- Method: DialogWindow>>selectedButton: (in category 'accessing') -----
- selectedButton: aButton
-
- aButton
- ifNil: [self deselectButton: self selectedButton]
- ifNotNil: [self selectButton: aButton].!
Item was removed:
- ----- Method: DialogWindow>>selectedButtonIndex (in category 'accessing') -----
- selectedButtonIndex
-
- ^ self selectedButton
- ifNil: [0]
- ifNotNil: [:btn | self buttons indexOf: btn]!
Item was removed:
- ----- Method: DialogWindow>>selectedButtonIndex: (in category 'accessing') -----
- selectedButtonIndex: anInteger
-
- anInteger = 0 ifTrue: [^ self selectedButton: nil].
- self selectedButton: (self buttons at: anInteger).!
Item was removed:
- ----- Method: DialogWindow>>setDefaultParameters (in category 'initialization') -----
- setDefaultParameters
- "change the receiver's appareance parameters"
-
- self
- color: (self userInterfaceTheme color ifNil: [Color white]);
- borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle simple]) copy;
- borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]);
- borderWidth: ((self userInterfaceTheme borderWidth ifNil: [1]) * RealEstateAgent scaleFactor) truncated;
- layoutInset: ((self class roundedDialogCorners and: [self class gradientDialog])
- "This check compensates a bug in balloon."
- ifTrue: [0] ifFalse: [self borderWidth negated asPoint]).
-
- Preferences menuAppearance3d ifTrue: [self addDropShadow].!
Item was removed:
- ----- Method: DialogWindow>>setMessageParameters (in category 'initialization') -----
- setMessageParameters
-
- | fontToUse colorToUse margins |
- messageMorph ifNil: [^ self].
-
- fontToUse := self userInterfaceTheme font ifNil: [TextStyle defaultFont].
- colorToUse := self userInterfaceTheme textColor ifNil: [Color black].
-
- margins := (TextStyle pointsToPixels: 5) truncated.
-
- messageMorph
- margins: (self wantsRoundedCorners
- ifTrue: [margins @ (margins - self cornerRadius) corner: margins @ margins]
- ifFalse: [margins]);
- textColor: colorToUse;
- textStyle: fontToUse asNewTextStyle. "Use style with other point sizes available"
-
- "Style read-only text for copy interaction."
- self flag: #todo. "mt: Duplication with PluggableTextMorph >> #setDefaultParameters"
- (UserInterfaceTheme current get: #caretColor for: #PluggableTextMorph)
- ifNotNil: [:c | messageMorph caretColor: c].
- (UserInterfaceTheme current get: #selectionColor for: #PluggableTextMorph)
- ifNotNil: [:c |
- self userInterfaceTheme color = (UserInterfaceTheme current get: #color for: #PluggableTextMorph)
- ifTrue: [messageMorph selectionColor: c]
- ifFalse: [
- "Background is different than in a text field. Use dialog-title color to ensure contrast."
- messageMorph selectionColor: self userInterfaceTheme titleColor]].!
Item was removed:
- ----- Method: DialogWindow>>setTitleParameters (in category 'initialization') -----
- setTitleParameters
-
- | scaleFactor |
- scaleFactor := RealEstateAgent scaleFactor.
- (self submorphNamed: #title) ifNotNil: [:title |
- title
- fillStyle: (self class gradientDialog
- ifFalse: [SolidFillStyle color: (self userInterfaceTheme titleColor ifNil: [Color r: 0.658 g: 0.678 b: 0.78])]
- ifTrue: [self titleGradientFor: title from: (self userInterfaceTheme titleColor ifNil: [Color r: 0.658 g: 0.678 b: 0.78])]);
- borderStyle: (self userInterfaceTheme titleBorderStyle ifNil: [BorderStyle simple]) copy;
- borderColor: (self userInterfaceTheme titleBorderColor ifNil: [Color r: 0.6 g: 0.7 b: 1]);
- borderWidth: (self userInterfaceTheme titleBorderWidth ifNil: [0]);
- cornerStyle: (self wantsRoundedCorners ifTrue: [#rounded] ifFalse: [#square]);
- vResizing: #shrinkWrap;
- hResizing: #spaceFill;
- cellGap: (5 * scaleFactor) rounded;
- layoutInset: ((5 at 3 * scaleFactor) rounded
- corner: (5 at 2 * scaleFactor) rounded
- + (self wantsRoundedCorners ifFalse: [0 at 0] ifTrue: [0 at self cornerRadius]) )].
-
- titleMorph ifNotNil: [
- | fontToUse colorToUse |
- fontToUse := self userInterfaceTheme titleFont ifNil: [TextStyle defaultFont].
- colorToUse := self userInterfaceTheme titleTextColor ifNil: [Color black].
-
- "Temporary HACK for 64-bit CI build. Can be removed in the future."
- titleMorph contents isText ifFalse: [^ self].
-
- titleMorph
- hResizing: #spaceFill;
- vResizing: #shrinkWrap.
-
- titleMorph contents
- addAttribute: (TextFontReference toFont: fontToUse);
- addAttribute: (TextColor color: colorToUse);
- addAttribute: TextAlignment centered].!
Item was removed:
- ----- Method: DialogWindow>>startDrag: (in category 'dropping/grabbing') -----
- startDrag: event
-
- self hasDropShadow: false.
- event hand grabMorph: self.!
Item was removed:
- ----- Method: DialogWindow>>step (in category 'stepping and presenter') -----
- step
- timeout ifNil: [^self].
- timeout = 0
- ifTrue: [
- self stopStepping.
- selectedButton performAction]
- ifFalse: [
- selectedButton label: ('{1} [{2}]' format: {
- selectedButton valueOfProperty: #normalLabel.
- timeout}).
- timeout := timeout - 1]!
Item was removed:
- ----- Method: DialogWindow>>stepTime (in category 'stepping and presenter') -----
- stepTime
- ^1000!
Item was removed:
- ----- Method: DialogWindow>>stopAutoTrigger (in category 'stepping and presenter') -----
- stopAutoTrigger
- timeout ifNil: [^self].
- timeout := nil.
- self stopStepping.
- selectedButton label: (selectedButton valueOfProperty: #normalLabel). !
Item was removed:
- ----- Method: DialogWindow>>title (in category 'accessing') -----
- title
- ^titleMorph contents!
Item was removed:
- ----- Method: DialogWindow>>title: (in category 'accessing') -----
- title: aString
-
- titleMorph contents: aString asText.
- self setTitleParameters.!
Item was removed:
- ----- Method: DialogWindow>>titleGradientFor:from: (in category 'initialization') -----
- titleGradientFor: morph from: aColor
-
- | cc gradient |
- cc := aColor.
- gradient := GradientFillStyle ramp: {
- 0.0 -> Color white.
- 0.15 ->(cc mixed: 0.5 with: Color white).
- 0.7 -> cc.
- }.
- gradient origin: morph topLeft.
- gradient direction: 0 @ (TextStyle defaultFont height + 10).
- ^ gradient!
Item was removed:
- ----- Method: DialogWindow>>toggleExclusive (in category 'running') -----
- toggleExclusive
-
- self exclusive: self exclusive not.!
Item was removed:
- ----- Method: DialogWindow>>update: (in category 'updating') -----
- update: aspect
-
- aspect == #buttons
- ifTrue: [self updateButtonExtent].
-
- aspect == #flash
- ifTrue: [self flash].
-
- ^ super update: aspect!
Item was removed:
- ----- Method: DialogWindow>>updateButtonExtent (in category 'updating') -----
- updateButtonExtent
-
- self updateButtonExtent: (20 at 0 * RealEstateAgent scaleFactor) rounded.!
Item was removed:
- ----- Method: DialogWindow>>updateButtonExtent: (in category 'updating') -----
- updateButtonExtent: margin
-
- "Update all button extents."
- | preferredButtonHeight |
- preferredButtonHeight := ToolBuilder default buttonRowHeight.
- (buttonRow submorphs collect: [:ea | ea minimumExtent]) max + margin in: [:preferredExtent |
- buttonRow submorphsDo: [:ea | ea extent: preferredExtent x @ preferredButtonHeight]].
-
- "Check whether horizontal or vertical button layout would be more appropriate."
- buttonRow listDirection: #leftToRight; fullBounds.
- buttonRow width > self messageMorph compositionRectangle width
- ifTrue: [buttonRow listDirection: #topToBottom].!
Item was removed:
- ----- Method: DialogWindow>>updateFilter (in category 'updating') -----
- updateFilter
-
- self buttons do: [:ea |
- ea enabled: (self filter isEmpty or: [ea label asString includesSubstring: self filter caseSensitive: false])].
-
- filterMorph
- visible: self filter notEmpty;
- disableLayout: self filter isEmpty;
- contents: '<', self filter, '>';
- textColor: self messageMorph textColor.
-
- self ensureSelectedButton.!
Item was removed:
- ----- Method: DialogWindow>>wantsRoundedCorners (in category 'rounding') -----
- wantsRoundedCorners
-
- ^ self class roundedDialogCorners or: [super wantsRoundedCorners]!
Item was removed:
- ----- Method: DialogWindow>>wantsToBeDroppedInto: (in category 'dropping/grabbing') -----
- wantsToBeDroppedInto: aMorph
- "Return true if it's okay to drop the receiver into aMorph"
- ^aMorph isWorldMorph "only into worlds"!
Item was removed:
- ----- Method: Dictionary>>explorerContents (in category '*Morphic-Explorer') -----
- explorerContents
-
- ^self keysSortedSafely replace: [ :key |
- ObjectExplorerWrapper
- with: (self at: key)
- name: (key printString contractTo: 32)
- model: self ]
- !
Item was removed:
- ----- Method: Dictionary>>hasContentsInExplorer (in category '*Morphic-Explorer') -----
- hasContentsInExplorer
-
- ^self isEmpty not!
Item was removed:
- ----- Method: DisplayScreen>>defaultCanvasClass (in category '*Morphic-blitter defaults') -----
- defaultCanvasClass
- "Return the WarpBlt version to use when I am active"
- ^FormCanvas!
Item was removed:
- BorderedMorph subclass: #DoCommandOnceMorph
- instanceVariableNames: 'target command actionBlock innerArea'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Basic'!
-
- !DoCommandOnceMorph commentStamp: '<historical>' prior: 0!
- I am used to execute a once-only command. My first use was in loading/saving the current project. In such cases it is necessary to be in another project to do the actual work. So an instance of me is added to a new world/project and that project is entered. I do my stuff (save/load followed by a re-enter of the previous project) and everyone is happy.!
Item was removed:
- ----- Method: DoCommandOnceMorph>>actionBlock: (in category 'accessing') -----
- actionBlock: aBlock
-
- actionBlock := aBlock!
Item was removed:
- ----- Method: DoCommandOnceMorph>>addText: (in category 'ui') -----
- addText: aString
-
- | t |
- t := TextMorph new
- beAllFont: (TextStyle default fontOfSize: 26);
- contents: aString.
- self extent: t extent * 3.
- innerArea := Morph new
- color: Color white;
- extent: self extent - (16 at 16);
- position: self position + (8 at 8);
- lock.
- self addMorph: innerArea.
- self addMorph: (t position: self position + t extent; lock).!
Item was removed:
- ----- Method: DoCommandOnceMorph>>defaultBorderColor (in category 'initialization') -----
- defaultBorderColor
- "answer the default border color/fill style for the receiver"
- ^ Color blue!
Item was removed:
- ----- Method: DoCommandOnceMorph>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- "answer the default border width for the receiver"
- ^ 8!
Item was removed:
- ----- Method: DoCommandOnceMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
-
- self useRoundedCorners!
Item was removed:
- ----- Method: DoCommandOnceMorph>>openInWorld: (in category 'initialization') -----
- openInWorld: aWorld
-
- self position: aWorld topLeft + (aWorld extent - self extent // 2).
- super openInWorld: aWorld!
Item was removed:
- ----- Method: DoCommandOnceMorph>>step (in category 'stepping and presenter') -----
- step
-
- | goForIt |
-
- actionBlock ifNil: [^self stopStepping].
- goForIt := actionBlock.
- actionBlock := nil.
- goForIt
- on: ProgressTargetRequestNotification
- do: [ :ex | ex resume: innerArea]. "in case a save/load progress display needs a home"
- !
Item was removed:
- ----- Method: DoCommandOnceMorph>>stepTime (in category 'stepping and presenter') -----
- stepTime
-
- ^1
- !
Item was removed:
- ----- Method: DoCommandOnceMorph>>wantsSteps (in category 'stepping and presenter') -----
- wantsSteps
-
- ^actionBlock notNil
- !
Item was removed:
- MenuItemMorph subclass: #DockingBarItemMorph
- instanceVariableNames: 'selectedIcon'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Menus-DockingBar'!
Item was removed:
- ----- Method: DockingBarItemMorph>>adjacentTo (in category 'selecting') -----
- adjacentTo
-
- | roundedCornersOffset verticalOffset |
- roundedCornersOffset := MenuMorph roundedMenuCorners
- ifTrue: [Morph preferredCornerRadius negated]
- ifFalse: [0].
- verticalOffset := 2.
-
- owner isFloating
- ifTrue: [^ {self bounds bottomLeft + (roundedCornersOffset @ verticalOffset)}].
- owner isAdheringToTop
- ifTrue: [^ {self bounds bottomLeft + (roundedCornersOffset @ verticalOffset)}].
- owner isAdheringToLeft
- ifTrue: [^ {self bounds topRight + (roundedCornersOffset @ verticalOffset)}].
- owner isAdheringToBottom
- ifTrue: [^ {self bounds topLeft + (roundedCornersOffset @ verticalOffset)}].
- owner isAdheringToRight
- ifTrue: [^ {self bounds topLeft + (roundedCornersOffset @ verticalOffset negated)}].
- ^ {self bounds bottomLeft + (roundedCornersOffset @ 5)}!
Item was removed:
- ----- Method: DockingBarItemMorph>>createSubmenu (in category 'private') -----
- createSubmenu
-
- ^DockingBarMenuMorph new!
Item was removed:
- ----- Method: DockingBarItemMorph>>createUpdatingSubmenu (in category 'private') -----
- createUpdatingSubmenu
-
- ^DockingBarUpdatingMenuMorph new!
Item was removed:
- ----- Method: DockingBarItemMorph>>drawIconOn: (in category 'drawing') -----
- drawIconOn: aCanvas
-
- | pos |
- self hasIcon ifTrue: [
- | iconForm |
- iconForm := self iconForm.
-
- pos := (contents
- ifEmpty: [self left + (self width - iconForm width // 2)]
- ifNotEmpty: [self left])
- @ (self top + (self height - iconForm height // 2)).
-
- aCanvas
- translucentImage: iconForm
- at: pos].!
Item was removed:
- ----- Method: DockingBarItemMorph>>drawLabelOn: (in category 'drawing') -----
- drawLabelOn: aCanvas
-
- | stringBounds |
- self contents ifEmpty: [^ self].
-
- stringBounds := bounds.
-
- self hasIcon ifTrue: [
- stringBounds := stringBounds left: stringBounds left + self iconForm width + 2 ].
-
- "Vertical centering."
- stringBounds := stringBounds top: stringBounds top + stringBounds bottom - self fontToUse height // 2.
- "Horizontal centering."
- stringBounds := stringBounds left: stringBounds left + (stringBounds width - (self fontToUse widthOfString: contents) // 2) abs.
-
- aCanvas
- drawString: contents
- in: stringBounds
- font: self fontToUse
- color: self colorToUse.!
Item was removed:
- ----- Method: DockingBarItemMorph>>drawSubMenuMarkerOn: (in category 'drawing') -----
- drawSubMenuMarkerOn: aCanvas
- "Ignore."!
Item was removed:
- ----- Method: DockingBarItemMorph>>iconForm (in category 'private') -----
- iconForm
- "private - answer the form to be used as the icon"
- ^isEnabled
- ifTrue: [
- (isSelected and: [ selectedIcon notNil ])
- ifTrue: [ selectedIcon ]
- ifFalse: [ icon ] ]
- ifFalse: [
- icon asGrayScale ]!
Item was removed:
- ----- Method: DockingBarItemMorph>>mouseDown: (in category 'events') -----
- mouseDown: evt
- "Handle a mouse down event. Menu items get activated when the mouse is over them."
-
- (evt shiftPressed and:[self wantsKeyboardFocusOnShiftClick]) ifTrue: [ ^super mouseDown: evt ]. "enable label editing"
- isSelected
- ifTrue: [
- owner selectItem: nil event: evt. ]
- ifFalse: [
- owner activate: evt. "Redirect to menu for valid transitions"
- owner selectItem: self event: evt. ]
- !
Item was removed:
- ----- Method: DockingBarItemMorph>>mouseEnter: (in category 'events') -----
- mouseEnter: evt
- "Do not hover docking bar items directory. Mouse-down required. But if you already see a submenu, support hovering."
-
- owner selectedItem ifNotNil: [owner selectItem: self event: evt]!
Item was removed:
- ----- Method: DockingBarItemMorph>>mouseUp: (in category 'events') -----
- mouseUp: evt
- "Handle a mouse up event. Menu items get activated when the mouse is over them. Do nothing if we're not in a 'valid menu transition', meaning that the current hand focus must be aimed at the owning menu."
-
- evt hand mouseFocus == owner ifFalse: [ ^self ].
- self contentString ifNotNil: [
- self contents: self contentString withMarkers: true inverse: true.
- self refreshWorld.
- (Delay forMilliseconds: 200) wait ].!
Item was removed:
- ----- Method: DockingBarItemMorph>>select: (in category 'selecting') -----
- select: evt
-
- super select: evt.
- subMenu ifNotNil: [
- evt hand newKeyboardFocus: subMenu ]!
Item was removed:
- ----- Method: DockingBarItemMorph>>selectedIcon: (in category 'accessing') -----
- selectedIcon: aFormOrNil
-
- selectedIcon := aFormOrNil
- ifNotNil: [:form | form scaleIconToDisplay].!
Item was removed:
- ----- Method: DockingBarItemMorph>>selectionFillStyle (in category 'private') -----
- selectionFillStyle
-
- | fill |
- fill := super selectionFillStyle.
- fill isColor ifTrue: [ ^fill ].
- self owner isVertical
- ifFalse: [ fill direction: 0 @ self height ]
- ifTrue: [ fill direction: self width @ 0 ].
- ^fill!
Item was removed:
- ----- Method: DockingBarItemMorph>>wantsKeyboardFocusOnShiftClick (in category 'events') -----
- wantsKeyboardFocusOnShiftClick
- "set this preference to false to prevent user editing of docking bar menu items"
- ^Preferences valueOfPreference: #allowMenubarItemEditing ifAbsent: [false]!
Item was removed:
- ----- Method: DockingBarItemMorph>>wantsRoundedCorners (in category 'rounding') -----
- wantsRoundedCorners
-
- ^false!
Item was removed:
- MenuMorph subclass: #DockingBarMenuMorph
- instanceVariableNames: 'activatorDockingBar'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Menus-DockingBar'!
Item was removed:
- ----- Method: DockingBarMenuMorph>>activatedFromDockingBar: (in category 'accessing') -----
- activatedFromDockingBar: aDockingBar
-
- activatorDockingBar := aDockingBar!
Item was removed:
- ----- Method: DockingBarMenuMorph>>handleCRStroke: (in category 'keystroke helpers') -----
- handleCRStroke: evt
-
- evt keyValue = 13 ifFalse: [ ^false ].
- selectedItem ifNotNil: [ selectedItem invokeWithEvent: evt ].
- ^true!
Item was removed:
- ----- Method: DockingBarMenuMorph>>handleLeftStroke: (in category 'keystroke helpers') -----
- handleLeftStroke: evt
-
- 28 = evt keyValue ifFalse: [ ^false ].
- (self stepIntoSubmenu: evt) ifFalse: [
- self deactivate: evt.
- activatorDockingBar moveSelectionDown: -1 event: evt ].
- ^true!
Item was removed:
- ----- Method: DockingBarMenuMorph>>handleRightStroke: (in category 'keystroke helpers') -----
- handleRightStroke: evt
-
- 29 = evt keyValue ifFalse: [ ^false ].
- (self stepIntoSubmenu: evt) ifFalse: [
- self deactivate: evt.
- activatorDockingBar moveSelectionDown: 1 event: evt ].
- ^true!
Item was removed:
- ----- Method: DockingBarMenuMorph>>popUpAdjacentTo:forHand:from: (in category 'as yet unclassified') -----
- popUpAdjacentTo: rightOrLeftPoint forHand: hand from: sourceItem
-
- | ownerInWorld world |
- super popUpAdjacentTo: rightOrLeftPoint forHand: hand from: sourceItem.
-
- "Docking bar and protruding menu should appear visually merged. Move the source item behind the receiver. If we did it the other way around, other navigators and docking bars in front of the sourceItem would cover the receiver. For the same reason, we can't use a higher different morphic layer numbers for docking bar menus because this would hide them after all other navigators."
- world := owner world.
- ownerInWorld := sourceItem firstOwnerSuchThat: [:owner | owner owner == world].
- world addMorph: ownerInWorld inFrontOf: self.!
Item was removed:
- ----- Method: DockingBarMenuMorph>>roundedCorners (in category 'rounding') -----
- roundedCorners
- "Return a list of those corners to round"
- activatorDockingBar isFloating
- ifTrue: [^ #(2 3 )].
- activatorDockingBar isAdheringToTop
- ifTrue: [^ #(2 3 )].
- activatorDockingBar isAdheringToBottom
- ifTrue: [^ #(1 4 )].
- activatorDockingBar isAdheringToLeft
- ifTrue: [^ #(3 4 )].
- activatorDockingBar isAdheringToRight
- ifTrue: [^ #(1 2 )]!
Item was removed:
- ----- Method: DockingBarMenuMorph>>veryDeepInner: (in category 'copying') -----
- veryDeepInner: deepCopier
- "Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment."
-
- super veryDeepInner: deepCopier.
- activatorDockingBar := activatorDockingBar. "Weakly copied"
- !
Item was removed:
- Morph subclass: #DockingBarMorph
- instanceVariableNames: 'originalColor gradientRamp fillsOwner avoidVisibleBordersAtEdge autoGradient selectedItem activeSubMenu oldKeyboardFocus oldMouseFocus'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Menus-DockingBar'!
Item was removed:
- ----- Method: DockingBarMorph class>>defaultNameStemForInstances (in category 'scripting') -----
- defaultNameStemForInstances
- ^ 'DockingBar'!
Item was removed:
- ----- Method: DockingBarMorph class>>example1 (in category 'samples') -----
- example1
- "
- DockingBarMorph example1.
-
- (Color lightBlue wheel: 4) do:[:c | DockingBarMorph example1
- color: c; borderColor: c twiceDarker].
-
- Project current world deleteDockingBars.
- "
- | instance |
- instance := DockingBarMorph new.
- ""
- instance addSpace: 10.
- instance
- addMorphBack: (ClockMorph new show24hr: true).
- instance addSpacer.
- instance
- addMorphBack: (ClockMorph new show24hr: true).
- instance addSpace: 10.
- ""
- instance adhereToTop.
- ""
- instance autoGradient: true.
- instance layoutInset: 10.
- ""
- ^ instance openInWorld!
Item was removed:
- ----- Method: DockingBarMorph class>>example2 (in category 'samples') -----
- example2
- "
- DockingBarMorph example2.
- Project current world deleteDockingBars.
- "
- | menu |
- menu := DockingBarMorph new.
- ""
- menu addSpace: 10.
- menu
- add: 'Squeak'
- icon: MenuIcons smallConfigurationIcon
- subMenu: self squeakMenu.
- menu
- add: 'Configuration'
- icon: MenuIcons smallWindowIcon
- subMenu: self squeakMenu.
- menu addSpace: 10.
- menu addLine.
- menu addSpace: 10.
- menu
- addMorphBack: (ImageMorph new image: MenuIcons smallBackIcon).
- menu addSpace: 10.
- menu
- addMorphBack: (ImageMorph new image: MenuIcons smallForwardIcon).
- menu addSpace: 10.
- menu addLine.
- menu addSpacer.
- ""
- menu addMorphBack: ProjectNavigationMorph new speakerIcon.
- ""
- menu addSpace: 10.
- menu
- addMorphBack: (ClockMorph new show24hr: true).
- menu addSpace: 10.
- ""
- menu adhereToTop.
- ""
- menu autoGradient: true.
- ""
- ^ menu openInWorld!
Item was removed:
- ----- Method: DockingBarMorph class>>example3 (in category 'samples') -----
- example3
- "
- DockingBarMorph example3.
- Project current world deleteDockingBars.
- "
- (Color lightBlue wheel: 4)
- with: #(#top #bottom #left #right )
- do: [:col :edge |
- | instance |
- instance := DockingBarMorph example1.
- instance adhereTo: edge.
- instance color: col.
- instance borderColor: col twiceDarker]!
Item was removed:
- ----- Method: DockingBarMorph class>>squeakMenu (in category 'samples') -----
- squeakMenu
- | menu |
- menu := DockingBarMenuMorph new defaultTarget: self.
- menu
- add: 'Hello'
- target: self
- selector: #inform:
- argument: 'Hello World!!'.
- menu
- add: 'Long Hello'
- target: self
- selector: #inform:
- argument: 'Helloooo World!!'.
- menu
- add: 'A very long Hello'
- target: self
- selector: #inform:
- argument: 'Hellooooooooooooooo World!!'.
- menu
- add: 'An incredible long Hello'
- target: self
- selector: #inform:
- argument: 'Hellooooooooooooooooooooooo World!!'.
- ^ menu!
Item was removed:
- ----- Method: DockingBarMorph class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ super themeProperties, {
- { #borderColor. 'Colors'. 'Color of the menu''s border.' }.
- { #borderWidth. 'Geometry'. 'Width of the menu''s border.' }.
- { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }.
- { #color. 'Colors'. 'Background color of the menu.' }.
-
- { #lineColor. 'Colors'. 'Color of the separators between menu items.' }.
- { #lineStyle. 'Colors'. 'Use border-style to change appearance.' }.
- { #lineWidth. 'Geometry'. 'How big the separators should be.' }.
- }!
Item was removed:
- ----- Method: DockingBarMorph>>aboutToBeGrabbedBy: (in category 'dropping/grabbing') -----
- aboutToBeGrabbedBy: aHand
- "The morph is about to be grabbed, make it float"
- self beFloating.
- self updateBounds.
- self updateColor.
- (self bounds containsPoint: aHand position)
- ifFalse: [self center: aHand position].
- self owner restoreFlapsDisplay!
Item was removed:
- ----- Method: DockingBarMorph>>activate: (in category 'events') -----
- activate: evt
- "Receiver should be activated; e.g., so that control passes
- correctly."
-
- oldKeyboardFocus := evt hand keyboardFocus.
- self oldMouseFocus: evt hand mouseFocus.
- evt hand
- newKeyboardFocus: self;
- newMouseFocus: self.
- self ensureSelectedItem: evt!
Item was removed:
- ----- Method: DockingBarMorph>>activeSubmenu: (in category 'control') -----
- activeSubmenu: aSubmenu
- activeSubMenu isNil
- ifFalse: [activeSubMenu delete].
- activeSubMenu := aSubmenu.
- aSubmenu isNil
- ifTrue: [^ self].
- activeSubMenu updateMenu.
- activeSubMenu selectItem: nil event: nil.
- MenuIcons decorateMenu: activeSubMenu.
- activeSubMenu
- activatedFromDockingBar: self;
- beSticky;
- resistsRemoval: true;
- removeMatchString!
Item was removed:
- ----- Method: DockingBarMorph>>add:icon:help:subMenu: (in category 'construction') -----
- add: wordingString icon: aForm help: helpString subMenu: aMenuMorph
- "Append the given submenu with the given label."
- | item |
- item := DockingBarItemMorph new.
- item contents: wordingString.
- item subMenu: aMenuMorph.
- item icon: aForm.
- helpString isNil
- ifFalse: [item setBalloonText: helpString].
- aMenuMorph ifNotNil: [
- "Docking bar and protruding menu should appear visually merged."
- aMenuMorph morphicLayerNumber: self morphicLayerNumber].
- self addMorphBack: item!
Item was removed:
- ----- Method: DockingBarMorph>>add:icon:selectedIcon:help:subMenu: (in category 'construction') -----
- add: wordingString icon: aForm selectedIcon: anotherForm help: helpString subMenu: aMenuMorph
- "Append the given submenu with the given label."
- | item |
- item := DockingBarItemMorph new
- contents: wordingString;
- subMenu: aMenuMorph;
- icon: aForm;
- selectedIcon: anotherForm.
- helpString ifNotNil: [
- item setBalloonText: helpString ].
- aMenuMorph ifNotNil: [
- "Docking bar and protruding menu should appear visually merged."
- aMenuMorph morphicLayerNumber: self morphicLayerNumber].
- self addMorphBack: item!
Item was removed:
- ----- Method: DockingBarMorph>>add:icon:subMenu: (in category 'construction') -----
- add: wordingString icon: aForm subMenu: aMenuMorph
- "Append the given submenu with the given label."
- ^ self add: wordingString icon: aForm help: nil subMenu: aMenuMorph !
Item was removed:
- ----- Method: DockingBarMorph>>add:subMenu: (in category 'construction') -----
- add: aString subMenu: aMenuMorph
- "Append the given submenu with the given label."
- self add: aString icon: nil subMenu: aMenuMorph !
Item was removed:
- ----- Method: DockingBarMorph>>addBlankIconsIfNecessary: (in category 'accessing') -----
- addBlankIconsIfNecessary: anIcon
- "If any of my items have an icon, ensure that all do by using
- anIcon for those that don't"
- self items
- reject: [:each | each hasIconOrMarker]
- thenDo: [:each | each icon: anIcon]!
Item was removed:
- ----- Method: DockingBarMorph>>addCustomMenuItems:hand: (in category 'menu') -----
- addCustomMenuItems: aMenu hand: aHandMorph
- "Populate aMenu with appropriate menu items for a
- yellow-button (context menu) click."
- super addCustomMenuItems: aMenu hand: aHandMorph.
- ""
- aMenu addLine.
- aMenu addUpdating: #autoGradientString action: #toggleAutoGradient.
- self isFloating
- ifFalse: [""
- aMenu addUpdating: #fillsOwnerString action: #toggleFillsOwner.
- aMenu addUpdating: #avoidVisibleBordersAtEdgeString action: #toggleAvoidVisibleBordersAtEdge]!
Item was removed:
- ----- Method: DockingBarMorph>>addDefaultSpace (in category 'construction') -----
- addDefaultSpace
- "Add a new space of the given size to the receiver."
- ^ self addSpace: ((Preferences tinyDisplay ifFalse:[10] ifTrue:[3]) * RealEstateAgent scaleFactor) truncated!
Item was removed:
- ----- Method: DockingBarMorph>>addItem: (in category 'construction') -----
- addItem: aBlock
- | item |
- item := DockingBarItemMorph new.
- aBlock value: item.
- item subMenu ifNotNil: [:menu |
- "Docking bar and protruding menu should appear visually merged."
- menu morphicLayerNumber: self morphicLayerNumber].
- self addMorphBack: item!
Item was removed:
- ----- Method: DockingBarMorph>>addLine (in category 'construction') -----
- addLine
- "Append a divider line to this menu. Suppress duplicate lines."
-
- | colorToUse |
- submorphs isEmpty ifTrue: [^ self].
- self lastSubmorph knownName = #line ifTrue: [^ self].
-
- colorToUse := self userInterfaceTheme lineColor ifNil: [Color gray: 0.9].
- self addMorphBack: (Morph new
- color: colorToUse;
- extent: (self userInterfaceTheme lineWidth ifNil: [2]) asPoint;
- borderStyle: (self userInterfaceTheme lineStyle ifNil: [BorderStyle inset]);
- borderColor: colorToUse;
- borderWidth: 1;
- name: #line; "see above"
- yourself).!
Item was removed:
- ----- Method: DockingBarMorph>>addSpace: (in category 'construction') -----
- addSpace: sizePointOrNumber
- "Add a new space of the given size to the receiver."
- | space |
- space := RectangleMorph new.
- space extent: sizePointOrNumber asPoint.
- space color: Color transparent.
- space borderWidth: 0.
- self addMorphBack: space!
Item was removed:
- ----- Method: DockingBarMorph>>addSpacer (in category 'construction') -----
- addSpacer
- "Add a new spacer to the receiver.
-
- Spacer are objects that try to use as much space as they can"
- self
- addMorphBack: (AlignmentMorph newSpacer: Color transparent)!
Item was removed:
- ----- Method: DockingBarMorph>>addUpdatingItem: (in category 'construction') -----
- addUpdatingItem: aBlock
- | item |
- item := DockingBarUpdatingItemMorph new.
- aBlock value: item.
- item subMenu ifNotNil: [:menu |
- "Docking bar and protruding menu should appear visually merged."
- menu morphicLayerNumber: self morphicLayerNumber].
- self addMorphBack: item!
Item was removed:
- ----- Method: DockingBarMorph>>addedMorph: (in category 'change reporting') -----
- addedMorph: aMorph
- "Update the new morph's layout properties according to my orientation."
-
- aMorph isMenuItemMorph ifFalse: [^ self].
-
- self isVertical
- ifTrue: [
- aMorph hResizing: #spaceFill.
- aMorph vResizing: #shrinkWrap ]
- ifFalse: [
- aMorph hResizing: #shrinkWrap.
- aMorph vResizing: #spaceFill ].!
Item was removed:
- ----- Method: DockingBarMorph>>adhereTo: (in category 'private - accessing') -----
- adhereTo: edgeSymbol
- "Private - Instruct the receiver to adhere to the given edge.
-
- Options: #left #top #right #bottom or #none"
- ""
- (#(#left #top #right #bottom #none ) includes: edgeSymbol)
- ifFalse: [^ self error: 'invalid option'].
- ""
- self setToAdhereToEdge: edgeSymbol.
- self updateLayoutProperties.
- self updateColor!
Item was removed:
- ----- Method: DockingBarMorph>>adhereToBottom (in category 'accessing') -----
- adhereToBottom
- "Instract the receiver to adhere to bottom"
- self adhereTo:#bottom!
Item was removed:
- ----- Method: DockingBarMorph>>adhereToLeft (in category 'accessing') -----
- adhereToLeft
- "Instract the receiver to adhere to left"
- self adhereTo: #left!
Item was removed:
- ----- Method: DockingBarMorph>>adhereToRight (in category 'accessing') -----
- adhereToRight
- "Instract the receiver to adhere to right"
- self adhereTo: #right!
Item was removed:
- ----- Method: DockingBarMorph>>adhereToTop (in category 'accessing') -----
- adhereToTop
- "Instract the receiver to adhere to top"
- self adhereTo: #top!
Item was removed:
- ----- Method: DockingBarMorph>>applyUserInterfaceTheme (in category 'update') -----
- applyUserInterfaceTheme
-
- | colorToUse |
- gradientRamp := nil.
-
- super applyUserInterfaceTheme.
-
- self setDefaultParameters.
-
- "Update properties of separating lines."
- colorToUse := self userInterfaceTheme lineColor ifNil: [Color gray: 0.9].
- self submorphs
- select: [:ea | ea knownName = #line]
- thenDo: [:line |
- line
- color: colorToUse;
- extent: (self userInterfaceTheme lineWidth ifNil: [2]) asPoint;
- borderStyle: (self userInterfaceTheme lineStyle ifNil: [BorderStyle inset]) copy;
- borderColor: colorToUse].!
Item was removed:
- ----- Method: DockingBarMorph>>autoGradient (in category 'accessing') -----
- autoGradient
- "Answer if the receiver is in autoGradient mode"
- ^ autoGradient!
Item was removed:
- ----- Method: DockingBarMorph>>autoGradient: (in category 'accessing') -----
- autoGradient: aBoolean
- "Instruct the receiver to fill the owner or not"
- autoGradient := aBoolean.
- self updateColor!
Item was removed:
- ----- Method: DockingBarMorph>>autoGradientString (in category 'menu') -----
- autoGradientString
- "Answer the string to be shown in a menu to represent the
- 'resistsRemoval' status"
- ^ (self autoGradient
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'auto gradient' translated!
Item was removed:
- ----- Method: DockingBarMorph>>avoidVisibleBordersAtEdge (in category 'accessing') -----
- avoidVisibleBordersAtEdge
- "Answer if the receiver is in avoidVisibleBordersAtEdge mode"
- ^ avoidVisibleBordersAtEdge!
Item was removed:
- ----- Method: DockingBarMorph>>avoidVisibleBordersAtEdge: (in category 'accessing') -----
- avoidVisibleBordersAtEdge: aBoolean
- "Instruct the receiver to avoid showing the borders at edge"
- avoidVisibleBordersAtEdge := aBoolean.
- self updateLayoutProperties.!
Item was removed:
- ----- Method: DockingBarMorph>>avoidVisibleBordersAtEdgeString (in category 'menu') -----
- avoidVisibleBordersAtEdgeString
- "Answer the string to be shown in a menu to represent the
- 'resistsRemoval' status"
- ^ (self avoidVisibleBordersAtEdge
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'avoid visible borders at edge' translated!
Item was removed:
- ----- Method: DockingBarMorph>>beFloating (in category 'accessing') -----
- beFloating
- "Instract the receiver to be floating"
- self adhereTo: #none!
Item was removed:
- ----- Method: DockingBarMorph>>color: (in category 'accessing') -----
- color: aColor
- "Set the receiver's color."
-
- super color: aColor.
- originalColor := aColor asColor.
- gradientRamp := nil.
- ""
- self updateColor!
Item was removed:
- ----- Method: DockingBarMorph>>deactivate: (in category 'events') -----
- deactivate: evt
-
- | newKeyboardFocus newMouseFocus |
- self selectItem: nil event: evt.
- newKeyboardFocus := self oldKeyboardFocus.
- newMouseFocus := self oldMouseFocus.
- oldKeyboardFocus := oldMouseFocus := nil.
- evt hand
- newKeyboardFocus: newKeyboardFocus;
- newMouseFocus: newMouseFocus!
Item was removed:
- ----- Method: DockingBarMorph>>delete (in category 'submorphs - add/remove') -----
- delete
-
- self currentHand removeKeyboardListener: self.
- activeSubMenu ifNotNil: [
- activeSubMenu delete].
- ^ super delete!
Item was removed:
- ----- Method: DockingBarMorph>>deleteIfPopUp: (in category 'control') -----
- deleteIfPopUp: evt
-
- evt ifNotNil: [
- evt hand releaseMouseFocus: self ]!
Item was removed:
- ----- Method: DockingBarMorph>>edgeToAdhereTo (in category 'private - accessing') -----
- edgeToAdhereTo
- "private - answer the edge where the receiver is adhering to"
- ^ self
- valueOfProperty: #edgeToAdhereTo
- ifAbsent: [#none]!
Item was removed:
- ----- Method: DockingBarMorph>>ensureSelectedItem: (in category 'events') -----
- ensureSelectedItem: evt
-
- self selectedItem ifNil: [
- self
- selectItem: (
- self submorphs
- detect: [ :each | each isMenuItemMorph ]
- ifNone: [ ^self ])
- event: evt ]!
Item was removed:
- ----- Method: DockingBarMorph>>extent: (in category 'geometry') -----
- extent: aPoint
- "change the receiver's extent"
- (bounds extent closeTo: aPoint) ifTrue: [^ self].
- super extent: aPoint.
- self updateColor!
Item was removed:
- ----- Method: DockingBarMorph>>fillsOwner (in category 'accessing') -----
- fillsOwner
- "Answer if the receiver is in fillOwner mode"
- ^ fillsOwner!
Item was removed:
- ----- Method: DockingBarMorph>>fillsOwner: (in category 'accessing') -----
- fillsOwner: aBoolean
- "Instruct the receiver to fill the owner or not"
- fillsOwner := aBoolean.
- self updateLayoutProperties!
Item was removed:
- ----- Method: DockingBarMorph>>fillsOwnerString (in category 'menu') -----
- fillsOwnerString
- "Answer the string to be shown in a menu to represent the
- 'resistsRemoval' status"
- ^ (self fillsOwner
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'fills owner' translated
- !
Item was removed:
- ----- Method: DockingBarMorph>>filterEvent:for: (in category 'events-processing') -----
- filterEvent: aKeyboardEvent for: anObject
- "Provide keyboard shortcuts."
-
- | index itemToSelect |
-
- aKeyboardEvent controlKeyPressed
- ifFalse: [^ aKeyboardEvent].
-
- aKeyboardEvent isKeystroke
- ifFalse: [^ aKeyboardEvent].
-
- "Search field."
- aKeyboardEvent keyCharacter = $0
- ifTrue: [
- self searchBarMorph ifNotNil: [ :morph |
- morph model activate: aKeyboardEvent in: morph ].
- ^ aKeyboardEvent ignore "hit!!"].
-
- "Select menu items."
- (aKeyboardEvent keyValue
- between: $1 asciiValue
- and: $9 asciiValue)
- ifFalse: [^ aKeyboardEvent].
-
- index := aKeyboardEvent keyValue - $1 asciiValue + 1.
- itemToSelect := (self submorphs select: [ :each |
- each isMenuItemMorph ])
- at: index
- ifAbsent: [^ aKeyboardEvent].
-
- self activate: aKeyboardEvent.
- self
- selectItem: itemToSelect
- event: aKeyboardEvent.
-
- ^ aKeyboardEvent ignore "hit!!"!
Item was removed:
- ----- Method: DockingBarMorph>>gradientRamp (in category 'private - layout') -----
- gradientRamp
- | cc |
- cc := originalColor adjustSaturation: -0.08 brightness: 0.4.
- ^ gradientRamp ifNil:[gradientRamp := {
- 0.0 -> cc.
- 0.25 -> (originalColor mixed: 0.5 with: cc).
- 0.9 -> originalColor.
- 1.0 -> originalColor darker.}]!
Item was removed:
- ----- Method: DockingBarMorph>>gradientRamp: (in category 'private - layout') -----
- gradientRamp: colorRamp
- gradientRamp := colorRamp.
- ""
- self updateColor!
Item was removed:
- ----- Method: DockingBarMorph>>handlesKeyboard: (in category 'events-processing') -----
- handlesKeyboard: evt
-
- ^true!
Item was removed:
- ----- Method: DockingBarMorph>>indicateKeyboardFocus (in category 'testing') -----
- indicateKeyboardFocus
- ^ false!
Item was removed:
- ----- Method: DockingBarMorph>>initialize (in category 'initialize-release') -----
- initialize
- "initialize the receiver"
- super initialize.
- self changeTableLayout.
-
- selectedItem := nil.
- activeSubMenu := nil.
- fillsOwner := true.
- avoidVisibleBordersAtEdge := true.
- autoGradient := MenuMorph gradientMenu.
- self
- setDefaultParameters ;
- rubberBandCells: true ;
- beFloating ;
- beSticky ;
- layoutInset: 0 ;
- dropEnabled: true!
Item was removed:
- ----- Method: DockingBarMorph>>isAdheringToBottom (in category 'accessing') -----
- isAdheringToBottom
- "Answer true if the receiver is adhering to bottom"
- ^ self edgeToAdhereTo == #bottom!
Item was removed:
- ----- Method: DockingBarMorph>>isAdheringToLeft (in category 'accessing') -----
- isAdheringToLeft
- "Answer true if the receiver is adhering to left"
- ^ self edgeToAdhereTo == #left!
Item was removed:
- ----- Method: DockingBarMorph>>isAdheringToRight (in category 'accessing') -----
- isAdheringToRight
- "Answer true if the receiver is adhering to right"
- ^ self edgeToAdhereTo == #right!
Item was removed:
- ----- Method: DockingBarMorph>>isAdheringToTop (in category 'accessing') -----
- isAdheringToTop
- "Answer true if the receiver is adhering to top"
- ^ self edgeToAdhereTo == #top!
Item was removed:
- ----- Method: DockingBarMorph>>isDockingBar (in category 'testing') -----
- isDockingBar
- "Return true if the receiver is a docking bar"
- ^ true!
Item was removed:
- ----- Method: DockingBarMorph>>isFloating (in category 'accessing') -----
- isFloating
- "Answer true if the receiver has a float layout"
- ^ self isHorizontal not
- and: [self isVertical not]!
Item was removed:
- ----- Method: DockingBarMorph>>isHorizontal (in category 'accessing') -----
- isHorizontal
- "Answer true if the receiver has a horizontal layout"
- ^ self isAdheringToTop
- or: [self isAdheringToBottom]!
Item was removed:
- ----- Method: DockingBarMorph>>isSticky (in category 'accessing') -----
- isSticky
- "answer whether the receiver is Sticky"
- ^ Preferences noviceMode
- or: [super isSticky] !
Item was removed:
- ----- Method: DockingBarMorph>>isVertical (in category 'accessing') -----
- isVertical
- "Answer true if the receiver has a vertical layout"
- ^ self isAdheringToLeft
- or: [self isAdheringToRight]
- !
Item was removed:
- ----- Method: DockingBarMorph>>items (in category 'accessing') -----
- items
-
- ^ submorphs select: [:m | m isKindOf: MenuItemMorph]!
Item was removed:
- ----- Method: DockingBarMorph>>justDroppedInto:event: (in category 'dropping/grabbing') -----
- justDroppedInto: aMorph event: anEvent
- | ownerBounds leftRegion droppedPosition rightRegion topRegion bottomRegion |
- super justDroppedInto: aMorph event: anEvent.
- ""
- self owner isNil
- ifTrue: [^ self].
- ""
- ownerBounds := aMorph bounds.
- topRegion := ownerBounds bottom: ownerBounds top + (ownerBounds height // 5).
- bottomRegion := ownerBounds top: ownerBounds bottom - (ownerBounds height // 5).
- ""
- leftRegion := ownerBounds right: ownerBounds left + (ownerBounds width // 5).
- leftRegion := leftRegion top: topRegion bottom.
- leftRegion := leftRegion bottom: bottomRegion top.
- ""
- rightRegion := ownerBounds left: ownerBounds right - (ownerBounds width // 5).
- rightRegion := rightRegion top: topRegion bottom.
- rightRegion := rightRegion bottom: bottomRegion top.
- ""
- droppedPosition := anEvent position.
- (topRegion containsPoint: droppedPosition)
- ifTrue: [
- ^ self adhereToTop].
- (bottomRegion containsPoint: droppedPosition)
- ifTrue: [
- ^ self adhereToBottom].
- (leftRegion containsPoint: droppedPosition)
- ifTrue: [
- ^ self adhereToLeft].
- (rightRegion containsPoint: droppedPosition)
- ifTrue: [
- ^ self adhereToRight].
- ""
- self beFloating!
Item was removed:
- ----- Method: DockingBarMorph>>keyStroke: (in category 'events-processing') -----
- keyStroke: evt
-
- | asc |
- asc := evt keyCharacter asciiValue.
- asc = 27 ifTrue: [ "escape key"
- ^self deactivate: evt ].
- asc = self selectSubmenuKey ifTrue: [
- self ensureSelectedItem: evt.
- self selectedItem subMenu ifNotNil: [ :subMenu |
- subMenu items ifNotEmpty: [
- subMenu activate: evt.
- ^subMenu moveSelectionDown: 1 event: evt ] ] ].
- asc = self previousKey ifTrue: [ ^self moveSelectionDown: -1 event: evt ].
- asc = self nextKey ifTrue: [ ^self moveSelectionDown: 1 event: evt ].
- selectedItem ifNotNil: [
- selectedItem subMenu ifNotNil: [ :subMenu |
- " If we didn't handle the keystroke, pass the keyboard focus
- to the open submenu. "
- evt hand newKeyboardFocus: subMenu.
- subMenu keyStroke: evt ] ]!
Item was removed:
- ----- Method: DockingBarMorph>>morphicLayerNumber (in category 'submorphs - layers') -----
- morphicLayerNumber
-
- ^ self valueOfProperty: #morphicLayerNumber ifAbsent: [self class navigatorLayer]!
Item was removed:
- ----- Method: DockingBarMorph>>mouseDown: (in category 'events-processing') -----
- mouseDown: evt
-
- (self fullContainsPoint: evt position) ifFalse: [
- self selectItem: nil event: evt.
- self deleteIfPopUp: evt ]!
Item was removed:
- ----- Method: DockingBarMorph>>mouseMove: (in category 'events-processing') -----
- mouseMove: evt
- "We might transfer control to *either* the currently active submenu or the pop up owner, if any. Since the active sub menu is always displayed upfront check it first."
-
- selectedItem ifNotNil:[selectedItem activateSubmenu: evt].!
Item was removed:
- ----- Method: DockingBarMorph>>mouseUp: (in category 'events-processing') -----
- mouseUp: evt
-
- evt hand newMouseFocus: self.!
Item was removed:
- ----- Method: DockingBarMorph>>moveSelectionDown:event: (in category 'control') -----
- moveSelectionDown: direction event: evt
- "Move the current selection up or down by one, presumably under keyboard control.
- direction = +/-1"
-
- | index |
- index := (submorphs
- indexOf: selectedItem
- ifAbsent: [direction positive ifTrue: [0] ifFalse: [1]]
- ) + direction.
- submorphs do: "Ensure finite"
- [:unused | | m |
- m := submorphs atWrap: index.
- (m isMenuItemMorph and: [m isEnabled]) ifTrue:
- [^ self selectItem: m event: evt].
- "Keep looking for an enabled item"
- index := index + direction sign].
- ^ self selectItem: nil event: evt!
Item was removed:
- ----- Method: DockingBarMorph>>nextKey (in category 'events-processing') -----
- nextKey
-
- self isHorizontal ifTrue: [ ^29 " right arrow" ].
- self isVertical ifTrue: [ ^31 " down arrow " ]!
Item was removed:
- ----- Method: DockingBarMorph>>oldKeyboardFocus (in category 'events') -----
- oldKeyboardFocus
-
- oldKeyboardFocus = self
- ifTrue: [ ^nil ]
- ifFalse: [ ^oldKeyboardFocus ]!
Item was removed:
- ----- Method: DockingBarMorph>>oldMouseFocus (in category 'events') -----
- oldMouseFocus
-
- oldMouseFocus = self
- ifTrue: [ ^nil ]
- ifFalse: [ ^oldMouseFocus ]!
Item was removed:
- ----- Method: DockingBarMorph>>oldMouseFocus: (in category 'events') -----
- oldMouseFocus: aMorph
-
- (self submorphs includes: aMorph)
- ifFalse: [ oldMouseFocus := aMorph ]
- ifTrue: [ oldMouseFocus := nil ]
- !
Item was removed:
- ----- Method: DockingBarMorph>>ownerChanged (in category 'change reporting') -----
- ownerChanged
- "The receiver's owner has changed its layout. "
- self updateBounds.
- ^ super ownerChanged!
Item was removed:
- ----- Method: DockingBarMorph>>predominantDockingBarsOfChastes: (in category 'private - accessing') -----
- predominantDockingBarsOfChastes: predominantChastes
- "Private - Answer a collection of the docking bar of my owner
- that are predominant to the receiver.
-
- By 'predominant' we mean docking bar that have the right to
- get a position before the receiver.
-
- The predominance of individual living in the same chaste is
- determinated by the arrival order.
- "
- | allDockingBars byChaste byArrival |
- (self owner isNil
- or: [self owner isHandMorph])
- ifTrue: [^ #()].
- ""
- allDockingBars := self owner dockingBars.
- ""
- byChaste := allDockingBars
- select: [:each | predominantChastes includes: each edgeToAdhereTo].
- ""
- (predominantChastes includes: self edgeToAdhereTo)
- ifFalse: [^ byChaste].
- ""
- byChaste := byChaste
- reject: [:each | each edgeToAdhereTo = self edgeToAdhereTo].
- ""
- byArrival := allDockingBars
- select: [:each | each edgeToAdhereTo = self edgeToAdhereTo].
-
- byArrival := byArrival copyAfter: self.
- ""
- ^ byChaste , byArrival!
Item was removed:
- ----- Method: DockingBarMorph>>previousKey (in category 'events-processing') -----
- previousKey
-
- self isHorizontal ifTrue: [ ^28 "left arrow" ].
- self isVertical ifTrue: [ ^30 "up arrow " ]!
Item was removed:
- ----- Method: DockingBarMorph>>processFocusEvent:using: (in category 'events-processing') -----
- processFocusEvent: evt using: dispatcher
-
- ^ dispatcher dispatchFocusEventFully: evt with: self!
Item was removed:
- ----- Method: DockingBarMorph>>release (in category 'initialize-release') -----
- release
- activeSubMenu := selectedItem := oldKeyboardFocus := oldMouseFocus := nil!
Item was removed:
- ----- Method: DockingBarMorph>>resistsRemoval (in category 'accessing') -----
- resistsRemoval
- "Answer whether the receiver is marked as resisting removal"
- ^ Preferences noviceMode
- or: [super resistsRemoval]!
Item was removed:
- ----- Method: DockingBarMorph>>rootMenu (in category 'accessing') -----
- rootMenu
- ^ self!
Item was removed:
- ----- Method: DockingBarMorph>>roundedCorners (in category 'rounding') -----
- roundedCorners
- "Return a list of those corners to round"
- self isAdheringToTop
- ifTrue: [^ #(2 3 )].
- self isAdheringToBottom
- ifTrue: [^ #(1 4 )].
- self isAdheringToLeft
- ifTrue: [^ #(3 4 )].
- self isAdheringToRight
- ifTrue: [^ #(1 2 )].
- ^ #(1 2 3 4 )!
Item was removed:
- ----- Method: DockingBarMorph>>searchBarMorph (in category 'events-processing') -----
- searchBarMorph
-
- ^self submorphs detect: [ :each | each knownName = #searchBar ] ifNone: [ nil ]!
Item was removed:
- ----- Method: DockingBarMorph>>selectItem:event: (in category 'control') -----
- selectItem: aMenuItem event: anEvent
- selectedItem
- ifNotNil: [selectedItem deselect: anEvent].
- selectedItem := aMenuItem.
- selectedItem
- ifNotNil: [selectedItem select: anEvent]!
Item was removed:
- ----- Method: DockingBarMorph>>selectSubmenuKey (in category 'events-processing') -----
- selectSubmenuKey
-
- self isAdheringToTop ifTrue: [ ^31 ].
- self isAdheringToRight ifTrue: [ ^28 ].
- self isAdheringToLeft ifTrue: [ ^29 ].
- self isAdheringToBottom ifTrue: [ ^30 ].
- ^31!
Item was removed:
- ----- Method: DockingBarMorph>>selectedItem (in category 'private') -----
- selectedItem
-
- (selectedItem notNil and: [
- selectedItem isSelected ]) ifTrue: [
- ^selectedItem ].
- ^ nil!
Item was removed:
- ----- Method: DockingBarMorph>>setDefaultParameters (in category 'initialize-release') -----
- setDefaultParameters
- "private - set the default parameter using Preferences as the inspiration source"
-
- self
- color: (self userInterfaceTheme color ifNil: [Color r: 0.9 g: 0.9 b: 0.9]);
- borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle simple]) copy;
- borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]);
- borderWidth: (self userInterfaceTheme borderWidth ifNil: [0]).
-
- self extent: (Preferences standardMenuFont lineGridForMorphs asPoint).!
Item was removed:
- ----- Method: DockingBarMorph>>snapToEdgeIfAppropriate (in category 'menus') -----
- snapToEdgeIfAppropriate
- (self owner isNil
- or: [self owner isHandMorph])
- ifTrue: [^ self].
- ""
- self updateBounds!
Item was removed:
- ----- Method: DockingBarMorph>>stayUp (in category 'accessing') -----
- stayUp
- ^ false!
Item was removed:
- ----- Method: DockingBarMorph>>toggleAutoGradient (in category 'menu') -----
- toggleAutoGradient
- self autoGradient: self autoGradient not!
Item was removed:
- ----- Method: DockingBarMorph>>toggleAvoidVisibleBordersAtEdge (in category 'menu') -----
- toggleAvoidVisibleBordersAtEdge
- self avoidVisibleBordersAtEdge: self avoidVisibleBordersAtEdge not!
Item was removed:
- ----- Method: DockingBarMorph>>toggleFillsOwner (in category 'menu') -----
- toggleFillsOwner
- self fillsOwner: self fillsOwner not!
Item was removed:
- ----- Method: DockingBarMorph>>updateBounds (in category 'private - layout') -----
- updateBounds
- "private - update the receiver's bounds"
- self updateExtent.
- self isFloating
- ifFalse: [self updatePosition]!
Item was removed:
- ----- Method: DockingBarMorph>>updateColor (in category 'private - layout') -----
- updateColor
- "private - update the receiver's color"
- | fill |
- MenuMorph gradientMenu ifFalse: [
- self color ~= originalColor ifTrue: [self color: originalColor].
- ^ self].
- ""
- fill := GradientFillStyle ramp: self gradientRamp.
- ""
- fill origin: self topLeft.
- self isVertical
- ifTrue: [fill direction: self width @ 0]
- ifFalse: [fill direction: 0 @ self height].
- ""
- self fillStyle: fill!
Item was removed:
- ----- Method: DockingBarMorph>>updateExtent (in category 'private - layout') -----
- updateExtent
- "private - update the receiver's extent"
- | margin |
- self fullBounds.
- self fillsOwner
- ifFalse: [^ self].
- ""
- margin := self avoidVisibleBordersAtEdge
- ifTrue: [self borderWidth * 2]
- ifFalse: [0].""
- self isHorizontal
- ifTrue: [self width: self owner width + margin].""
- self isVertical
- ifTrue: [| usedHeight |
- usedHeight := self usedHeightByPredominantDockingBarsOfChastes: #(#top #bottom ).
- self height: self owner height + margin - usedHeight]!
Item was removed:
- ----- Method: DockingBarMorph>>updateLayoutProperties (in category 'private - layout') -----
- updateLayoutProperties
- "private - update the layout properties based on adhering,
- fillsOwner and avoidVisibleBordersAtEdge preferencs"
- ""
- (self isHorizontal
- or: [self isFloating])
- ifTrue: [self listDirection: #leftToRight]
- ifFalse: [self listDirection: #topToBottom].
- ""
- self hResizing: #shrinkWrap.
- self vResizing: #shrinkWrap.
- self fillsOwner
- ifTrue: [""
- self isHorizontal
- ifTrue: [self hResizing: #spaceFill].
- self isVertical
- ifTrue: [self vResizing: #spaceFill]].
- ""
- self isHorizontal ifTrue: [
- self submorphsDo: [:m | m hResizing: #shrinkWrap; vResizing: #spaceFill]].
- self isVertical ifTrue: [
- self submorphsDo: [:m | m vResizing: #shrinkWrap; hResizing: #spaceFill]].
- !
Item was removed:
- ----- Method: DockingBarMorph>>updatePosition (in category 'private - layout') -----
- updatePosition
- "private - update the receiver's position"
- | edgeSymbol margin |
- edgeSymbol := self edgeToAdhereTo.
- self
- perform: (edgeSymbol , ':') asSymbol
- with: (self owner perform: edgeSymbol).
- ""
- margin := self avoidVisibleBordersAtEdge
- ifTrue: [self borderWidth asPoint]
- ifFalse: [0 asPoint].
- ""
- self isAdheringToTop
- ifTrue: [| usedHeight |
- usedHeight := self usedHeightByPredominantDockingBarsOfChastes: #(#top ).
- self topLeft: self owner topLeft - margin + (0 @ usedHeight)].
- self isAdheringToBottom
- ifTrue: [| usedHeight |
- usedHeight := self usedHeightByPredominantDockingBarsOfChastes: #(#bottom ).
- self bottomLeft: self owner bottomLeft + (-1 @ 1 * margin) - (0 @ usedHeight)].
- ""
- self isAdheringToLeft
- ifTrue: [| usedHeight usedWidth |
- usedHeight := self usedHeightByPredominantDockingBarsOfChastes: #(#top ).
- usedWidth := self usedWidthByPredominantDockingBarsOfChastes: #(#left ).
- self topLeft: self owner topLeft - margin + (usedWidth @ usedHeight)].
- self isAdheringToRight
- ifTrue: [| usedHeight usedWidth |
- usedHeight := self usedHeightByPredominantDockingBarsOfChastes: #(#top ).
- usedWidth := self usedWidthByPredominantDockingBarsOfChastes: #(#right ).
- self topRight: self owner topRight + (1 @ -1 * margin) + (usedWidth negated @ usedHeight)]!
Item was removed:
- ----- Method: DockingBarMorph>>usedHeightByPredominantDockingBarsOfChastes: (in category 'private - accessing') -----
- usedHeightByPredominantDockingBarsOfChastes: predominantChastes
- "Private - convenience"
- | predominants |
- predominants := self predominantDockingBarsOfChastes: predominantChastes.
- ^ predominants isEmpty
- ifTrue: [0]
- ifFalse: [(predominants
- collect: [:each | each height]) sum]!
Item was removed:
- ----- Method: DockingBarMorph>>usedWidthByPredominantDockingBarsOfChastes: (in category 'private - accessing') -----
- usedWidthByPredominantDockingBarsOfChastes: predominantChastes
- "Private - convenience"
- | predominants |
- predominants := self predominantDockingBarsOfChastes: predominantChastes.
- ^ predominants isEmpty
- ifTrue: [0]
- ifFalse: [(predominants
- collect: [:each | each width]) sum]!
Item was removed:
- ----- Method: DockingBarMorph>>wantsEveryMouseMove (in category 'events-processing') -----
- wantsEveryMouseMove
- ^ true!
Item was removed:
- ----- Method: DockingBarMorph>>wantsToBeTopmost (in category 'accessing') -----
- wantsToBeTopmost
- "Answer if the receiver want to be one of the topmost objects in
- its owner"
- ^ true!
Item was removed:
- ----- Method: DockingBarMorph>>wantsYellowButtonMenu (in category 'menu') -----
- wantsYellowButtonMenu
- "Answer true if the receiver wants a yellow button menu"
- ^ Preferences noviceMode not!
Item was removed:
- UpdatingMenuItemMorph subclass: #DockingBarUpdatingItemMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Menus-DockingBar'!
Item was removed:
- ----- Method: DockingBarUpdatingItemMorph>>adjacentTo (in category 'selecting') -----
- adjacentTo
-
- | roundedCornersOffset verticalOffset |
- roundedCornersOffset := MenuMorph roundedMenuCorners
- ifTrue: [Morph preferredCornerRadius negated]
- ifFalse: [0].
- verticalOffset := 2.
-
- owner isFloating
- ifTrue: [^ {self bounds bottomLeft + (roundedCornersOffset @ verticalOffset)}].
- owner isAdheringToTop
- ifTrue: [^ {self bounds bottomLeft + (roundedCornersOffset @ verticalOffset)}].
- owner isAdheringToLeft
- ifTrue: [^ {self bounds topRight + (roundedCornersOffset @ verticalOffset)}].
- owner isAdheringToBottom
- ifTrue: [^ {self bounds topLeft + (roundedCornersOffset @ verticalOffset)}].
- owner isAdheringToRight
- ifTrue: [^ {self bounds topLeft + (roundedCornersOffset @ verticalOffset negated)}].
- ^ {self bounds bottomLeft + (roundedCornersOffset @ 5)}!
Item was removed:
- ----- Method: DockingBarUpdatingItemMorph>>createSubmenu (in category 'private') -----
- createSubmenu
-
- ^DockingBarMenuMorph new!
Item was removed:
- ----- Method: DockingBarUpdatingItemMorph>>createUpdatingSubmenu (in category 'private') -----
- createUpdatingSubmenu
-
- ^DockingBarUpdatingMenuMorph new!
Item was removed:
- ----- Method: DockingBarUpdatingItemMorph>>decorateOwner (in category 'world') -----
- decorateOwner
-
- "Ignore."!
Item was removed:
- ----- Method: DockingBarUpdatingItemMorph>>drawIconOn: (in category 'drawing') -----
- drawIconOn: aCanvas
-
- | pos |
- self hasIcon ifTrue: [
- | iconForm |
- iconForm := self iconForm.
-
- pos := (contents
- ifEmpty: [self left + (self width - iconForm width // 2)]
- ifNotEmpty: [self left])
- @ (self top + (self height - iconForm height // 2)).
-
- aCanvas
- translucentImage: iconForm
- at: pos].!
Item was removed:
- ----- Method: DockingBarUpdatingItemMorph>>drawLabelOn: (in category 'drawing') -----
- drawLabelOn: aCanvas
-
- | stringBounds |
- self contents ifEmpty: [^ self].
-
- stringBounds := bounds.
-
- self hasIcon ifTrue: [
- stringBounds := stringBounds left: stringBounds left + self iconForm width + 2 ].
-
- "Vertical centering."
- stringBounds := stringBounds top: stringBounds top + stringBounds bottom - self fontToUse height // 2.
- "Horizontal centering."
- stringBounds := stringBounds left: stringBounds left + (stringBounds width - (self fontToUse widthOfString: contents) // 2) abs.
-
- aCanvas
- drawString: contents
- in: stringBounds
- font: self fontToUse
- color: self colorToUse.!
Item was removed:
- ----- Method: DockingBarUpdatingItemMorph>>drawSubMenuMarkerOn: (in category 'drawing') -----
- drawSubMenuMarkerOn: aCanvas
- "Ignore."!
Item was removed:
- ----- Method: DockingBarUpdatingItemMorph>>mouseDown: (in category 'events') -----
- mouseDown: evt
- "Handle a mouse down event. Menu items get activated when the mouse is over them."
-
- (evt shiftPressed and:[self wantsKeyboardFocusOnShiftClick]) ifTrue: [ ^super mouseDown: evt ]. "enable label editing"
- isSelected
- ifTrue: [
- owner selectItem: nil event: evt. ]
- ifFalse: [
- owner activate: evt. "Redirect to menu for valid transitions"
- owner selectItem: self event: evt. ]
- !
Item was removed:
- ----- Method: DockingBarUpdatingItemMorph>>mouseEnter: (in category 'events') -----
- mouseEnter: evt
- "Do not hover docking bar items directory. Mouse-down required. But if you already see a submenu, support hovering."
-
- owner selectedItem ifNotNil: [owner selectItem: self event: evt]!
Item was removed:
- ----- Method: DockingBarUpdatingItemMorph>>mouseUp: (in category 'events') -----
- mouseUp: evt
- "Handle a mouse up event. Menu items get activated when the mouse is over them. Do nothing if we're not in a 'valid menu transition', meaning that the current hand focus must be aimed at the owning menu."
-
- evt hand mouseFocus == owner ifFalse: [ ^self ].
- self contentString ifNotNil: [
- self contents: self contentString withMarkers: true inverse: true.
- self refreshWorld.
- (Delay forMilliseconds: 200) wait ].!
Item was removed:
- ----- Method: DockingBarUpdatingItemMorph>>select: (in category 'selecting') -----
- select: evt
-
- super select: evt.
- subMenu ifNotNil: [
- evt hand newKeyboardFocus: subMenu ]!
Item was removed:
- ----- Method: DockingBarUpdatingItemMorph>>wantsKeyboardFocusOnShiftClick (in category 'events') -----
- wantsKeyboardFocusOnShiftClick
- "set this preference to false to prevent user editing of docking bar menu items"
- ^Preferences valueOfPreference: #allowMenubarItemEditing ifAbsent: [false]!
Item was removed:
- DockingBarMenuMorph subclass: #DockingBarUpdatingMenuMorph
- instanceVariableNames: 'arguments updater updateSelector menuUpdater'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Menus-DockingBar'!
Item was removed:
- ----- Method: DockingBarUpdatingMenuMorph>>delete (in category 'initialization') -----
- delete
-
- owner ifNotNil: [
- " When deleted remove my menu items, so I can avoid holding unwanted references to other objects. They will be updated anyway when I become visible again. "
- " The owner notNil condition is necessary because MenuItemMorph >> select: sends delete before I become visible, but after the menu items are updated. "
- self removeAllMorphs ].
- super delete!
Item was removed:
- ----- Method: DockingBarUpdatingMenuMorph>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
- menuUpdater := MenuUpdater new!
Item was removed:
- ----- Method: DockingBarUpdatingMenuMorph>>morphicLayerNumber: (in category 'update') -----
- morphicLayerNumber: n
-
- super morphicLayerNumber: n.
- !
Item was removed:
- ----- Method: DockingBarUpdatingMenuMorph>>updateMenu (in category 'update') -----
- updateMenu
-
- menuUpdater update: self!
Item was removed:
- ----- Method: DockingBarUpdatingMenuMorph>>updater:updateSelector: (in category 'initialization') -----
- updater: anObject updateSelector: aSelector
-
- menuUpdater updater: anObject updateSelector: aSelector!
Item was removed:
- ----- Method: DockingBarUpdatingMenuMorph>>updater:updateSelector:arguments: (in category 'initialization') -----
- updater: anObject updateSelector: aSelector arguments: anArray
-
- menuUpdater updater: anObject updateSelector: aSelector arguments: anArray!
Item was removed:
- MorphicEvent subclass: #DropEvent
- instanceVariableNames: 'position contents wasHandled'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!
Item was removed:
- ----- Method: DropEvent>>contents (in category 'accessing') -----
- contents
- ^contents!
Item was removed:
- ----- Method: DropEvent>>copyHandlerState: (in category 'initialize') -----
- copyHandlerState: anEvent
- "Copy the handler state from anEvent. Used for quickly transferring handler information between transformed events."
- wasHandled := anEvent wasHandled.!
Item was removed:
- ----- Method: DropEvent>>cursorPoint (in category 'accessing') -----
- cursorPoint
- "For compatibility with mouse events"
- ^position!
Item was removed:
- ----- Method: DropEvent>>isDropEvent (in category 'testing') -----
- isDropEvent
- ^true!
Item was removed:
- ----- Method: DropEvent>>position (in category 'accessing') -----
- position
- ^position!
Item was removed:
- ----- Method: DropEvent>>printOn: (in category 'printing') -----
- printOn: aStream
-
- aStream nextPut: $[.
- aStream nextPutAll: self position printString; space.
- aStream nextPutAll: self type.
- aStream nextPut: $].!
Item was removed:
- ----- Method: DropEvent>>resetHandlerFields (in category 'initialize') -----
- resetHandlerFields
- "Reset anything that is used to cross-communicate between two eventual handlers during event dispatch"
- wasHandled := false.!
Item was removed:
- ----- Method: DropEvent>>sentTo: (in category 'dispatching') -----
- sentTo: anObject
- "Dispatch the receiver into anObject"
- self type == #dropEvent ifTrue:[^anObject handleDropMorph: self].!
Item was removed:
- ----- Method: DropEvent>>setPosition:contents:hand: (in category 'private') -----
- setPosition: pos contents: aMorph hand: aHand
- position := pos.
- contents := aMorph.
- source := aHand.
- wasHandled := false.!
Item was removed:
- ----- Method: DropEvent>>transformBy: (in category 'transforming') -----
- transformBy: aMorphicTransform
- "Transform the receiver into a local coordinate system."
- position := aMorphicTransform globalPointToLocal: position.!
Item was removed:
- ----- Method: DropEvent>>transformedBy: (in category 'transforming') -----
- transformedBy: aMorphicTransform
- "Return the receiver transformed by the given transform into a local coordinate system."
- ^self shallowCopy transformBy: aMorphicTransform!
Item was removed:
- ----- Method: DropEvent>>translateTo: (in category 'transforming') -----
- translateTo: point
-
- position := point.!
Item was removed:
- ----- Method: DropEvent>>type (in category 'accessing') -----
- type
- ^#dropEvent!
Item was removed:
- ----- Method: DropEvent>>wasHandled (in category 'accessing') -----
- wasHandled
- ^wasHandled!
Item was removed:
- ----- Method: DropEvent>>wasHandled: (in category 'accessing') -----
- wasHandled: aBool
- wasHandled := aBool.!
Item was removed:
- MenuMorph subclass: #DumberMenuMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Explorer'!
-
- !DumberMenuMorph commentStamp: '<historical>' prior: 0!
- Contributed by Bob Arning as part of the ObjectExplorer package.
- !
Item was removed:
- ----- Method: DumberMenuMorph>>setInvokingView: (in category 'menu') -----
- setInvokingView: invokingView
- "I'd rather not, if that's OK"!
Item was removed:
- Object subclass: #Editor
- instanceVariableNames: 'morph'
- classVariableNames: 'BlinkingCursor DestructiveBackWord DumbbellCursor KeystrokeActions SelectionsMayShrink'
- poolDictionaries: ''
- category: 'Morphic-Text Support'!
-
- !Editor commentStamp: 'hjh 9/28/2017 11:37' prior: 0!
- New text editors.
- TextEditor provides most of the functionality that used to be in TextMorphEditor.
- SmalltalkEditor is has Smalltalk code specific features.
- !
Item was removed:
- ----- Method: Editor class>>blinkingCursor (in category 'preferences') -----
- blinkingCursor
- <preference: 'Blinking Text Cursor'
- category: 'Morphic'
- description: 'When true, the text cursor will blink.'
- type: #Boolean>
- ^ BlinkingCursor ifNil: [ true ]!
Item was removed:
- ----- Method: Editor class>>blinkingCursor: (in category 'preferences') -----
- blinkingCursor: aBoolean
- BlinkingCursor := aBoolean!
Item was removed:
- ----- Method: Editor class>>cleanUp: (in category 'class initialization') -----
- cleanUp: aggressive
-
- aggressive ifTrue: [self initialize].!
Item was removed:
- ----- Method: Editor class>>destructiveBackWord (in category 'preferences') -----
- destructiveBackWord
- <preference: 'Destructive Back-Word'
- category: 'Morphic'
- description: 'Indicates whether the back-word command deletes, or merely selects, the prior word.'
- type: #Boolean>
- ^ DestructiveBackWord ifNil: [ true ]!
Item was removed:
- ----- Method: Editor class>>destructiveBackWord: (in category 'preferences') -----
- destructiveBackWord: aBoolean
- DestructiveBackWord := aBoolean!
Item was removed:
- ----- Method: Editor class>>dumbbellCursor (in category 'preferences') -----
- dumbbellCursor
- <preference: 'Dumbbell Text Cursor'
- category: 'Morphic'
- description: 'When enabled, the text cursor assumes the shape of a dumbbell, otherwise a vertical bar.'
- type: #Boolean>
- ^ DumbbellCursor ifNil: [ false ]!
Item was removed:
- ----- Method: Editor class>>dumbbellCursor: (in category 'preferences') -----
- dumbbellCursor: aBoolean
- DumbbellCursor := aBoolean!
Item was removed:
- ----- Method: Editor class>>initialize (in category 'class initialization') -----
- initialize
- "
- Editor initialize
- "
- self initializeKeystrokeActions.
- self allSubclassesDo: [ :c | c initialize ]!
Item was removed:
- ----- Method: Editor class>>initializeKeystrokeActions (in category 'class initialization') -----
- initializeKeystrokeActions
- "Initialize the table for regular (i.e. non-command) keystroke dispatch"
- "
- self initializeKeystrokeActions
- "
- | actions |
- actions := Array new: 256 withAll: #normalCharacter:.
- 0 to: 31 do: [ :i | actions at: i+1 put: #noop: ].
- actions at: 1 + 1 put: #cursorHome:. "home key"
- actions at: 3 + 1 put: #enter:. "enter / return key"
- actions at: 4 + 1 put: #cursorEnd:. "end key"
- actions at: 5 + 1 put: #noop:. "insert key"
- actions at: 8 + 1 put: #backspace:. "macDelete winBackspace key"
- actions at: 9 + 1 put: #normalCharacter:. "tab"
- actions at: 11 + 1 put: #cursorPageUp:. "page up key"
- actions at: 12 + 1 put: #cursorPageDown:. "page down key"
- actions at: 13 + 1 put: #enter:. "enter / return key"
- actions at: 27 + 1 put: #offerMenuFromEsc:. "escape key"
- actions at: 28 + 1 put: #cursorLeft:. "left arrow key"
- actions at: 29 + 1 put: #cursorRight:. "right arrow key"
- actions at: 30 + 1 put: #cursorUp:. "up arrow key"
- actions at: 31 + 1 put: #cursorDown:. "down arrow key"
- actions at: 127 + 1 put: #forwardDelete:. "winDelete key"
- KeystrokeActions := actions!
Item was removed:
- ----- Method: Editor class>>selectionsMayShrink (in category 'preferences') -----
- selectionsMayShrink
- <preference: 'Selections may shrink'
- category: 'Morphic'
- description: 'When true, allows selection to shrink when using shift+cursor keys'
- type: #Boolean>
- ^SelectionsMayShrink ifNil:[true]!
Item was removed:
- ----- Method: Editor class>>selectionsMayShrink: (in category 'preferences') -----
- selectionsMayShrink: aBoolean
- SelectionsMayShrink := aBoolean!
Item was removed:
- ----- Method: Editor class>>specialShiftCmdKeys (in category 'keyboard shortcut tables') -----
- specialShiftCmdKeys
-
- "Private - return array of key codes that represent single keys acting
- as if shift-command were also being pressed"
-
- ^#(
- 1 "home"
- 3 "enter"
- 4 "end"
- 5 "insert"
- 8 "backspace"
- 11 "page up"
- 12 "page down"
- 27 "escape"
- 28 "left arrow"
- 29 "right arrow"
- 30 "up arrow"
- 31 "down arrow"
- 127 "delete"
- )!
Item was removed:
- ----- Method: Editor>>backWord: (in category 'typing/selecting keys') -----
- backWord: aKeyboardEvent
- ^ self class destructiveBackWord
- ifTrue: [ self destructiveBackWord: aKeyboardEvent ]
- ifFalse: [ self nonDestructiveBackWord: aKeyboardEvent ]!
Item was removed:
- ----- Method: Editor>>backspace: (in category 'typing/selecting keys') -----
- backspace: aKeyboardEvent
- "Backspace over the last character."
-
- | startIndex |
- aKeyboardEvent shiftPressed ifTrue: [^ self backWord: aKeyboardEvent].
- startIndex := self markIndex +
- (self hasCaret ifTrue: [0] ifFalse: [1]).
- startIndex := 1 max: startIndex - 1.
-
- ^ self backTo: startIndex!
Item was removed:
- ----- Method: Editor>>beginningOfLine: (in category 'private') -----
- beginningOfLine: position
- "Redefined in subclasses using Paragraph support"
- ^ self beginningOfParagraph: position!
Item was removed:
- ----- Method: Editor>>beginningOfNextParagraph: (in category 'private') -----
- beginningOfNextParagraph: position
- | s |
- s := self string.
- ^ (s
- indexOf: Character cr
- startingAt: position
- ifAbsent: [ s size ]) + 1!
Item was removed:
- ----- Method: Editor>>beginningOfParagraph: (in category 'private') -----
- beginningOfParagraph: position
- ^ (self string
- lastIndexOf: Character cr
- startingAt: position) + 1.!
Item was removed:
- ----- Method: Editor>>beginningOfText (in category 'private') -----
- beginningOfText
- ^1!
Item was removed:
- ----- Method: Editor>>clearSelection (in category 'typing/selecting keys') -----
- clearSelection
-
- self selectFrom: 1 to: 0!
Item was removed:
- ----- Method: Editor>>clipboardText (in category 'menu messages') -----
- clipboardText
-
- ^ Clipboard clipboardText!
Item was removed:
- ----- Method: Editor>>clipboardTextPut: (in category 'menu messages') -----
- clipboardTextPut: text
-
- ^ Clipboard clipboardText: text!
Item was removed:
- ----- Method: Editor>>copySelection: (in category 'editing keys') -----
- copySelection: aKeyboardEvent
- "Copy the current text selection."
-
- self copySelection.
- ^true!
Item was removed:
- ----- Method: Editor>>cr: (in category 'typing/selecting keys') -----
- cr: aKeyboardEvent
- "Append a carriage return character to the stream of characters."
-
- self addString: Character cr asString.
- ^false!
Item was removed:
- ----- Method: Editor>>crWithIndent: (in category 'typing/selecting keys') -----
- crWithIndent: aKeyboardEvent
-
- "Only for SmalltalkEditor. Regular editors don't indent"
- ^ self cr: aKeyboardEvent!
Item was removed:
- ----- Method: Editor>>crlf: (in category 'typing/selecting keys') -----
- crlf: aKeyboardEvent
- "Append a line feed character to the stream of characters."
-
- self addString: String crlf.
- ^false!
Item was removed:
- ----- Method: Editor>>cursorDown: (in category 'nonediting/nontyping keys') -----
- cursorDown: aKeyboardEvent
- "Private - Move cursor from position in current line to same position in
- next line. If next line too short, put at end. If shift key down,
- select."
- self insertAndCloseTypeIn.
- self
- moveCursor: [:position | self
- sameColumn: position
- newLine: [:line | line + 1]
- forward: true]
- forward: true
- event: aKeyboardEvent
- specialBlock: [:dummy | dummy].
- ^true!
Item was removed:
- ----- Method: Editor>>cursorLeft: (in category 'nonediting/nontyping keys') -----
- cursorLeft: aKeyboardEvent
- "Private - Move cursor left one character if nothing selected, otherwise
- move cursor to beginning of selection. If the shift key is down, start
- selecting or extending current selection. Don't allow cursor past
- beginning of text"
-
- self insertAndCloseTypeIn.
- self
- moveCursor:[:position | position - 1 max: 1]
- forward: false
- event: aKeyboardEvent
- specialBlock:[:position | self previousWord: position].
- ^ true!
Item was removed:
- ----- Method: Editor>>cursorPageDown: (in category 'nonediting/nontyping keys') -----
- cursorPageDown: aKeyboardEvent
-
- self insertAndCloseTypeIn.
- self
- moveCursor: [:position |
- self
- sameColumn: position
- newLine: [:lineNo | lineNo + self pageHeight]
- forward: true]
- forward: true
- event: aKeyboardEvent
- specialBlock:[:dummy | dummy].
- ^true!
Item was removed:
- ----- Method: Editor>>cursorPageUp: (in category 'nonediting/nontyping keys') -----
- cursorPageUp: aKeyboardEvent
-
- self insertAndCloseTypeIn.
- self
- moveCursor: [:position |
- self
- sameColumn: position
- newLine: [:lineNo | lineNo - self pageHeight]
- forward: false]
- forward: false
- event: aKeyboardEvent
- specialBlock:[:dummy | dummy].
- ^true!
Item was removed:
- ----- Method: Editor>>cursorRight: (in category 'nonediting/nontyping keys') -----
- cursorRight: aKeyboardEvent
- "Private - Move cursor right one character if nothing selected,
- otherwise move cursor to end of selection. If the shift key is down,
- start selecting characters or extending already selected characters.
- Don't allow cursor past end of text"
-
- self insertAndCloseTypeIn.
- self
- moveCursor: [:position | position + 1]
- forward: true
- event: aKeyboardEvent
- specialBlock:[:position | self nextWord: position].
- ^ true!
Item was removed:
- ----- Method: Editor>>cursorTopHome: (in category 'typing/selecting keys') -----
- cursorTopHome: aKeyboardEvent
- "Put cursor at beginning of text -- invoked from cmd-H shortcut, useful for keyboards that have no home key."
-
- self selectAt: 1.
- ^ true!
Item was removed:
- ----- Method: Editor>>cursorUp: (in category 'nonediting/nontyping keys') -----
- cursorUp: aKeyboardEvent
- "Private - Move cursor from position in current line to same position in
- prior line. If prior line too short, put at end"
-
- self insertAndCloseTypeIn.
- self
- moveCursor: [:position | self
- sameColumn: position
- newLine:[:line | line - 1]
- forward: false]
- forward: false
- event: aKeyboardEvent
- specialBlock:[:dummy | dummy].
- ^true!
Item was removed:
- ----- Method: Editor>>cut: (in category 'editing keys') -----
- cut: aKeyboardEvent
- "Cut out the current text selection."
-
- self cut.
- ^true!
Item was removed:
- ----- Method: Editor>>destructiveBackWord (in category 'typing/selecting keys') -----
- destructiveBackWord
- "If the selection is not a caret, delete it and leave it in the backspace buffer.
- Else if there is typeahead, delete it.
- Else, delete the word before the caret."
-
- | startIndex |
- self hasCaret
- ifTrue: "a caret, delete at least one character"
- [startIndex := 1 max: self markIndex - 1.
- [startIndex > 1 and:
- [(self string at: startIndex - 1) tokenish]]
- whileTrue:
- [startIndex := startIndex - 1]]
- ifFalse: "a non-caret, just delete it"
- [startIndex := self markIndex].
- self backTo: startIndex.
- ^ false!
Item was removed:
- ----- Method: Editor>>destructiveBackWord: (in category 'typing/selecting keys') -----
- destructiveBackWord: aKeyboardEvent
-
- ^ self destructiveBackWord!
Item was removed:
- ----- Method: Editor>>endOfLine: (in category 'private') -----
- endOfLine: position
- "Redefined in subclasses using Paragraph support"
- ^self endOfParagraph: position!
Item was removed:
- ----- Method: Editor>>endOfParagraph: (in category 'private') -----
- endOfParagraph: position
- | s |
- s := self string.
- ^ s
- indexOf: Character cr
- startingAt: position
- ifAbsent: [ s size + 1 ].!
Item was removed:
- ----- Method: Editor>>endOfText (in category 'private') -----
- endOfText
- ^self string size + 1!
Item was removed:
- ----- Method: Editor>>enter: (in category 'typing/selecting keys') -----
- enter: aKeyboardEvent
- "Enter / return key was pressed"
- "Process the various Enter / Return keystrokes"
-
- morph acceptOnCR ifTrue: [
- self closeTypeIn.
- ^ true].
-
- aKeyboardEvent controlKeyPressed ifTrue: [
- ^ self cr: aKeyboardEvent ].
- aKeyboardEvent shiftPressed ifTrue: [
- ^ self lf: aKeyboardEvent ].
- aKeyboardEvent commandAltKeyPressed ifTrue: [
- ^ self crlf: aKeyboardEvent ].
- ^ self crWithIndent: aKeyboardEvent!
Item was removed:
- ----- Method: Editor>>firstWordBoundaryAfter: (in category 'private') -----
- firstWordBoundaryAfter: position
- "If the character at position is whitespace, answer the position of the first character after position which is not whitespace.
- If the character at position is not whitespace, answer the position of the first character after position which is whitespace."
- | string index atWhitespace |
- string := self string.
- index := position.
- (atWhitespace := (string at: index) isSeparator)
- ifTrue:
- [ "find next non-separator"
- [ (index <= string size) and: [ (string at: index) isSeparator ] ] whileTrue: [ index := index + 1 ] ]
- ifFalse:
- [ "find next separator"
- [ (index <= string size) and: [ (string at: index) isSeparator not ] ] whileTrue: [ index := index + 1 ] ].
- ^ index!
Item was removed:
- ----- Method: Editor>>hasSelection (in category 'accessing-selection') -----
- hasSelection
- ^self hasCaret not!
Item was removed:
- ----- Method: Editor>>lf: (in category 'typing/selecting keys') -----
- lf: aKeyboardEvent
- "Append a line feed character to the stream of characters."
-
- self addString: Character lf asString.
- ^false!
Item was removed:
- ----- Method: Editor>>lineSelectAndEmptyCheck: (in category 'menu messages') -----
- lineSelectAndEmptyCheck: returnBlock
- "If the current selection is an insertion point, expand it to be the entire current line; if after that's done the selection is still empty, then evaluate the returnBlock, which will typically consist of '[^ self]' in the caller -- check senders of this method to understand this."
-
- self hasSelection ifFalse: [
- self selectLine.
- self hasSelection ifFalse: [
- morph flash.
- ^ returnBlock value]].!
Item was removed:
- ----- Method: Editor>>lines (in category 'private') -----
- lines
- "Compute lines based on logical line breaks, not optical (which may change due to line wrapping of the editor).
- Subclasses using kinds of Paragraphs can instead use the service provided by it."
- | lines string lineIndex |
- string := self string.
- "Empty strings have no lines at all. Think of something."
- string isEmpty ifTrue:[^{#(1 0 0)}].
- lines := OrderedCollection new: (string size // 15).
- lineIndex := 0.
- string lineIndicesDo: [:start :endWithoutDelimiters :end |
- lines addLast: {start. (lineIndex := lineIndex + 1). end}].
- "Special workaround for last line empty."
- (string last == Character cr or: [string last == Character lf])
- ifTrue: [lines addLast: {string size + 1. lineIndex + 1. string size}].
- ^lines!
Item was removed:
- ----- Method: Editor>>morph (in category 'accessing') -----
- morph
- ^ morph!
Item was removed:
- ----- Method: Editor>>morph: (in category 'accessing') -----
- morph: aMorph
- "Install a link back to the morph being edited (esp for text links)"
- morph := aMorph !
Item was removed:
- ----- Method: Editor>>moveCursor:forward:event:specialBlock: (in category 'private') -----
- moveCursor: directionBlock forward: forward event: aKeyboardEvent specialBlock: specialBlock
- "Private - Move cursor.
- directionBlock is a one argument Block that computes the new Position from a given one.
- specialBlock is a one argumentBlock that computes the new position from a given one under the alternate semantics.
- Note that directionBlock always is evaluated first."
- | indices newPosition shouldSelect |
- shouldSelect := aKeyboardEvent shiftPressed.
- indices := self setIndices: shouldSelect forward: forward.
- newPosition := directionBlock value: (indices at: #moving).
- (aKeyboardEvent commandKeyPressed or: [aKeyboardEvent controlKeyPressed])
- ifTrue: [newPosition := specialBlock value: newPosition].
- shouldSelect
- ifTrue: [self selectMark: (indices at: #fixed) point: newPosition - 1]
- ifFalse: [self selectAt: newPosition]!
Item was removed:
- ----- Method: Editor>>moveCursor:forward:select: (in category 'private') -----
- moveCursor: directionBlock forward: forward select: shouldSelect
- "Private - Move cursor.
- directionBlock is a one argument Block that computes the new Position from a given one.
- specialBlock is a one argumentBlock that computes the new position from a given one under the alternate semantics.
- Note that directionBlock always is evaluated first."
- | indices newPosition |
- indices := self setIndices: shouldSelect forward: forward.
- newPosition := directionBlock value: (indices at: #moving).
- shouldSelect
- ifTrue: [self selectMark: (indices at: #fixed) point: newPosition - 1]
- ifFalse: [self selectAt: newPosition]!
Item was removed:
- ----- Method: Editor>>nextWord: (in category 'private') -----
- nextWord: position
- | string index |
- string := self string.
- index := position.
- [(index between: 1 and: string size) and: [(string at: index) isAlphaNumeric]]
- whileTrue: [index := index + 1].
- [(index between: 1 and: string size) and: [(string at: index) isAlphaNumeric not]]
- whileTrue: [index := index + 1].
- ^ index!
Item was removed:
- ----- Method: Editor>>nonDestructiveBackWord: (in category 'typing/selecting keys') -----
- nonDestructiveBackWord: aKeyboardEvent
- "Select the prior word."
- | indices newPosition |
- self closeTypeIn.
- indices := self
- setIndices: true
- forward: false.
- newPosition := 1 max: (indices at: #moving) - 1.
- newPosition := self previousWord: newPosition.
- self selectMark: (indices at: #fixed) point: newPosition - 1.
- ^ true!
Item was removed:
- ----- Method: Editor>>noop: (in category 'editing keys') -----
- noop: aKeyboardEvent
- "Unimplemented keyboard command; just ignore it."
-
- ^ true!
Item was removed:
- ----- Method: Editor>>normalCharacter: (in category 'typing/selecting keys') -----
- normalCharacter: aKeyboardEvent
- "A nonspecial character is to be added to the stream of characters."
-
- self addString: aKeyboardEvent keyCharacter asString.
- ^false!
Item was removed:
- ----- Method: Editor>>paste (in category 'menu messages') -----
- paste
- "Paste the text from the shared buffer over the current selection and
- redisplay if necessary. Undoer & Redoer: undoAndReselect."
-
- self replace: self selectionInterval with: self clipboardText and:
- [self selectAt: self pointIndex]!
Item was removed:
- ----- Method: Editor>>paste: (in category 'editing keys') -----
- paste: aKeyboardEvent
- "Replace the current text selection by the text in the shared buffer."
-
- self insertAndCloseTypeIn.
- self paste.
- ^true!
Item was removed:
- ----- Method: Editor>>previousWord: (in category 'private') -----
- previousWord: position
- | string index |
- string := self string.
- index := position.
- [(index between: 1 and: string size) and: [(string at: index) isAlphaNumeric not]]
- whileTrue: [index := index - 1].
- [(index between: 1 and: string size) and: [(string at: index) isAlphaNumeric]]
- whileTrue: [index := index - 1].
- ^ index + 1!
Item was removed:
- ----- Method: Editor>>selectAll (in category 'typing/selecting keys') -----
- selectAll
-
- self selectFrom: 1 to: self string size!
Item was removed:
- ----- Method: Editor>>selectAll: (in category 'typing/selecting keys') -----
- selectAll: aKeyboardEvent
- "select everything, invoked by cmd-a. 1/17/96 sw"
-
- self insertAndCloseTypeIn.
- self selectFrom: 1 to: self string size.
- ^ true!
Item was removed:
- ----- Method: Editor>>selectAt: (in category 'new selection') -----
- selectAt: characterIndex
- "Deselect, then place the caret before the character at characterIndex.
- Be sure it is in view."
-
- self selectFrom: characterIndex to: characterIndex - 1!
Item was removed:
- ----- Method: Editor>>selectInterval: (in category 'new selection') -----
- selectInterval: anInterval
- "Deselect, then select the specified characters inclusive.
- Be sure the selection is in view."
-
- self selectFrom: anInterval first to: anInterval last!
Item was removed:
- ----- Method: Editor>>selectIntervalInvisibly: (in category 'new selection') -----
- selectIntervalInvisibly: anInterval
- "Deselect, then select the specified characters inclusive.
- Do not yet make the new selection visible."
-
- self selectInvisiblyFrom: anInterval first to: anInterval last!
Item was removed:
- ----- Method: Editor>>selectInvisiblyFrom:to: (in category 'new selection') -----
- selectInvisiblyFrom: start to: stop
- "Select the designated characters, inclusive. Make no visual changes."
-
- self markIndex: start pointIndex: stop + 1!
Item was removed:
- ----- Method: Editor>>selectInvisiblyMark:point: (in category 'new selection') -----
- selectInvisiblyMark: mark point: point
- "Select the designated characters, inclusive. Make no visual changes."
-
- self markIndex: mark pointIndex: point + 1!
Item was removed:
- ----- Method: Editor>>selectMark:point: (in category 'new selection') -----
- selectMark: mark point: point
- "Deselect, then select the specified characters inclusive.
- Be sure the selection is in view."
-
- (mark = self markIndex and: [point + 1 = self pointIndex]) ifFalse: [
- self selectInvisiblyMark: mark point: point ]!
Item was removed:
- ----- Method: Editor>>selectWord (in category 'new selection') -----
- selectWord
- "Select a word or expression, the result of pressing Command+[Space Bar] or by double-clicking."
- ^self
- selectWordLeftDelimiters: '
- "''|([{<' "<--- punctuation symbols should precede the bracket symbols"
- rightDelimiters: '
- "''|)]}>'!
Item was removed:
- ----- Method: Editor>>selectWord: (in category 'nonediting/nontyping keys') -----
- selectWord: aKeyboardEvent
-
- self insertAndCloseTypeIn.
- self selectWord.
- ^ true!
Item was removed:
- ----- Method: Editor>>selectWordLeftDelimiters:rightDelimiters: (in category 'new selection') -----
- selectWordLeftDelimiters: leftDelimiters rightDelimiters: rightDelimiters
- "Select delimited text or word--the result of double-clicking."
-
- | openDelimiter closeDelimiter direction match level
- string here hereChar start stop |
- string := self string.
- string size < 2 ifTrue: [^self].
- here := self pointIndex.
- "Select the whole text when clicking before first or after last character"
- (here > string size or: [here < 2]) ifTrue: [^self selectFrom: 1 to: string size].
- openDelimiter := string at: here - 1.
- closeDelimiter := string at: here.
- (match := leftDelimiters indexOf: openDelimiter) > (rightDelimiters indexOf: closeDelimiter)
- ifTrue: [
- "a more-distinct delimiter is on the left -- match to the right"
- start := here.
- direction := 1.
- here := here - 1.
- closeDelimiter := rightDelimiters at: match]
- ifFalse: [
- openDelimiter := string at: here.
- match := rightDelimiters indexOf: openDelimiter.
- match > 0
- ifTrue: [
- "delimiter is on right -- match to the left"
- stop := here - 1.
- direction := -1.
- closeDelimiter := leftDelimiters at: match]
- ifFalse: [
- "no delimiters -- select a token"
- direction := -1]].
- level := 1.
- [level > 0 and: [direction > 0
- ifTrue: [here < string size]
- ifFalse: [here > 1]]]
- whileTrue: [
- hereChar := string at: (here := here + direction).
- match = 0
- ifTrue: ["token scan goes left, then right"
- hereChar tokenish
- ifTrue: [here = 1
- ifTrue: [
- start := 1.
- "go right if hit string start"
- direction := 1]]
- ifFalse: [
- direction < 0
- ifTrue: [
- start := here + 1.
- "go right if hit non-token"
- direction := 1]
- ifFalse: [level := 0]]]
- ifFalse: ["bracket match just counts nesting level"
- hereChar = closeDelimiter
- ifTrue: [level := level - 1"leaving nest"]
- ifFalse: [hereChar = openDelimiter
- ifTrue: [level := level + 1"entering deeper nest"]]]].
-
- level > 0 ifTrue: ["in case ran off string end" here := here + direction].
- ^direction > 0
- ifTrue: [self selectFrom: start to: here - 1]
- ifFalse: [self selectFrom: here + 1 to: stop]!
Item was removed:
- ----- Method: Editor>>selectionInterval (in category 'accessing-selection') -----
- selectionInterval
- "Answer the interval that is currently selected."
-
- ^self startIndex to: self stopIndex - 1 !
Item was removed:
- ----- Method: Editor>>setIndices:forward: (in category 'private') -----
- setIndices: shiftPressed forward: forward
- "Little helper method that sets the moving and fixed indices according to some flags."
- | indices |
- indices := Dictionary new.
- (shiftPressed and:[self class selectionsMayShrink])
- ifTrue: [
- indices at: #moving put: self pointIndex.
- indices at: #fixed put: self markIndex
- ] ifFalse: [
- forward
- ifTrue:[
- indices at: #moving put: self stopIndex.
- indices at: #fixed put: self startIndex.
- ] ifFalse: [
- indices at: #moving put: self startIndex.
- indices at: #fixed put: self stopIndex.
- ]
- ].
- ^indices!
Item was removed:
- ----- Method: Editor>>userHasEdited (in category 'accessing') -----
- userHasEdited
- "Note that my text is free of user edits."
-
- morph hasUnacceptedEdits: true!
Item was removed:
- ----- Method: Editor>>wordSelectAndEmptyCheck: (in category 'menu messages') -----
- wordSelectAndEmptyCheck: returnBlock
- "Ensure selecting the entire current word; if after that's done the selection is still empty, then evaluate the returnBlock, which will typically consist of '[^ self]' in the caller -- check senders of this method to understand this."
-
- self hasSelection ifFalse: [
- self selectWord.
- self hasSelection ifFalse: [
- morph flash.
- ^ returnBlock value]].!
Item was removed:
- Object subclass: #EllipseMidpointTracer
- instanceVariableNames: 'rect x y a b aSquared bSquared d1 d2 inFirstRegion'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Support'!
Item was removed:
- ----- Method: EllipseMidpointTracer>>on: (in category 'initialize') -----
- on: aRectangle
- rect := aRectangle.
- a := rect width // 2.
- b := rect height // 2.
- x := 0.
- y := b.
- aSquared := a * a.
- bSquared := b * b.
- d1 := bSquared - (aSquared * b) + (0.25 * aSquared).
- d2 := nil.
- inFirstRegion := true.!
Item was removed:
- ----- Method: EllipseMidpointTracer>>stepInY (in category 'computing') -----
- stepInY
- "Step to the next y value"
- inFirstRegion ifTrue:[
- "In the upper region we must step until we reach the next y value"
- [(aSquared * (y-0.5)) > (bSquared * (x+1))] whileTrue:[
- d1 < 0.0
- ifTrue:[d1 := d1 + (bSquared * (2*x+3)).
- x := x + 1]
- ifFalse:[d1 := d1 + (bSquared * (2*x+3)) + (aSquared * (-2*y+2)).
- y := y - 1.
- ^x := x + 1]].
- "Stepping into second region"
- d2 := (bSquared * (x + 0.5) squared) + (aSquared * (y-1) squared) - (aSquared * bSquared).
- inFirstRegion := false.
- ].
- "In the lower region each step is a y-step"
- d2 < 0.0
- ifTrue:[d2 := d2 + (bSquared * (2*x+2)) + (aSquared * (-2*y+3)).
- x := x + 1]
- ifFalse:[d2 := d2 + (aSquared * (-2*y+3))].
- y := y - 1.
- ^x!
Item was removed:
- BorderedMorph subclass: #EllipseMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Basic'!
-
- !EllipseMorph commentStamp: 'kfr 10/27/2003 10:32' prior: 0!
- A round BorderedMorph. Supports borderWidth and borderColor.
- Only simple borderStyle is implemented.
-
- EllipseMorph new borderWidth:10; borderColor: Color green; openInWorld.
- EllipseMorph new borderStyle:(SimpleBorder width: 5 color: Color blue); openInWorld.!
Item was removed:
- ----- Method: EllipseMorph class>>descriptionForPartsBin (in category 'parts bin') -----
- descriptionForPartsBin
- ^ self partName: 'Ellipse' translatedNoop
- categories: {'Graphics' translatedNoop. 'Basic' translatedNoop}
- documentation: 'An elliptical or circular shape' translatedNoop!
Item was removed:
- ----- Method: EllipseMorph>>areasRemainingToFill: (in category 'drawing') -----
- areasRemainingToFill: aRectangle
- "Could be improved by quick check of inner rectangle"
-
- ^ Array with: aRectangle!
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>>canDrawBorder: (in category 'testing') -----
- canDrawBorder: aBorderStyle
- ^aBorderStyle style == #simple!
Item was removed:
- ----- Method: EllipseMorph>>canHaveFillStyles (in category 'visual properties') -----
- canHaveFillStyles
- "Return true if the receiver can have general fill styles; not just colors.
- This method is for gradually converting old morphs."
- ^true!
Item was removed:
- ----- Method: EllipseMorph>>closestPointTo: (in category 'geometry') -----
- closestPointTo: aPoint
- ^self intersectionWithLineSegmentFromCenterTo: aPoint!
Item was removed:
- ----- Method: EllipseMorph>>containsPoint: (in category 'geometry testing') -----
- containsPoint: aPoint
-
- | radius other delta xOverY |
- (bounds containsPoint: aPoint) ifFalse: [^ false]. "quick elimination"
- (bounds width = 1 or: [bounds height = 1])
- ifTrue: [^ true]. "Degenerate case -- code below fails by a bit"
-
- radius := bounds height asFloat / 2.
- other := bounds width asFloat / 2.
- delta := aPoint - bounds topLeft - (other at radius).
- xOverY := bounds width asFloat / bounds height asFloat.
- ^ (delta x asFloat / xOverY) squared + delta y squared <= radius squared!
Item was removed:
- ----- Method: EllipseMorph>>cornerStyle: (in category 'rounding') -----
- cornerStyle: aSymbol
- "Set the receiver's corner style. But, in this case, do *not*"
-
- self removeProperty: #cornerStyle.
- self changed!
Item was removed:
- ----- Method: EllipseMorph>>couldHaveRoundedCorners (in category 'accessing') -----
- couldHaveRoundedCorners
- ^ false!
Item was removed:
- ----- Method: EllipseMorph>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- "answer the default border width for the receiver"
- ^ 1!
Item was removed:
- ----- Method: EllipseMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color yellow!
Item was removed:
- ----- Method: EllipseMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- aCanvas isShadowDrawing
- ifTrue: [^ aCanvas fillOval: self bounds fillStyle: self fillStyle borderWidth: 0 borderColor: nil].
- aCanvas fillOval: self bounds fillStyle: self fillStyle borderWidth: self borderWidth borderColor: self borderColor.
- !
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:
- Object subclass: #EventHandler
- instanceVariableNames: 'mouseDownRecipient mouseDownSelector mouseMoveRecipient mouseMoveSelector mouseStillDownRecipient mouseStillDownSelector mouseUpRecipient mouseUpSelector mouseEnterRecipient mouseEnterSelector mouseLeaveRecipient mouseLeaveSelector mouseEnterDraggingRecipient mouseEnterDraggingSelector mouseLeaveDraggingRecipient mouseLeaveDraggingSelector mouseWheelRecipient mouseWheelSelector keyStrokeRecipient keyStrokeSelector keyUpRecipient keyUpSelector keyDownRecipient keyDownSelector valueParameter startDragRecipient startDragSelector doubleClickSelector doubleClickRecipient doubleClickTimeoutSelector doubleClickTimeoutRecipient clickSelector clickRecipient keyboardFocusChangeRecipient keyboardFocusChangeSelector wantsEveryMouseMove'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!
-
- !EventHandler commentStamp: '<historical>' prior: 0!
- Events in Morphic originate in a Hand, pass to a target morph, and are then dispatched by an EventHandler. EventHandlers support redirection of mouse and keyboard activity by specifying and independent recipient object and message selector for each of the possible events. In addition each eventHandler can supply an optional value parameter for distinguishing between, eg, events from a number of otherwise identical source morphs.
-
- The basic protocol of an event handler is to receive a message of the form
- mouseDown: event in: targetMorph
- and redirect this as one of
- mouseDownRecipient perform: mouseDownSelector0
- mouseDownRecipient perform: mouseDownSelector1 with: event
- mouseDownRecipient perform: mouseDownSelector2 with: event with: targetMorph
- mouseDownRecipient perform: mouseDownSelector3 with: event with: targetMorph with: valueParameter
- depending on the arity of the mouseDownSelector.
- !
Item was removed:
- ----- Method: EventHandler>>allRecipients (in category 'access') -----
- allRecipients
- "Answer a list, without duplication, of all the objects serving as recipients to any of the events I handle. Intended for debugging/documentation use only"
- | aList |
- aList := OrderedCollection with: mouseDownRecipient with: mouseStillDownRecipient with: mouseUpRecipient with: mouseEnterRecipient with: mouseLeaveRecipient.
- aList addAll: (OrderedCollection with: mouseEnterDraggingRecipient with: mouseLeaveDraggingRecipient with: doubleClickRecipient with: keyStrokeRecipient).
- aList add: mouseMoveRecipient.
- ^ (aList copyWithout: nil) asSet asArray!
Item was removed:
- ----- Method: EventHandler>>click:fromMorph: (in category 'events') -----
- click: event fromMorph: sourceMorph
- "This message is sent only when double clicks are handled."
- ^ self
- send: clickSelector
- to: clickRecipient
- withEvent: event
- fromMorph: sourceMorph!
Item was removed:
- ----- Method: EventHandler>>convertToCurrentVersion:refStream: (in category 'objects from disk') -----
- convertToCurrentVersion: varDict refStream: smartRefStrm
-
- "20 dec 2000 - only a few (old) conversion exists"
-
- varDict at: 'mouseEnterLadenRecipient' ifPresent: [ :x | mouseEnterDraggingRecipient := x].
- varDict at: 'mouseEnterLadenSelector' ifPresent: [ :x | mouseEnterDraggingSelector := x].
- varDict at: 'mouseLeaveLadenRecipient' ifPresent: [ :x | mouseLeaveDraggingRecipient := x].
- varDict at: 'mouseLeaveLadenSelector' ifPresent: [ :x | mouseLeaveDraggingSelector := x].
- ^super convertToCurrentVersion: varDict refStream: smartRefStrm.
-
- !
Item was removed:
- ----- Method: EventHandler>>doubleClick:fromMorph: (in category 'events') -----
- doubleClick: event fromMorph: sourceMorph
- ^ self
- send: doubleClickSelector
- to: doubleClickRecipient
- withEvent: event
- fromMorph: sourceMorph!
Item was removed:
- ----- Method: EventHandler>>doubleClickTimeout:fromMorph: (in category 'events') -----
- doubleClickTimeout: event fromMorph: sourceMorph
- ^ self
- send: doubleClickTimeoutSelector
- to: doubleClickTimeoutRecipient
- withEvent: event
- fromMorph: sourceMorph!
Item was removed:
- ----- Method: EventHandler>>firstMouseSelector (in category 'access') -----
- firstMouseSelector
- "Answer the selector corresponding to the first mouse-handling selector fielded. Created in support of providing balloon-help for halo handles, triggered by the selector handled"
-
- mouseDownSelector ifNotNil: [^ mouseDownSelector].
- mouseMoveSelector ifNotNil:[^mouseMoveSelector].
- mouseStillDownSelector ifNotNil: [^ mouseStillDownSelector].
- mouseUpSelector ifNotNil: [^ mouseUpSelector].
- mouseEnterSelector ifNotNil: [^ mouseEnterSelector].
- mouseLeaveSelector ifNotNil: [^ mouseLeaveSelector].
- mouseEnterDraggingSelector ifNotNil: [^ mouseEnterDraggingSelector].
- mouseLeaveDraggingSelector ifNotNil: [^ mouseLeaveDraggingSelector].
- doubleClickSelector ifNotNil: [^ doubleClickSelector].
- ^ nil!
Item was removed:
- ----- Method: EventHandler>>fixReversedValueMessages (in category 'fixups') -----
- fixReversedValueMessages
- "ar 3/18/2001: Due to the change in the ordering of the value parameter old event handlers may have messages that need to be fixed up. Do this here."
-
- self replaceSendsIn: #( renameCharAction:sourceMorph:requestor: makeGetter:from:forPart: makeSetter:from:forPart: newMakeGetter:from:forPart: newMakeSetter:from:forPart: clickOnLine:evt:envelope: limitHandleMoveEvent:from:index: mouseUpEvent:linkMorph:formData: mouseUpEvent:linkMorph:browserAndUrl: mouseDownEvent:noteMorph:pitch: mouseMoveEvent:noteMorph:pitch: mouseUpEvent:noteMorph:pitch: dragVertex:fromHandle:vertIndex: dropVertex:fromHandle:vertIndex: newVertex:fromHandle:afterVert: prefMenu:rcvr:pref: event:arrow:upDown:
- newMakeGetter:from:forMethodInterface:)
- with: #( renameCharAction:event:sourceMorph: makeGetter:event:from: makeSetter:event:from: newMakeGetter:event:from: newMakeSetter:event:from: clickOn:evt:from: limitHandleMove:event:from: mouseUpFormData:event:linkMorph: mouseUpBrowserAndUrl:event:linkMorph: mouseDownPitch:event:noteMorph: mouseMovePitch:event:noteMorph: mouseUpPitch:event:noteMorph: dragVertex:event:fromHandle: dropVertex:event:fromHandle: newVertex:event:fromHandle: prefMenu:event:rcvr: upDown:event:arrow: makeUniversalTilesGetter:event:from:).
-
- "sw 3/28/2001 extended Andreas's original lists by one item"!
Item was removed:
- ----- Method: EventHandler>>handlesClickOrDrag: (in category 'testing') -----
- handlesClickOrDrag: evt
- clickRecipient ifNotNil:[^true].
- doubleClickRecipient ifNotNil:[^true].
- startDragRecipient ifNotNil:[^true].
- ^false!
Item was removed:
- ----- Method: EventHandler>>handlesGestureStart: (in category 'testing') -----
- handlesGestureStart: evt
- "Does the associated morph want to handle gestures?"
- ^false!
Item was removed:
- ----- Method: EventHandler>>handlesKeyboard: (in category 'testing') -----
- handlesKeyboard: evt
- keyStrokeRecipient ifNotNil: [^ true].
- ^ false!
Item was removed:
- ----- Method: EventHandler>>handlesMouseDown: (in category 'testing') -----
- handlesMouseDown: evt
- mouseDownRecipient ifNotNil: [^ true].
- mouseStillDownRecipient ifNotNil: [^ true].
- mouseUpRecipient ifNotNil: [^ true].
- (self handlesClickOrDrag: evt) ifTrue:[^true].
- ^self handlesGestureStart: evt!
Item was removed:
- ----- Method: EventHandler>>handlesMouseMove: (in category 'testing') -----
- handlesMouseMove: evt
-
- ^ self wantsEveryMouseMove == true
- or: [((((mouseMoveRecipient notNil and: [mouseMoveSelector notNil])
- and: [evt hand hasSubmorphs not])
- and: [evt anyButtonPressed])
- and: [evt hand mouseFocus notNil])
- and: [evt hand mouseFocus eventHandler == self]]!
Item was removed:
- ----- Method: EventHandler>>handlesMouseOver: (in category 'testing') -----
- handlesMouseOver: evt
- mouseEnterRecipient ifNotNil: [^ true].
- mouseLeaveRecipient ifNotNil: [^ true].
- ^ false!
Item was removed:
- ----- Method: EventHandler>>handlesMouseOverDragging: (in category 'testing') -----
- handlesMouseOverDragging: evt
- mouseEnterDraggingRecipient ifNotNil: [^ true].
- mouseLeaveDraggingRecipient ifNotNil: [^ true].
- ^ false!
Item was removed:
- ----- Method: EventHandler>>handlesMouseStillDown: (in category 'testing') -----
- handlesMouseStillDown: evt
- ^mouseStillDownRecipient notNil and:[mouseStillDownSelector notNil]!
Item was removed:
- ----- Method: EventHandler>>handlesMouseWheel: (in category 'testing') -----
- handlesMouseWheel: evt
- mouseWheelRecipient ifNotNil: [^ true].
- ^ false!
Item was removed:
- ----- Method: EventHandler>>keyDown:fromMorph: (in category 'events') -----
- keyDown: event fromMorph: sourceMorph
- ^ self send: keyDownSelector to: keyDownRecipient withEvent: event fromMorph: sourceMorph!
Item was removed:
- ----- Method: EventHandler>>keyStroke:fromMorph: (in category 'events') -----
- keyStroke: event fromMorph: sourceMorph
- ^ self send: keyStrokeSelector to: keyStrokeRecipient withEvent: event fromMorph: sourceMorph!
Item was removed:
- ----- Method: EventHandler>>keyUp:fromMorph: (in category 'events') -----
- keyUp: event fromMorph: sourceMorph
- ^ self send: keyUpSelector to: keyUpRecipient withEvent: event fromMorph: sourceMorph!
Item was removed:
- ----- Method: EventHandler>>keyboardFocusChange:fromMorph: (in category 'events') -----
- keyboardFocusChange: aBoolean fromMorph: sourceMorph
-
- ^ self
- send: keyboardFocusChangeSelector
- to: keyboardFocusChangeRecipient
- withEvent: aBoolean
- fromMorph: sourceMorph!
Item was removed:
- ----- Method: EventHandler>>messageList (in category 'access') -----
- messageList
- "Return a list of 'Class selector' for each message I can send. tk
- 9/13/97"
- | list |
- self flag: #mref.
- "is this still needed? I replaced the one use that I could spot with
- #methodRefList "
- list := OrderedCollection new.
- mouseDownRecipient
- ifNotNil: [list add: (mouseDownRecipient class whichClassIncludesSelector: mouseDownSelector) name , ' ' , mouseDownSelector].
- mouseMoveRecipient
- ifNotNil: [list add: (mouseMoveRecipient class whichClassIncludesSelector: mouseMoveSelector) name , ' ' , mouseMoveSelector].
- mouseStillDownRecipient
- ifNotNil: [list add: (mouseStillDownRecipient class whichClassIncludesSelector: mouseStillDownSelector) name , ' ' , mouseStillDownSelector].
- mouseUpRecipient
- ifNotNil: [list add: (mouseUpRecipient class whichClassIncludesSelector: mouseUpSelector) name , ' ' , mouseUpSelector].
- mouseEnterRecipient
- ifNotNil: [list add: (mouseEnterRecipient class whichClassIncludesSelector: mouseEnterSelector) name , ' ' , mouseEnterSelector].
- mouseLeaveRecipient
- ifNotNil: [list add: (mouseLeaveRecipient class whichClassIncludesSelector: mouseLeaveSelector) name , ' ' , mouseLeaveSelector].
- mouseEnterDraggingRecipient
- ifNotNil: [list add: (mouseEnterDraggingRecipient class whichClassIncludesSelector: mouseEnterDraggingSelector) name , ' ' , mouseEnterDraggingSelector].
- mouseLeaveDraggingRecipient
- ifNotNil: [list add: (mouseLeaveDraggingRecipient class whichClassIncludesSelector: mouseLeaveDraggingSelector) name , ' ' , mouseLeaveDraggingSelector].
- doubleClickRecipient
- ifNotNil: [list add: (doubleClickRecipient class whichClassIncludesSelector: doubleClickSelector) name , ' ' , doubleClickSelector].
- keyStrokeRecipient
- ifNotNil: [list add: (keyStrokeRecipient class whichClassIncludesSelector: keyStrokeSelector) name , ' ' , keyStrokeSelector].
- ^ list sort!
Item was removed:
- ----- Method: EventHandler>>methodRefList (in category 'access') -----
- methodRefList
- "Return a MethodReference for each message I can send. tk 9/13/97, raa
- 5/29/01 "
- | list adder |
- list := OrderedCollection new.
- adder := [:recip :sel | recip
- ifNotNil: [list
- add: (MethodReference new
- class: (recip class whichClassIncludesSelector: sel)
- selector: sel)]].
- adder value: mouseDownRecipient value: mouseDownSelector.
- adder value: mouseMoveRecipient value: mouseMoveSelector.
- adder value: mouseStillDownRecipient value: mouseStillDownSelector.
- adder value: mouseUpRecipient value: mouseUpSelector.
- adder value: mouseEnterRecipient value: mouseEnterSelector.
- adder value: mouseLeaveRecipient value: mouseLeaveSelector.
- adder value: mouseEnterDraggingRecipient value: mouseEnterDraggingSelector.
- adder value: mouseLeaveDraggingRecipient value: mouseLeaveDraggingSelector.
- adder value: doubleClickRecipient value: doubleClickSelector.
- adder value: keyStrokeRecipient value: keyStrokeSelector.
- ^ list sort!
Item was removed:
- ----- Method: EventHandler>>mouseDown:fromMorph: (in category 'events') -----
- mouseDown: event fromMorph: sourceMorph
- "Take double-clicks into account."
- ((self handlesClickOrDrag: event) and:[event redButtonPressed]) ifTrue:[
- event hand waitForClicksOrDrag: sourceMorph event: event.
- ].
- ^self
- send: mouseDownSelector
- to: mouseDownRecipient
- withEvent: event
- fromMorph: sourceMorph.
- !
Item was removed:
- ----- Method: EventHandler>>mouseDownSelector (in category 'access') -----
- mouseDownSelector
- ^ mouseDownSelector!
Item was removed:
- ----- Method: EventHandler>>mouseEnter:fromMorph: (in category 'events') -----
- mouseEnter: event fromMorph: sourceMorph
- ^ self send: mouseEnterSelector to: mouseEnterRecipient withEvent: event fromMorph: sourceMorph!
Item was removed:
- ----- Method: EventHandler>>mouseEnterDragging:fromMorph: (in category 'events') -----
- mouseEnterDragging: event fromMorph: sourceMorph
- ^ self send: mouseEnterDraggingSelector to: mouseEnterDraggingRecipient withEvent: event fromMorph: sourceMorph!
Item was removed:
- ----- Method: EventHandler>>mouseLeave:fromMorph: (in category 'events') -----
- mouseLeave: event fromMorph: sourceMorph
- ^ self send: mouseLeaveSelector to: mouseLeaveRecipient withEvent: event fromMorph: sourceMorph!
Item was removed:
- ----- Method: EventHandler>>mouseLeaveDragging:fromMorph: (in category 'events') -----
- mouseLeaveDragging: event fromMorph: sourceMorph
- ^ self send: mouseLeaveDraggingSelector to: mouseLeaveDraggingRecipient withEvent: event fromMorph: sourceMorph!
Item was removed:
- ----- Method: EventHandler>>mouseMove:fromMorph: (in category 'events') -----
- mouseMove: event fromMorph: sourceMorph
- ^ self send: mouseMoveSelector to: mouseMoveRecipient withEvent: event fromMorph: sourceMorph!
Item was removed:
- ----- Method: EventHandler>>mouseStillDown:fromMorph: (in category 'events') -----
- mouseStillDown: event fromMorph: sourceMorph
- ^ self send: mouseStillDownSelector to: mouseStillDownRecipient withEvent: event fromMorph: sourceMorph!
Item was removed:
- ----- Method: EventHandler>>mouseStillDownRecipient (in category 'access') -----
- mouseStillDownRecipient
- ^mouseStillDownRecipient!
Item was removed:
- ----- Method: EventHandler>>mouseStillDownSelector (in category 'access') -----
- mouseStillDownSelector
- ^mouseStillDownSelector!
Item was removed:
- ----- Method: EventHandler>>mouseUp:fromMorph: (in category 'events') -----
- mouseUp: event fromMorph: sourceMorph
- ^ self send: mouseUpSelector to: mouseUpRecipient withEvent: event fromMorph: sourceMorph!
Item was removed:
- ----- Method: EventHandler>>mouseUpSelector (in category 'access') -----
- mouseUpSelector
- ^ mouseUpSelector!
Item was removed:
- ----- Method: EventHandler>>mouseWheel:fromMorph: (in category 'events') -----
- mouseWheel: event fromMorph: sourceMorph
- ^ self
- send: mouseWheelSelector
- to: mouseWheelRecipient
- withEvent: event
- fromMorph: sourceMorph!
Item was removed:
- ----- Method: EventHandler>>on:send:to: (in category 'initialization') -----
- on: eventName send: selector to: recipient
- eventName == #mouseDown ifTrue:
- [mouseDownRecipient := recipient. mouseDownSelector := selector. ^ self].
- eventName == #mouseMove ifTrue:
- [mouseMoveRecipient := recipient. mouseMoveSelector := selector. ^ self].
- eventName == #mouseStillDown ifTrue:
- [mouseStillDownRecipient := recipient. mouseStillDownSelector := selector. ^ self].
- eventName == #mouseUp ifTrue:
- [mouseUpRecipient := recipient. mouseUpSelector := selector. ^ self].
- eventName == #mouseEnter ifTrue:
- [mouseEnterRecipient := recipient. mouseEnterSelector := selector. ^ self].
- eventName == #mouseLeave ifTrue:
- [mouseLeaveRecipient := recipient. mouseLeaveSelector := selector. ^ self].
- eventName == #mouseEnterDragging ifTrue:
- [mouseEnterDraggingRecipient := recipient. mouseEnterDraggingSelector := selector. ^ self].
- eventName == #mouseLeaveDragging ifTrue:
- [mouseLeaveDraggingRecipient := recipient. mouseLeaveDraggingSelector := selector. ^ self].
- eventName == #click ifTrue:
- [clickRecipient := recipient. clickSelector := selector. ^ self].
- eventName == #doubleClick ifTrue:
- [doubleClickRecipient := recipient. doubleClickSelector := selector. ^ self].
- eventName == #doubleClickTimeout ifTrue:
- [doubleClickTimeoutRecipient := recipient. doubleClickTimeoutSelector := selector. ^ self].
- eventName == #startDrag ifTrue:
- [startDragRecipient := recipient. startDragSelector := selector. ^ self].
- eventName == #mouseWheel ifTrue:
- [mouseWheelRecipient := recipient. mouseWheelSelector := selector. ^ self].
- eventName == #keyStroke ifTrue:
- [keyStrokeRecipient := recipient. keyStrokeSelector := selector. ^ self].
- eventName == #keyUp ifTrue:
- [keyUpRecipient := recipient. keyUpSelector := selector. ^ self].
- eventName == #keyDown ifTrue:
- [keyDownRecipient := recipient. keyDownSelector := selector. ^ self].
- eventName == #keyboardFocusChange ifTrue:
- [keyboardFocusChangeRecipient := recipient. keyboardFocusChangeSelector := selector. ^ self].
- eventName == #gesture ifTrue:
- [ ^self onGestureSend: selector to: recipient ].
- self error: 'Event name, ' , eventName , ' is not recognizable.'
- !
Item was removed:
- ----- Method: EventHandler>>on:send:to:withValue: (in category 'initialization') -----
- on: eventName send: selector to: recipient withValue: value
- selector numArgs = 3 ifFalse:
- [self halt: 'Warning: value parameters are passed as first of 3 arguments'].
- self on: eventName send: selector to: recipient.
- valueParameter := value
- !
Item was removed:
- ----- Method: EventHandler>>onGestureSend:to: (in category 'initialization') -----
- onGestureSend: selector to: recipient!
Item was removed:
- ----- Method: EventHandler>>printOn: (in category 'printing') -----
- printOn: aStream
- | recipients |
- super printOn: aStream.
- #('mouseDownSelector' 'mouseStillDownSelector' 'mouseUpSelector' 'mouseEnterSelector' 'mouseLeaveSelector' 'mouseEnterDraggingSelector' 'mouseLeaveDraggingSelector' 'mouseWheelSelector' 'doubleClickSelector' 'keyStrokeSelector' 'keyUpSelector' 'keyDownSelector' 'startDragSelector' 'clickSelector' 'keyboardFocusChangeSelector')
- do:
- [:aName | | aVal |
- (aVal := self instVarNamed: aName) notNil
- ifTrue: [aStream nextPutAll: '; ' , aName , '=' , aVal]].
- (recipients := self allRecipients) notEmpty
- ifTrue:
- [aStream nextPutAll: ' recipients: '.
- recipients printOn: aStream]!
Item was removed:
- ----- Method: EventHandler>>replaceSendsIn:with: (in category 'fixups') -----
- replaceSendsIn: array1 with: array2
- "Replace all the sends that occur in array1 with those in array2. Used for fixing old event handlers in files."
- | old index |
- 1 to: self class instSize do:[:i|
- old := self instVarAt: i.
- index := array1 identityIndexOf: old.
- index > 0 ifTrue:[self instVarAt: i put: (array2 at: index)]].!
Item was removed:
- ----- Method: EventHandler>>send:to:withEvent:fromMorph: (in category 'events') -----
- send: selector to: recipient withEvent: event fromMorph: sourceMorph
- | arity |
- recipient ifNil: [^ self].
- arity := selector numArgs.
- arity = 0 ifTrue:
- [^ recipient perform: selector].
- arity = 1 ifTrue:
- [^ recipient perform: selector with: event].
- arity = 2 ifTrue:
- [^ recipient perform: selector with: event with: sourceMorph].
- arity = 3 ifTrue:
- [^ recipient perform: selector with: valueParameter with: event with: sourceMorph].
- self error: 'Event handling selectors must be Symbols and take 0-3 arguments'!
Item was removed:
- ----- Method: EventHandler>>startDrag:fromMorph: (in category 'events') -----
- startDrag: event fromMorph: sourceMorph
- ^ self
- send: startDragSelector
- to: startDragRecipient
- withEvent: event
- fromMorph: sourceMorph!
Item was removed:
- ----- Method: EventHandler>>veryDeepFixupWith: (in category 'copying') -----
- veryDeepFixupWith: deepCopier
- | old |
- "ALL inst vars were weakly copied. If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"
-
- super veryDeepFixupWith: deepCopier.
- 1 to: self class instSize do:
- [:ii | old := self instVarAt: ii.
- self instVarAt: ii put: (deepCopier references at: old ifAbsent: [old])].
-
- !
Item was removed:
- ----- Method: EventHandler>>veryDeepInner: (in category 'copying') -----
- veryDeepInner: deepCopier
- "ALL fields are weakly copied!! Can't duplicate an object by duplicating a button that activates it. See DeepCopier."
-
- super veryDeepInner: deepCopier.
- "just keep old pointers to all fields"
- !
Item was removed:
- ----- Method: EventHandler>>wantsEveryMouseMove (in category 'access') -----
- wantsEveryMouseMove
-
- ^ wantsEveryMouseMove!
Item was removed:
- ----- Method: EventHandler>>wantsEveryMouseMove: (in category 'access') -----
- wantsEveryMouseMove: aBoolean
-
- wantsEveryMouseMove := aBoolean.!
Item was removed:
- ListItemWrapper subclass: #FileDirectoryWrapper
- instanceVariableNames: 'itemName balloonText hasContents'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Explorer'!
Item was removed:
- ----- Method: FileDirectoryWrapper class>>with:name:model: (in category 'instance creation') -----
- with: anObject name: aString model: aModel
-
- ^self new
- setItem: anObject name: aString model: aModel!
Item was removed:
- ----- Method: FileDirectoryWrapper>>asString (in category 'converting') -----
- asString
- ^itemName translatedIfCorresponds!
Item was removed:
- ----- Method: FileDirectoryWrapper>>balloonText (in category 'accessing') -----
- balloonText
-
- ^balloonText!
Item was removed:
- ----- Method: FileDirectoryWrapper>>balloonText: (in category 'accessing') -----
- balloonText: aStringOrNil
-
- balloonText := aStringOrNil!
Item was removed:
- ----- Method: FileDirectoryWrapper>>contents (in category 'accessing') -----
- contents
-
- ^((model directoryNamesFor: item) sorted: [ :a :b | a caseInsensitiveLessOrEqual: b]) collect: [ :n |
- FileDirectoryWrapper with: (item directoryNamed: n) name: n model: self
- ]
- !
Item was removed:
- ----- Method: FileDirectoryWrapper>>directoryNamesFor: (in category 'private') -----
- directoryNamesFor: anItem
- ^model directoryNamesFor: anItem!
Item was removed:
- ----- Method: FileDirectoryWrapper>>hasContents (in category 'accessing') -----
- hasContents
- "Return whether this directory has subfolders. The value is cached to
- avoid a performance penalty. Also for performance reasons, the code
- below will just assume that the directory does indeed have contents in a
- few of cases:
- 1. If the item is not a FileDirectory (thus avoiding the cost
- of refreshing directories that are not local)
- 2. If it's the root directory of a given volume
- 3. If there is an error computing the FileDirectory's contents
- "
- hasContents
- ifNil: [hasContents := true. "default"
- ["Best test I could think of for determining if this is a local directory "
- ((item isKindOf: FileDirectory)
- and: ["test to see that it's not the root directory"
- "there has to be a better way of doing this test -tpr"
- item pathParts size > 1])
- ifTrue: [hasContents := self contents notEmpty]]
- on: Error
- do: [hasContents := true]].
- ^ hasContents!
Item was removed:
- ----- Method: FileDirectoryWrapper>>icon (in category 'accessing') -----
- icon
- "Answer a form to be used as icon"
- ^ item isRemoteDirectory
- ifTrue: [MenuIcons smallRemoteOpenIcon]
- ifFalse: [MenuIcons smallOpenIcon]!
Item was removed:
- ----- Method: FileDirectoryWrapper>>setItem:name:model: (in category 'initialization') -----
- setItem: anObject name: aString model: aModel
-
- item := anObject.
- model := aModel.
- itemName := aString.
- hasContents := nil.
- !
Item was removed:
- ----- Method: FileDirectoryWrapper>>settingSelector (in category 'private') -----
- settingSelector
-
- ^#setSelectedDirectoryTo:!
Item was removed:
- DialogWindow subclass: #FillInTheBlankMorph
- instanceVariableNames: 'response done textPane responseUponCancel'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
Item was removed:
- ----- Method: FillInTheBlankMorph class>>defaultAnswerExtent (in category 'default constants') -----
- defaultAnswerExtent
- ^ ((TextStyle defaultFont widthOf: $x) * 30) @ (3 * TextStyle defaultFont height)!
Item was removed:
- ----- Method: FillInTheBlankMorph class>>request: (in category 'instance creation') -----
- request: queryString
- "Create an instance of me whose question is queryString. Invoke it centered at the cursor, and answer the string the user accepts. Answer the empty string if the user cancels."
- "FillInTheBlankMorph request: 'What is your favorite color?'"
-
- ^ self
- request: queryString
- initialAnswer: ''
- centerAt: (self currentHand ifNil: [Sensor]) cursorPoint!
Item was removed:
- ----- Method: FillInTheBlankMorph class>>request:initialAnswer: (in category 'instance creation') -----
- request: queryString initialAnswer: defaultAnswer
- "Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. Answer the empty string if the user cancels."
- "FillInTheBlankMorph
- request: 'What is your favorite color?'
- initialAnswer: 'red, no blue. Ahhh!!'"
-
- ^ self
- request: queryString
- initialAnswer: defaultAnswer
- centerAt: (self currentHand ifNil: [Sensor]) cursorPoint!
Item was removed:
- ----- Method: FillInTheBlankMorph class>>request:initialAnswer:centerAt: (in category 'instance creation') -----
- request: queryString initialAnswer: defaultAnswer centerAt: aPoint
- "Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. Answer the empty string if the user cancels.
- This variant is only for calling from within a Morphic project."
- "FillInTheBlankMorph
- request: 'Type something, then type CR.'
- initialAnswer: 'yo ho ho!!'
- centerAt: Display center"
-
- ^ self
- request: queryString
- initialAnswer: defaultAnswer
- centerAt: aPoint
- inWorld: self currentWorld!
Item was removed:
- ----- Method: FillInTheBlankMorph class>>request:initialAnswer:centerAt:inWorld: (in category 'instance creation') -----
- request: queryString initialAnswer: defaultAnswer centerAt: aPoint inWorld: aWorld
- "Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. Answer the empty string if the user cancels."
- "FillInTheBlankMorph
- request: 'Type something, then type CR.'
- initialAnswer: 'yo ho ho!!'
- centerAt: Display center"
-
- ^ self request: queryString initialAnswer: defaultAnswer centerAt: aPoint inWorld: aWorld onCancelReturn: ''!
Item was removed:
- ----- Method: FillInTheBlankMorph class>>request:initialAnswer:centerAt:inWorld:onCancelReturn: (in category 'instance creation') -----
- request: queryString initialAnswer: defaultAnswer centerAt: aPoint inWorld: aWorld onCancelReturn: returnOnCancel
- "Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. If the user cancels, answer returnOnCancel. If user hits cr, treat it as a normal accept."
-
- "FillInTheBlankMorph
- request: 'Type something, then type CR.'
- initialAnswer: 'yo ho ho!!'
- centerAt: Display center"
-
- ^ self request: queryString initialAnswer: defaultAnswer centerAt: aPoint inWorld: aWorld onCancelReturn: returnOnCancel acceptOnCR: true!
Item was removed:
- ----- Method: FillInTheBlankMorph class>>request:initialAnswer:centerAt:inWorld:onCancelReturn:acceptOnCR: (in category 'instance creation') -----
- request: queryString initialAnswer: defaultAnswer centerAt: aPoint inWorld: aWorld onCancelReturn: returnOnCancel acceptOnCR: acceptBoolean
- "Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. If the user cancels, answer returnOnCancel."
-
- ^ self request: queryString initialAnswer: defaultAnswer centerAt: aPoint
- inWorld: aWorld onCancelReturn: returnOnCancel
- acceptOnCR: acceptBoolean answerExtent: self defaultAnswerExtent!
Item was removed:
- ----- Method: FillInTheBlankMorph class>>request:initialAnswer:centerAt:inWorld:onCancelReturn:acceptOnCR:answerExtent: (in category 'instance creation') -----
- request: queryString initialAnswer: defaultAnswer centerAt: aPoint inWorld: aWorld onCancelReturn: returnOnCancel acceptOnCR: acceptBoolean answerExtent: answerExtent
- "Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. If the user cancels, answer returnOnCancel."
- "FillInTheBlankMorph
- request: 'Type something, then type CR.'
- initialAnswer: 'yo ho ho!!'
- centerAt: Display center"
-
- | aFillInTheBlankMorph |
- aFillInTheBlankMorph := self new
- setQuery: queryString
- initialAnswer: defaultAnswer
- answerExtent: answerExtent
- acceptOnCR: acceptBoolean.
-
- aFillInTheBlankMorph createAcceptButton
- action: [aFillInTheBlankMorph textPane accept].
- aFillInTheBlankMorph createCancelButton
- action: [aFillInTheBlankMorph closeDialog: returnOnCancel].
-
- aFillInTheBlankMorph preferredPosition: aPoint.
- ^ aFillInTheBlankMorph getUserResponse
- !
Item was removed:
- ----- Method: FillInTheBlankMorph class>>request:initialAnswer:centerAt:inWorld:onCancelReturn:acceptOnCR:answerHeight: (in category 'instance creation') -----
- request: queryString initialAnswer: defaultAnswer centerAt: aPoint inWorld: aWorld onCancelReturn: returnOnCancel acceptOnCR: acceptBoolean answerHeight: answerHeight
- "Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. If the user cancels, answer returnOnCancel."
- ^ self request: queryString initialAnswer: defaultAnswer centerAt: aPoint
- inWorld: aWorld onCancelReturn: returnOnCancel acceptOnCR: acceptBoolean
- answerExtent: self defaultAnswerExtent x @ answerHeight!
Item was removed:
- ----- Method: FillInTheBlankMorph class>>requestPassword: (in category 'instance creation') -----
- requestPassword: queryString
- "Create an instance of me whose question is queryString. Invoke it centered at the cursor, and answer the string the user accepts. Answer the empty string if the user cancels."
- "use password font"
- "FillInTheBlankMorph requestPassword: 'Password?'"
-
- ^ self
- requestPassword: queryString
- initialAnswer: ''
- centerAt: Sensor cursorPoint
- inWorld: Project current world
- onCancelReturn: ''
- acceptOnCR: true
- !
Item was removed:
- ----- Method: FillInTheBlankMorph class>>requestPassword:initialAnswer:centerAt:inWorld:onCancelReturn:acceptOnCR: (in category 'instance creation') -----
- requestPassword: queryString initialAnswer: defaultAnswer centerAt: aPoint inWorld: aWorld onCancelReturn: returnOnCancel acceptOnCR: acceptBoolean
- "Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. If the user cancels, answer returnOnCancel."
- "FillInTheBlankMorph
- request: 'Type something, then type CR.'
- initialAnswer: 'yo ho ho!!'
- centerAt: Display center"
-
- | aFillInTheBlankMorph |
- aFillInTheBlankMorph := self new
- setPasswordQuery: queryString
- initialAnswer: defaultAnswer
- answerHeight: 50
- acceptOnCR: acceptBoolean.
-
- aFillInTheBlankMorph createAcceptButton
- action: [aFillInTheBlankMorph textPane accept].
- aFillInTheBlankMorph createCancelButton
- action: [aFillInTheBlankMorph closeDialog: returnOnCancel].
-
- aFillInTheBlankMorph preferredPosition: aPoint.
- ^ aFillInTheBlankMorph getUserResponse!
Item was removed:
- ----- Method: FillInTheBlankMorph>>codePaneMenu:shifted: (in category 'menu') -----
- codePaneMenu: aMenu shifted: shifted
-
- ^ StringHolder codePaneMenu: aMenu shifted: shifted.
- !
Item was removed:
- ----- Method: FillInTheBlankMorph>>createTextPaneAcceptOnCR: (in category 'initialization') -----
- createTextPaneAcceptOnCR: acceptBoolean
-
- textPane := PluggableTextMorph
- on: self
- text: #response
- accept: #response:
- readSelection: #selectionInterval
- menu: #codePaneMenu:shifted:.
- textPane
- plainTextOnly: true;
- hScrollBarPolicy: ((acceptBoolean or: (Preferences alwaysHideHScrollbar))
- ifTrue: [#never] ifFalse: [#whenNeeded]);
- vScrollBarPolicy: #whenNeeded;
- wantsFrameAdornments: false;
- hasUnacceptedEdits: true;
- askBeforeDiscardingEdits: false;
- setProperty: #alwaysAccept toValue: true;
- acceptOnCR: acceptBoolean;
- setNameTo: 'textPane';
- layoutFrame: (LayoutFrame fractions: (0 at 0 corner: 1 at 1));
- hResizing: #spaceFill;
- vResizing: #spaceFill;
- scrollToTop.
- ^ textPane!
Item was removed:
- ----- Method: FillInTheBlankMorph>>defaultFocusMorph (in category 'accessing') -----
- defaultFocusMorph
-
- ^ self textPane!
Item was removed:
- ----- Method: FillInTheBlankMorph>>filterEvent:for: (in category 'events') -----
- filterEvent: event for: morph
-
- (event isKeystroke and: [event keyCharacter = Character escape])
- ifTrue: [event ignore. self cancelDialog].
-
- ^ event!
Item was removed:
- ----- Method: FillInTheBlankMorph>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
- self addKeyboardCaptureFilter: self.!
Item was removed:
- ----- Method: FillInTheBlankMorph>>response (in category 'accessing') -----
- response
-
- ^ result
- !
Item was removed:
- ----- Method: FillInTheBlankMorph>>response: (in category 'accessing') -----
- response: aText
- "Sent when text pane accepts."
-
- result := aText asString.
- self delete.
- !
Item was removed:
- ----- Method: FillInTheBlankMorph>>selectionInterval (in category 'accessing') -----
- selectionInterval
- ^ 1 to: result size
- !
Item was removed:
- ----- Method: FillInTheBlankMorph>>setDefaultParameters (in category 'initialization') -----
- setDefaultParameters
-
- super setDefaultParameters.
- textPane ifNotNil: [:tp | tp borderColor: self borderColor].!
Item was removed:
- ----- Method: FillInTheBlankMorph>>setPasswordQuery:initialAnswer:answerHeight:acceptOnCR: (in category 'initialization') -----
- setPasswordQuery: queryString initialAnswer: initialAnswer answerHeight: answerHeight acceptOnCR: acceptBoolean
-
- self setQuery: queryString
- initialAnswer: initialAnswer
- answerHeight: answerHeight
- acceptOnCR: acceptBoolean.
- textPane font: StrikeFont passwordFont.!
Item was removed:
- ----- Method: FillInTheBlankMorph>>setQuery:initialAnswer:answerExtent:acceptOnCR: (in category 'initialization') -----
- setQuery: queryString initialAnswer: initialAnswer answerExtent: answerExtent acceptOnCR: acceptBoolean
-
- | text textFont preferredLineCount preferredCharCount preferredExtent |
-
- result := initialAnswer asString. "plain text only; see #createTextPaneAcceptOnCR:"
- done := false.
-
- self paneMorph removeAllMorphs.
-
- self title: 'Input Requested' translated.
- self message: queryString.
-
- preferredLineCount := (result lineCount
- min: 10 "Both one-liner and multi-liner show this max. lines before scrolling"
- max: (acceptBoolean ifTrue: [1 "one-liner"] ifFalse: [3 "multi-liner"])).
- preferredCharCount := 0.
- result lineIndicesDo: [:start :end :endCR |
- preferredCharCount := preferredCharCount max: end-start].
- preferredCharCount := preferredCharCount
- min: 75 "Optimized for bigger multi-line input request"
- max: 30 "Optimized for a small search field".
-
- textFont := TextStyle defaultFont.
- preferredExtent := (textFont widthOf: $x) * preferredCharCount
- @ (ToolBuilder default inputFieldHeightFor: preferredLineCount).
-
- text := self createTextPaneAcceptOnCR: acceptBoolean.
- self paneMorph addMorphBack: text.
-
- self paneMorph
- wantsPaneSplitters: true;
- cellGap: ProportionalSplitterMorph gripThickness.
-
- acceptBoolean ifFalse: [
- self paneMorph
- addCornerGrips;
- layoutInset: ProportionalSplitterMorph gripThickness.
- self paneMorph grips do: [:ea | ea showHandle: true]].
-
- self paneMorph layoutExtent: preferredExtent.
- self setDefaultParameters.!
Item was removed:
- ----- Method: FillInTheBlankMorph>>setQuery:initialAnswer:answerHeight:acceptOnCR: (in category 'initialization') -----
- setQuery: queryString initialAnswer: initialAnswer answerHeight: answerHeight acceptOnCR: acceptBoolean
- self setQuery: queryString initialAnswer: initialAnswer
- answerExtent: (self class defaultAnswerExtent x @ answerHeight)
- acceptOnCR: acceptBoolean
- !
Item was removed:
- ----- Method: FillInTheBlankMorph>>textPane (in category 'accessing') -----
- textPane
- ^ textPane!
Item was removed:
- NullEncoder subclass: #FlattenEncoder
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Support'!
-
- !FlattenEncoder commentStamp: '<historical>' prior: 0!
- The simplest possible encoding: leave the objects as is.
- !
Item was removed:
- ----- Method: FlattenEncoder class>>filterSelector (in category 'configuring') -----
- filterSelector
- ^#flattenOnStream:
- !
Item was removed:
- ----- Method: FlattenEncoder>>cr (in category 'writing') -----
- cr
- ^self print:String cr.
-
- !
Item was removed:
- ----- Method: FlattenEncoder>>elementSeparator (in category 'filter streaming') -----
- elementSeparator
- ^target elementSeparator.!
Item was removed:
- ----- Method: FlattenEncoder>>writeArrayedCollection: (in category 'writing') -----
- writeArrayedCollection:anArrayedCollection
- ^self writeCollectionContents:anArrayedCollection.
-
- !
Item was removed:
- ----- Method: FlattenEncoder>>writeCollection: (in category 'writing') -----
- writeCollection:aCollection
- ^self writeCollectionContents:aCollection.
-
- !
Item was removed:
- ----- Method: FlattenEncoder>>writeCollectionContents: (in category 'writing') -----
- writeCollectionContents:aCollection
- ^self writeCollectionContents:aCollection separator:self elementSeparator iterationMessage:#do:.
-
- !
Item was removed:
- ----- Method: FlattenEncoder>>writeCollectionContents:separator: (in category 'writing') -----
- writeCollectionContents:aCollection separator:separator
- ^self writeCollectionContents:aCollection separator:separator iterationMessage:#do:.!
Item was removed:
- ----- Method: FlattenEncoder>>writeCollectionContents:separator:iterationMessage: (in category 'writing') -----
- writeCollectionContents:aCollection separator:separator iterationMessage:op
- | first |
- first := true.
- aCollection perform:op with: [ :each | first ifFalse:[ self writeObject:separator ]. self write:each. first:=false.].
- !
Item was removed:
- ----- Method: FlattenEncoder>>writeDictionary: (in category 'writing') -----
- writeDictionary:aCollection
- ^self writeDictionaryContents:aCollection separator:nil.
-
- !
Item was removed:
- ----- Method: FlattenEncoder>>writeDictionaryContents:separator: (in category 'writing') -----
- writeDictionaryContents:aCollection separator:separator
- ^self writeCollectionContents:aCollection separator:separator iterationMessage:#associationsDo:.!
Item was removed:
- ----- Method: Float>>hasContentsInExplorer (in category '*Morphic-Explorer') -----
- hasContentsInExplorer
-
- ^false!
Item was removed:
- Model subclass: #FontChooserTool
- instanceVariableNames: 'title selectedFontIndex fontList target getSelector setSelector pointSize emphasis window result offerStyleList'
- classVariableNames: 'Default'
- poolDictionaries: ''
- category: 'Morphic-Support'!
-
- !FontChooserTool commentStamp: 'ar 8/30/2009 14:28' prior: 0!
- A ToolBuilder version of FreeTypePlus' FontChooser[Morph].!
Item was removed:
- ----- Method: FontChooserTool class>>default (in category 'accessing') -----
- default
- "Answer the default font chooser tool"
- ^Default ifNil:[self]!
Item was removed:
- ----- Method: FontChooserTool class>>default: (in category 'accessing') -----
- default: aFontChooser
- "Answer the default font chooser tool"
- Default := aFontChooser!
Item was removed:
- ----- Method: FontChooserTool class>>open (in category 'opening') -----
- open
- "
- FontChooserTool open.
- "
- ^self new open!
Item was removed:
- ----- Method: FontChooserTool class>>openWithWindowTitle:for:setSelector:getSelector: (in category 'opening') -----
- openWithWindowTitle: titleString for: anObject setSelector: setSelector getSelector: getSelector
- "
- FontChooserTool
- openWithWindowTitle: 'Choose the Menu Font'
- for: Preferences
- setSelector: #setMenuFontTo:
- getSelector: #standardMenuFont.
- "
- ^(self withTitle: titleString for: anObject setSelector: setSelector getSelector: getSelector) open!
Item was removed:
- ----- Method: FontChooserTool class>>windowTitle:for:setSelector:getSelector: (in category 'opening') -----
- windowTitle: titleString for: anObject setSelector: setSelector getSelector: getSelector
- | instance |
-
- instance := self new.
- instance
- title: titleString;
- target: anObject;
- setSelector: setSelector;
- getSelector: getSelector.
- ^instance open!
Item was removed:
- ----- Method: FontChooserTool class>>withTitle:for:setSelector:getSelector: (in category 'opening') -----
- withTitle: titleString for: anObject setSelector: setSelector getSelector: getSelector
- "
- (FontChooserTool
- withTitle: 'Choose the Menu Font'
- for: Preferences
- setSelector: #setMenuFontTo:
- getSelector: #standardMenuFont) open.
- "
- | instance |
- instance := self new.
- instance
- title: titleString;
- target: anObject;
- setSelector: setSelector;
- getSelector: getSelector.
- ^instance!
Item was removed:
- ----- Method: FontChooserTool>>accept (in category 'actions') -----
- accept
- self apply.
- result := self selectedFont.
- ToolBuilder default close: window.!
Item was removed:
- ----- Method: FontChooserTool>>apply (in category 'actions') -----
- apply
- | font |
- target ifNotNil:[
- setSelector ifNotNil:[
- font := self selectedFont.
- font ifNotNil:[
- target perform: setSelector with: font]]].!
Item was removed:
- ----- Method: FontChooserTool>>buildButtonBarWith: (in category 'toolbuilder') -----
- buildButtonBarWith: builder
- "Build the button bar"
- | panelSpec buttonSpec |
- panelSpec := builder pluggablePanelSpec new.
- panelSpec
- layout: #horizontal;
- children: OrderedCollection new.
-
- buttonSpec := builder pluggableButtonSpec new.
- buttonSpec
- model: self;
- label: 'Apply' translated;
- action: #apply.
- panelSpec children addLast: buttonSpec.
-
- panelSpec children addLast: (builder pluggableSpacerSpec new extent: ((TextStyle defaultFont widthOf: $m) @1)).
-
- buttonSpec := builder pluggableButtonSpec new.
- buttonSpec
- model: self;
- label: 'OK' translated;
- action: #accept.
- panelSpec children addLast: buttonSpec.
-
- buttonSpec := builder pluggableButtonSpec new.
- buttonSpec
- model: self;
- label: 'Cancel' translated;
- action: #cancel.
- panelSpec children addLast: buttonSpec.
-
- ^panelSpec!
Item was removed:
- ----- Method: FontChooserTool>>buildFontListWith: (in category 'toolbuilder') -----
- buildFontListWith: builder
- "Build the font choosers list of font names"
- | listSpec |
- listSpec := builder pluggableListSpec new.
- listSpec
- model: self;
- name: #fontList;
- list: #fontList;
- icon: #fontListIconAt:;
- getIndex: #selectedFontIndex;
- setIndex: #selectedFontIndex:.
- ^listSpec
- !
Item was removed:
- ----- Method: FontChooserTool>>buildPointSizeInputWith: (in category 'toolbuilder') -----
- buildPointSizeInputWith: builder
- "Build the font choosers list of point sizes"
- | listSpec |
- listSpec := builder pluggableInputFieldSpec new.
- listSpec
- model: self;
- plainTextOnly: true;
- getText: #pointSizeInput;
- setText: #pointSizeInput:;
- textStyle: TextStyle default copy centered;
- softLineWrap: true.
- ^listSpec
- !
Item was removed:
- ----- Method: FontChooserTool>>buildPointSizeListWith: (in category 'toolbuilder') -----
- buildPointSizeListWith: builder
- "Build the font choosers list of point sizes"
- | listSpec |
- listSpec := builder pluggableListSpec new.
- listSpec
- model: self;
- list: #pointSizeList;
- getIndex: #selectedPointSizeIndex;
- setIndex: #selectedPointSizeIndex:;
- itemAlignment: #right;
- padding: self pointSizePadding.
- ^listSpec
- !
Item was removed:
- ----- Method: FontChooserTool>>buildPreviewPaneWith: (in category 'toolbuilder') -----
- buildPreviewPaneWith: builder
- "Build the preview panel"
- | textSpec |
- textSpec := builder pluggableTextSpec new.
- textSpec
- name: #preview;
- model: self;
- getText: #contents;
- textStyle: #selectedFontTextStyle;
- softLineWrap: false.
- ^textSpec!
Item was removed:
- ----- Method: FontChooserTool>>buildStyleListWith: (in category 'toolbuilder') -----
- buildStyleListWith: builder
- "Build the font choosers list of font styles"
- | listSpec |
- listSpec := builder pluggableListSpec new.
- listSpec
- model: self;
- list: #fontStyleList;
- getIndex: #selectedFontStyleIndex;
- setIndex: #selectedFontStyleIndex:.
- ^listSpec
- !
Item was removed:
- ----- Method: FontChooserTool>>buildWith: (in category 'toolbuilder') -----
- buildWith: builder
- "Create the ui for the browser"
- "ToolBuilder open: self"
- | windowSpec hDiv |
- hDiv := 0.55.
- self offerStyleList ifTrue:[
- windowSpec := self buildWindowWith: builder specs: {
- (0 at 0 corner: 0.5 at hDiv) -> [self buildFontListWith: builder].
- (0.5 at 0 corner: 0.8 at hDiv) -> [self buildStyleListWith: builder].
- (LayoutFrame fractions: (0.8 at 0 corner: 1.0 at hDiv) offsets: (0 at 0 corner: 0 @ self pointSizeInputHeight negated))
- -> [self buildPointSizeListWith: builder].
- (LayoutFrame fractions: (0.8 at hDiv corner: 1.0 at hDiv) offsets: (0 at self pointSizeInputHeight negated corner: 0 at 0))
- -> [self buildPointSizeInputWith: builder].
- (LayoutFrame fractions: (0.0 at hDiv corner: 1.0 at 1.0) offsets: (0 at 0 corner: 0 @ self buttonHeight negated))
- -> [self buildPreviewPaneWith: builder].
- (LayoutFrame fractions: (0 at 1 corner: 1 at 1) offsets: (0@ self buttonHeight negated corner: 0 at 0))
- -> [self buildButtonBarWith: builder].
- }.
- ] ifFalse:[
- windowSpec := self buildWindowWith: builder specs: {
- (0 at 0 corner: 0.7 at hDiv) -> [self buildFontListWith: builder].
- (LayoutFrame fractions: (0.7 at 0 corner: 1.0 at hDiv) offsets: (0 at 0 corner: 0 @ self pointSizeInputHeight negated))
- -> [self buildPointSizeListWith: builder].
-
- (LayoutFrame fractions: (0.7 at hDiv corner: 1.0 at hDiv) offsets: (0 at self pointSizeInputHeight negated corner: 0 at 0))
- -> [self buildPointSizeInputWith: builder].
- (LayoutFrame fractions: (0.0 at hDiv corner: 1.0 at 1.0) offsets: (0 at 0 corner: 0 @ self buttonHeight negated))
- -> [self buildPreviewPaneWith: builder].
- (LayoutFrame fractions: (0 at 1 corner: 1 at 1) offsets: (0@ self buttonHeight negated corner: 0 at 0))
- -> [self buildButtonBarWith: builder].
- }.
- ].
- windowSpec extent: self initialExtent.
- window := builder build: windowSpec.
-
- "Now that the window has been built, notify selection again to scroll it into view."
- self changed: #selectedFontIndex.
- self changed: #selectedFontStyleIndex.
- self changed: #selectedPointSizeIndex.
- ^window!
Item was removed:
- ----- Method: FontChooserTool>>buttonHeight (in category 'toolbuilder') -----
- buttonHeight
-
- ^ ToolBuilder default buttonRowHeight!
Item was removed:
- ----- Method: FontChooserTool>>cancel (in category 'actions') -----
- cancel
- result := nil.
- ToolBuilder default close: window.!
Item was removed:
- ----- Method: FontChooserTool>>contents (in category 'toolbuilder') -----
- contents
- "Note that we cannot just rely on #selectedTextStyle because there are, for example, symbol fonts out there, which require a different set of characters as a sample text."
-
- ^ self selectedFont
- ifNil: [Text new]
- ifNotNil: [:font |
- font isSymbolFont
- ifTrue: [font symbolSample]
- ifFalse: [Text textSample]]!
Item was removed:
- ----- Method: FontChooserTool>>fontList (in category 'font list') -----
- fontList
- "List of available font family names. Avoid StrikeFonts if PPI is not 96.0."
-
- fontList ifNotNil: [^ fontList].
-
- fontList := TextStyle knownTextStylesWithoutDefault.
- self getFontFromRequestor ifNotNil: [:font |
- (fontList includes: font familyName) ifFalse: [
- fontList := (fontList, {font familyName}) sorted]].
- TextStyle pixelsPerInch = 96.0 ifFalse: [
- fontList := fontList select: [:styleName |
- (TextStyle named: styleName) ifNil: [true "not yet installed"] ifNotNil: [:style | style isTTCStyle] ]].
- ^ fontList!
Item was removed:
- ----- Method: FontChooserTool>>fontListIconAt: (in category 'font list') -----
- fontListIconAt: index
-
- ^ ToolIcons iconNamed: ( ((TextStyle named: (self fontList at: index))
- ifNil: [self getFontFromRequestor ifNotNil: [:font | TextStyle fontArray: {font} "Not yet installed" ]])
- ifNil: [#blank16]
- ifNotNil: [:style | style isTTCStyle ifTrue: [#font] ifFalse: [#blank16]] )!
Item was removed:
- ----- Method: FontChooserTool>>fontStyleList (in category 'style list') -----
- fontStyleList
- "names of simulated styles are enclosed in parenthesis"
- ^#('Regular' 'Bold' 'Italic' 'Bold Italic')!
Item was removed:
- ----- Method: FontChooserTool>>getFontFromRequestor (in category 'updating') -----
- getFontFromRequestor
-
- ^ (getSelector isSymbol and:[target notNil])
- ifTrue:[target perform: getSelector]
- ifFalse:[getSelector]!
Item was removed:
- ----- Method: FontChooserTool>>getSelector (in category 'accessing') -----
- getSelector
- "Answer the value of getSelector"
-
- ^ getSelector!
Item was removed:
- ----- Method: FontChooserTool>>getSelector: (in category 'accessing') -----
- getSelector: aSelectorSymbolOrFont
- "Set the value of getSelector"
-
- getSelector := aSelectorSymbolOrFont.
- self updateFromRequestor.!
Item was removed:
- ----- Method: FontChooserTool>>initialExtent (in category 'initialize') -----
- initialExtent
-
- ^ self offerStyleList
- ifTrue:[450 at 250]
- ifFalse:[400 at 250].!
Item was removed:
- ----- Method: FontChooserTool>>initialize (in category 'initialize') -----
- initialize
- super initialize.
- title := 'Choose A Font'.
- getSelector := TextStyle defaultFont.
- emphasis := 0.
- offerStyleList := true.!
Item was removed:
- ----- Method: FontChooserTool>>offerStyleList (in category 'initialize') -----
- offerStyleList
- "Whether to offer a choice of styles with the font."
- ^offerStyleList!
Item was removed:
- ----- Method: FontChooserTool>>offerStyleList: (in category 'initialize') -----
- offerStyleList: aBool
- "Whether to offer a choice of styles with the font."
- offerStyleList := aBool!
Item was removed:
- ----- Method: FontChooserTool>>open (in category 'toolbuilder') -----
- open
- ^ToolBuilder open: self!
Item was removed:
- ----- Method: FontChooserTool>>pointSize (in category 'point size') -----
- pointSize
- ^pointSize ifNil: [pointSize := 10.0]!
Item was removed:
- ----- Method: FontChooserTool>>pointSize: (in category 'point size') -----
- pointSize: aNumber
-
- pointSize := aNumber.
-
- self changed: #selectedFontTextStyle.
- self changed: #contents.
-
- self changed: #pointSizeList.
- self changed: #selectedPointSizeIndex.
- self changed: #pointSizeInput.!
Item was removed:
- ----- Method: FontChooserTool>>pointSizeInput (in category 'point size') -----
- pointSizeInput
-
- ^ self pointSize asString!
Item was removed:
- ----- Method: FontChooserTool>>pointSizeInput: (in category 'point size') -----
- pointSizeInput: aString
-
- self pointSize: (aString asNumber roundTo: 0.5).
- self changed: #pointSizeInput.!
Item was removed:
- ----- Method: FontChooserTool>>pointSizeInputHeight (in category 'toolbuilder') -----
- pointSizeInputHeight
- ^ ToolBuilder default inputFieldHeight!
Item was removed:
- ----- Method: FontChooserTool>>pointSizeList (in category 'point size') -----
- pointSizeList
- ^self selectedTextStyle pointSizes collect: [:each | each printShowingDecimalPlaces: 1]!
Item was removed:
- ----- Method: FontChooserTool>>pointSizePadding (in category 'toolbuilder') -----
- pointSizePadding
-
- ^ 0 at 0 corner: (10 * RealEstateAgent scaleFactor) truncated @0!
Item was removed:
- ----- Method: FontChooserTool>>result (in category 'accessing') -----
- result
- ^result!
Item was removed:
- ----- Method: FontChooserTool>>selectedFont (in category 'font list') -----
- selectedFont
- "Generate missing pointSIze only if TrueType font."
-
- | style |
- ^ (style := self selectedTextStyle) isTTCStyle
- ifTrue: [ style fontArray size = 1 "Font not yet installed..."
- ifTrue: [style defaultFont]
- ifFalse: [TTCFont familyName: self selectedFontFamily pointSize: pointSize emphasized: emphasis]]
- ifFalse: [
- | font |
- font := (style fontOfPointSize: pointSize) emphasized: emphasis.
- pointSize ~= font pointSize ifTrue: [
- self inform: ('The point size you requested is not available for this pre-rendered font. Please choose a TrueType font, where you can add custom point sizes.' translated withNoLineLongerThan: 45).
- pointSize := font pointSize].
- self changed: #selectedPointSizeIndex.
- font]!
Item was removed:
- ----- Method: FontChooserTool>>selectedFontFamily (in category 'font list') -----
- selectedFontFamily
- ^self fontList at: self selectedFontIndex ifAbsent:[nil].
-
- !
Item was removed:
- ----- Method: FontChooserTool>>selectedFontIndex (in category 'font list') -----
- selectedFontIndex
-
- ^ selectedFontIndex ifNil: [0]!
Item was removed:
- ----- Method: FontChooserTool>>selectedFontIndex: (in category 'font list') -----
- selectedFontIndex: anIndex
- anIndex = 0 ifTrue: [^self].
- selectedFontIndex := anIndex.
- self changed: #selectedFontIndex.
- self changed: #selectedFontStyleIndex.
-
- self changed: #selectedFontTextStyle.
- self changed: #contents.
-
- self changed: #pointSizeList.
- self changed: #selectedPointSizeIndex.
- !
Item was removed:
- ----- Method: FontChooserTool>>selectedFontStyleIndex (in category 'style list') -----
- selectedFontStyleIndex
- "This is a hack"
- ^emphasis+1!
Item was removed:
- ----- Method: FontChooserTool>>selectedFontStyleIndex: (in category 'style list') -----
- selectedFontStyleIndex: anIndex
- anIndex = 0 ifTrue: [^self].
- emphasis := anIndex - 1.
- self changed: #selectedFontStyleIndex.
- self changed: #selectedFontTextStyle.
- self changed: #contents.!
Item was removed:
- ----- Method: FontChooserTool>>selectedFontTextStyle (in category 'font list') -----
- selectedFontTextStyle
-
- ^ TextStyle fontArray: {self selectedFont}!
Item was removed:
- ----- Method: FontChooserTool>>selectedPointSize (in category 'point size') -----
- selectedPointSize
- ^self selectedFont pointSize!
Item was removed:
- ----- Method: FontChooserTool>>selectedPointSizeIndex (in category 'point size') -----
- selectedPointSizeIndex
-
- ^ pointSize
- ifNil: [0]
- ifNotNil: [self pointSizeList indexOf: (pointSize printShowingDecimalPlaces: 1)]!
Item was removed:
- ----- Method: FontChooserTool>>selectedPointSizeIndex: (in category 'point size') -----
- selectedPointSizeIndex: anIndex
-
- anIndex = 0 ifTrue: [^self].
- self pointSizeInput: (self pointSizeList at: anIndex).
- self changed: #selectedPointSizeIndex.!
Item was removed:
- ----- Method: FontChooserTool>>selectedTextStyle (in category 'font list') -----
- selectedTextStyle
-
- ^ (TextStyle named: self selectedFontFamily)
- ifNil: [ self getFontFromRequestor
- ifNil: [ TextStyle default ]
- ifNotNil: [:font | TextStyle fontArray: {font} "Not yet installed" ]].!
Item was removed:
- ----- Method: FontChooserTool>>setSelector: (in category 'accessing') -----
- setSelector: anObject
- "Set the value of setSelector"
-
- setSelector := anObject!
Item was removed:
- ----- Method: FontChooserTool>>target (in category 'accessing') -----
- target
- "Answer the value of target"
-
- ^ target!
Item was removed:
- ----- Method: FontChooserTool>>target: (in category 'accessing') -----
- target: anObject
- "Set the value of target"
-
- target := anObject!
Item was removed:
- ----- Method: FontChooserTool>>title: (in category 'accessing') -----
- title: anObject
- "Set the value of title"
-
- title := anObject!
Item was removed:
- ----- Method: FontChooserTool>>updateFromRequestor (in category 'updating') -----
- updateFromRequestor
-
-
- self getFontFromRequestor ifNotNil: [ :font |
- | textStyleName |
- textStyleName := font textStyleName.
- self fontList
- detect: [:f | f = textStyleName]
- ifFound: [:family | self selectedFontIndex: (self fontList indexOf: family)].
- self selectedFontStyleIndex: font emphasis + 1.
- self pointSize: font pointSize].!
Item was removed:
- ----- Method: FontChooserTool>>window (in category 'accessing') -----
- window
- ^window!
Item was removed:
- ----- Method: FontChooserTool>>windowTitle (in category 'initialize') -----
- windowTitle
- ^ title translated!
Item was removed:
- Model subclass: #FontImporterTool
- instanceVariableNames: 'title allFonts currentSelection currentParent selectedFont previewTextSelector customPreviewText pointSize lineSpacing editModeWidgets'
- classVariableNames: 'CustomPreviewTexts'
- poolDictionaries: ''
- category: 'Morphic-Support'!
-
- !FontImporterTool commentStamp: 'topa 3/9/2015 18:56' prior: 0!
- A tool to import platform (native) fonts into the image!
Item was removed:
- ----- Method: FontImporterTool class>>cleanUp: (in category 'initialize-release') -----
- cleanUp: aggressive
-
- aggressive ifTrue: [CustomPreviewTexts := nil].!
Item was removed:
- ----- Method: FontImporterTool class>>initialize (in category 'class initialization') -----
- initialize
-
- self registerInOpenMenu.!
Item was removed:
- ----- Method: FontImporterTool class>>open (in category 'opening') -----
- open
- "
- FontImporterTool open.
- "
- ^self new open!
Item was removed:
- ----- Method: FontImporterTool class>>registerInOpenMenu (in category 'class initialization') -----
- registerInOpenMenu
- (TheWorldMenu respondsTo: #registerOpenCommand:) ifTrue: [
- TheWorldMenu unregisterOpenCommand: 'Font Importer'.
- TheWorldMenu registerOpenCommand: {'Font Importer'. {self. #open}}].
- !
Item was removed:
- ----- Method: FontImporterTool class>>unload (in category 'class initialization') -----
- unload
-
- self unregisterFromOpenMenu.!
Item was removed:
- ----- Method: FontImporterTool class>>unregisterFromOpenMenu (in category 'class initialization') -----
- unregisterFromOpenMenu
- (TheWorldMenu respondsTo: #registerOpenCommand:)
- ifTrue: [TheWorldMenu unregisterOpenCommand: 'Font Importer'].
- !
Item was removed:
- ----- Method: FontImporterTool>>aboutToStyle: (in category 'preview text - code styling') -----
- aboutToStyle: aStyler
-
- previewTextSelector = #codeSample ifFalse: [^ false].
- self customPreviewText ifNotEmpty: [^ false].
-
- aStyler parseAMethod: true. "See Text class >> #codeSample."
- ^ true!
Item was removed:
- ----- Method: FontImporterTool>>acceptCustomPreviewText: (in category 'preview text - custom') -----
- acceptCustomPreviewText: aStringOrTextOrNil
- "The user accepted (i.e. CMD+S or Return) the current input text, Now we store it in the list of custom texts so that it is retrievable via the preview button."
-
- customPreviewText := aStringOrTextOrNil ifNotNil: [:value | value asString].
- self changed: #customPreviewText.
-
- self customPreviewText ifNotEmpty: [:customText |
- CustomPreviewTexts ifNil: [CustomPreviewTexts := OrderedCollection new].
- (CustomPreviewTexts includes: customText)
- ifFalse:[CustomPreviewTexts add: customText] ].
-
- ^ true!
Item was removed:
- ----- Method: FontImporterTool>>adjustXHeight (in category 'edit mode - actions') -----
- adjustXHeight
-
- self selectedFont adjustXHeight; adjustLineGapToGlyphScale.
-
- self currentSelection
- ttExtraScale: self selectedFont extraGlyphScale;
- ttExtraGap: self selectedFont extraLineGap.
-
- self changed: #objectChanged with: self currentSelection.
- self changed: #selectedFontTextStyle.
-
- self changed: #pointSizeInput.
- self changed: #lineSpacingInput.
- self changed: #ttExtraScaleInput.
- self changed: #ttExtraGapInput.!
Item was removed:
- ----- Method: FontImporterTool>>allFonts (in category 'font list/tree') -----
- allFonts
-
- ^ allFonts ifNil: [Cursor wait showWhile: [allFonts := TTFontFileHandle allHandles values sorted]]!
Item was removed:
- ----- Method: FontImporterTool>>allFonts: (in category 'font list/tree') -----
- allFonts: anObject
-
- allFonts := anObject.
- self changed: #allFonts.!
Item was removed:
- ----- Method: FontImporterTool>>applyFont (in category 'actions') -----
- applyFont
-
- | fontSymbols fontLabels choice |
- fontSymbols := self fontSymbolsToUse.
- fontLabels := fontSymbols collect: [:ea | (ea findFeatures joinSeparatedBy: ' ') capitalized].
-
- fontSymbols := #(all allScaled), fontSymbols, #(fallback).
- fontLabels := #('All fonts' 'All fonts (only font family)'), fontLabels, #('Fallback font').
-
- choice := Project uiManager chooseFrom: fontLabels values: fontSymbols title: 'Apply font as...' translated.
- choice ifNil: [^ self].
-
- choice caseOf: {
- [#all] -> [self applyFontToAll].
- [#allScaled] -> [self applyFontToAllScaled].
- [#fallback] -> [self applyFontToFallback].
- } otherwise: [self applyFontTo: choice].!
Item was removed:
- ----- Method: FontImporterTool>>applyFontTo: (in category 'actions') -----
- applyFontTo: fontSymbol
-
- self currentSelection isInstalled ifFalse: [self installFont].
-
- Cursor wait showWhile: [
- UserInterfaceTheme setFont: fontSymbol to: self selectedFont].!
Item was removed:
- ----- Method: FontImporterTool>>applyFontToAll (in category 'actions') -----
- applyFontToAll
-
- | fontSymbolsToApply |
- (Project uiManager
- confirm: 'Do you really want to overwrite individual\point sizes and emphases such as in\buttons and window titles?' translated withCRs
- title: 'Apply Font to Everything' translated)
- ifFalse: [^ self].
-
- self currentSelection isInstalled ifFalse: [self installFont].
-
- fontSymbolsToApply := self selectedFont hasFixedWidth
- ifTrue: [self fontSymbolsToUse]
- ifFalse: [
- self inform: 'This font is not monospaced. It will\not replace the current one.' translated withCRs.
- self fontSymbolsToUse copyWithout: #standardFixedFont].
-
- Cursor wait showWhile: [
- UserInterfaceTheme makeAllTTCBased.
- UserInterfaceTheme current applyAfter: [
- fontSymbolsToApply do: [:fontSymbol |
- UserInterfaceTheme setFont: fontSymbol to: self selectedFont] ]].!
Item was removed:
- ----- Method: FontImporterTool>>applyFontToAllScaled (in category 'actions') -----
- applyFontToAllScaled
- "Like #applyFontToAll but keep the respective point sizes and emphases."
-
- | fontSymbolsToApply |
- self currentSelection isInstalled ifFalse: [self installFont].
-
- fontSymbolsToApply := self selectedFont hasFixedWidth
- ifTrue: [self fontSymbolsToUse]
- ifFalse: [
- self inform: 'This font is not monospaced. It will\not replace the current one.' translated withCRs.
- self fontSymbolsToUse copyWithout: #standardFixedFont].
-
- Cursor wait showWhile: [
- UserInterfaceTheme makeAllTTCBased.
- UserInterfaceTheme current applyAfter: [
- fontSymbolsToApply do: [:fontSymbol | | fontToUse |
-
- (UserInterfaceTheme current get: fontSymbol)
- ifNil: [fontToUse := self selectedFont]
- ifNotNil: [:usedFont |
- fontToUse := (self selectedFont
- asPointSize: usedFont pointSize)
- emphasized: usedFont emphasis].
-
- UserInterfaceTheme setFont: fontSymbol to: fontToUse] ]].!
Item was removed:
- ----- Method: FontImporterTool>>applyFontToFallback (in category 'actions') -----
- applyFontToFallback
-
- self currentSelection isInstalled ifFalse: [self installFont].
-
- Cursor wait showWhile: [
- TextStyle setDefaultFallback: self selectedFont textStyleOrNil.
- TextStyle installDefaultFallbackTextStyle].!
Item was removed:
- ----- Method: FontImporterTool>>browseFont (in category 'actions') -----
- browseFont
-
- self selectedFont browseAllGlyphsByCategory.!
Item was removed:
- ----- Method: FontImporterTool>>browseSystemFonts (in category 'actions') -----
- browseSystemFonts
- "Open a workspace that shows the current preview text with the usual system fonts so that users can compare the font they want to import."
-
- | sample tmp fonts sorted contents preview |
- previewTextSelector = #widgetSample
- ifTrue: [ sample := [:font | self widgetSampleFor: font] ]
- ifFalse: [
- tmp := self previewText.
- sample := [:font | tmp]].
- (TextStyler for: #Smalltalk) ifNotNil: [:stylerClass |
- | styler |
- styler := stylerClass new.
- (self aboutToStyle: styler)
- ifTrue: [sample := [:font | styler styledTextFor: tmp asText]]].
-
- fonts := IdentityDictionary new.
- self fontSymbolsToUse do: [:ea |
- | font |
- font := UserInterfaceTheme current get: ea.
- (fonts at: font ifAbsentPut: [OrderedCollection new]) add: ea].
-
- sorted := fonts keys sorted: [:a :b |
- a familyName < b familyName or: [a familyName = b familyName and: [
- a pointSize < b pointSize or: [a pointSize = b pointSize and: [
- a emphasis < b emphasis]]]]].
-
- contents := Text streamContents: [:s |
-
- sorted do: [:font |
- preview := '{1} ({2} {3}pt)\ #{4}\\' withCRs asText format: {
- font familyName asText addAttribute: (PluggableTextAttribute evalBlock: [font explore]); yourself.
- font subfamilyName.
- font pointSize.
- (fonts at: font) joinSeparatedBy: '\ #' withCRs. }.
-
- preview := preview, (sample value: font).
- preview := preview, String cr. "for the consistent line height at the end"
-
- s cr; nextPutAll: (preview asText addAttribute: (TextFontReference toFont: font); yourself); cr ]].
-
- contents editWithLabel: 'Current system fonts'.!
Item was removed:
- ----- Method: FontImporterTool>>buildButtonBarWith: (in category 'ui - building') -----
- buildButtonBarWith: builder
- "Build the button bar"
- | panelSpec |
- panelSpec := builder pluggablePanelSpec new.
- panelSpec
- layout: #horizontal;
- children: OrderedCollection new.
-
- {
- #installButtonLabel.
- #installButtonHelp.
- #installButtonHit.
- #installButtonColor.
- #installButtonEnabled.
-
- 'Apply...' translated.
- 'Apply the current font in the system. Assure that the font is installed.' translated.
- #applyFont.
- nil.
- nil.
-
- "nil. nil. nil. nil."
-
- 'Browse' translated.
- 'Browse the glyphs. Do not install the font into the image.' translated.
- #browseFont.
- nil.
- nil.
-
- 'Explore' translated.
- 'Explore the font object.' translated.
- #exploreFont.
- nil.
- nil.
- } groupsDo: [:label :help :action :buttonColor :enabled |
- | spec |
- action
- ifNil: [
- spec := builder pluggableSpacerSpec new]
- ifNotNil: [
- spec := builder pluggableButtonSpec new
- model: self;
- label: label;
- color: buttonColor;
- help: help;
- action: action;
- enabled: enabled;
- yourself].
- panelSpec children addLast: spec ].
-
- ^panelSpec!
Item was removed:
- ----- Method: FontImporterTool>>buildFontListWith: (in category 'ui - building') -----
- buildFontListWith: builder
- "Build the font choosers list of font names"
-
- ^ builder pluggableTreeSpec new
- model: self;
- roots: #allFonts;
- label: #labelOf: ;
- getChildren: #childrenOf: ;
- getSelected: #currentSelection;
- setSelected: #currentSelection:;
- setSelectedParent: #currentParent:;
- menu: #fontListMenu:;
- autoDeselect: false;
- yourself
- !
Item was removed:
- ----- Method: FontImporterTool>>buildFontPanelWith: (in category 'ui - building') -----
- buildFontPanelWith: builder
- "Build the main panel for the currently selected font (family). Includes a list of associated file names, an interactive preview panel and the copyright."
-
- ^ builder pluggablePanelSpec new
- children: {
- builder pluggableTextSpec new
- model: self;
- getText: #filename;
- readOnly: true;
- indicateUnacceptedChanges: false;
- font: self filenameFont;
- help: '<- Please select a font family';
- frame: (LayoutFrame
- fractions: (0 at 0 corner: 1 at 0)
- offsets: (0 at 0 corner: 0@ self filenameHeight));
- yourself.
-
- (self buildPreviewPaneWith: builder)
- frame: (LayoutFrame
- fractions: (0 at 0 corner: 1 at 1)
- offsets: (0@ self filenameHeight corner: 0@ (self copyrightHeight negated)));
- yourself.
-
- builder pluggableTextSpec new
- model: self;
- getText: #copyright;
- font: self copyrightFont;
- readOnly: true;
- indicateUnacceptedChanges: false;
- frame: (LayoutFrame
- fractions: (0 at 1 corner: 1 at 1)
- offsets: (0 @ (self copyrightHeight negated) corner: 0 @ 0));
- yourself
-
- };
- yourself!
Item was removed:
- ----- Method: FontImporterTool>>buildPreviewPaneWith: (in category 'ui - building') -----
- buildPreviewPaneWith: builder
- "Build the preview panel. Offer the user the change preview text through the default font, point size, extra (glyph) scale and extra (line) gap."
-
- ^ builder pluggablePanelSpec new
- " wantsResizeHandles: true;"
- children: {
- builder pluggablePanelSpec new
- children: {
- builder pluggableButtonSpec new
- model: self;
- help: #previewTextButtonHelp;
- label: #previewTextButtonLabel;
- action: #offerPreviewTextMenu;
- style: #menuButton;
- frame: (LayoutFrame fractions: (0 at 0 corner: 0.16 at 1));
- yourself.
-
- builder pluggableInputFieldSpec new
- model: self;
- help: 'Type custom preview text here...' translated;
- getText: #customPreviewText;
- setText: #acceptCustomPreviewText:;
- editText: #editCustomPreviewText:;
- plainTextOnly: true;
- frame: (LayoutFrame fractions: (0.16 at 0 corner: 0.84 at 1));
- yourself.
-
- builder pluggableButtonSpec new
- model: self;
- help: 'Click to see current preview text using the system''s current fonts for comparison' translated;
- label: 'Compare' translated;
- action: #browseSystemFonts;
- frame: (LayoutFrame fractions: (0.84 at 0 corner: 1 at 1));
- yourself };
- frame: (LayoutFrame
- fractions: (0 at 0 corner: 1 at 0)
- offsets: (0 at 0 corner: 0@ self customPreviewTextHeight));
- yourself.
-
- builder pluggableTextSpec new
- model: self;
- getText: #previewText;
- textStyle: #selectedFontTextStyle;
- askBeforeDiscardingEdits: false;
- indicateUnacceptedChanges: false;
- softLineWrap: false;
- padding: self previewTextPadding;
- stylerClass: (TextStyler for: #Smalltalk);
- menu: #previewTextMenu:shifted:;
- frame: (LayoutFrame
- fractions: (0 at 0 corner: 1 at 1)
- offsets: (0 @ self customPreviewTextHeight corner: 0@ self configurationPanelHeight negated));
- yourself.
-
- builder pluggablePanelSpec new name: #configPanel; children: (Array streamContents: [:s | | n |
- n := 0.
- self fontConfigurationSpecs groupsDo: [:kind :get :help :label :group | | w |
- kind caseOf: {
- [#spacer] -> [
- w := builder pluggableSpacerSpec new fillSpaceHorizontally].
- [#button] -> [
- w := builder pluggableButtonSpec new
- model: self; label: label; action: get; help: help; yourself].
- [#text] -> [
- w := builder pluggableInputFieldSpec new
- model: self; getText: get; setText: get asSimpleSetter;
- help: help; plainTextOnly: true; yourself].
- } otherwise: [ "Ignore" ].
- w ifNotNil: [ "Remember the group. See #toggleEditMode"
- w name: (group, (n := n + 1)) asSymbol.
- s nextPut: w] ]]);
- layout: #horizontal;
- frame: self configurationPanelFrame;
- yourself.
- };
- yourself!
Item was removed:
- ----- Method: FontImporterTool>>buildWith: (in category 'ui - building') -----
- buildWith: builder
- "Create the ui for the browser"
- "ToolBuilder open: self"
-
- | windowSpec window |
- windowSpec := self buildWindowWith: builder specs: {
- (self fontListFrame) -> [self buildFontListWith: builder].
- (self fontPanelFrame) -> [self buildFontPanelWith: builder].
- (self buttonsFrame) -> [self buildButtonBarWith: builder].
- }.
- window := builder build: windowSpec.
- self prepareEditMode: (builder widgetAt: #configPanel).
- ^ window!
Item was removed:
- ----- Method: FontImporterTool>>buttonHeight (in category 'ui - layout') -----
- buttonHeight
-
- ^ ToolBuilder default buttonRowHeight!
Item was removed:
- ----- Method: FontImporterTool>>buttonsFrame (in category 'ui - layout') -----
- buttonsFrame
-
- ^ LayoutFrame
- fractions: (0 at 1 corner: 1 at 1)
- offsets: (0@ self buttonHeight negated corner: 0 at 0)
- !
Item was removed:
- ----- Method: FontImporterTool>>childrenOf: (in category 'font list/tree') -----
- childrenOf: aFontDescription
-
- ^ aFontDescription children!
Item was removed:
- ----- Method: FontImporterTool>>configurationPanelFrame (in category 'ui - layout') -----
- configurationPanelFrame
-
- ^ LayoutFrame
- fractions: (0 at 1 corner: 1 at 1)
- offsets: (0 @ self configurationPanelHeight negated corner: 0 at 0)!
Item was removed:
- ----- Method: FontImporterTool>>configurationPanelHeight (in category 'ui - layout') -----
- configurationPanelHeight
-
- ^ ToolBuilder default inputFieldHeight!
Item was removed:
- ----- Method: FontImporterTool>>copyright (in category 'accessing') -----
- copyright
- | f |
- f := self selectedFont ifNil:[^ ''].
- ^ f isTTCFont
- ifTrue: [f ttcDescription copyright ifNil: ['']]
- ifFalse: ['']!
Item was removed:
- ----- Method: FontImporterTool>>copyrightFont (in category 'ui - layout') -----
- copyrightFont
-
- ^ Preferences standardBalloonHelpFont!
Item was removed:
- ----- Method: FontImporterTool>>copyrightHeight (in category 'ui - layout') -----
- copyrightHeight
-
- ^ ToolBuilder default helpFieldHeightFor: 3!
Item was removed:
- ----- Method: FontImporterTool>>currentParent (in category 'font list/tree') -----
- currentParent
-
- ^ currentParent!
Item was removed:
- ----- Method: FontImporterTool>>currentParent: (in category 'font list/tree') -----
- currentParent: anObject
-
- anObject = currentParent ifTrue: [^ self].
- currentParent := anObject.
- self changed: #currentParent.
- !
Item was removed:
- ----- Method: FontImporterTool>>currentSelection (in category 'font list/tree') -----
- currentSelection
-
- ^ currentSelection!
Item was removed:
- ----- Method: FontImporterTool>>currentSelection: (in category 'font list/tree') -----
- currentSelection: fontHandleOrNil
-
- fontHandleOrNil = currentSelection ifTrue: [
- ^ self].
-
- fontHandleOrNil
- ifNil: [
- "User probably collapsed subtree with prior selection."
- self selectTextStyleNamed: self selectedFont textStyleName]
- ifNotNil: [
- currentSelection := fontHandleOrNil.
- self changed: #currentSelection].
-
- fontHandleOrNil
- ifNotNil: [self editModeEnabled: self currentSelection isModified].
-
- self selectedFont: nil. "Refresh preview"
-
- !
Item was removed:
- ----- Method: FontImporterTool>>customPreviewText (in category 'preview text - custom') -----
- customPreviewText
-
- ^ customPreviewText ifNil: ['']!
Item was removed:
- ----- Method: FontImporterTool>>customPreviewTextFont (in category 'ui - layout') -----
- customPreviewTextFont
-
- ^ TextStyle defaultFont!
Item was removed:
- ----- Method: FontImporterTool>>customPreviewTextHeight (in category 'ui - layout') -----
- customPreviewTextHeight
-
- ^ ToolBuilder default inputFieldHeight!
Item was removed:
- ----- Method: FontImporterTool>>defaultButtonColor (in category 'ui - colors') -----
- defaultButtonColor
-
- ^ (UserInterfaceTheme current get: #color for: #PluggableButtonMorph) ifNil: [Color gray: 0.91]!
Item was removed:
- ----- Method: FontImporterTool>>discardCustomPreviewTexts (in category 'preview text - custom') -----
- discardCustomPreviewTexts
-
- CustomPreviewTexts := nil.
- self setCustomPreviewText: nil.!
Item was removed:
- ----- Method: FontImporterTool>>editButtonHelp (in category 'edit mode - ui') -----
- editButtonHelp
-
- ^ 'Modify font properties such as <b>extra glyph scale</b> and <b>extra line gap</b>, which will be shared through all point sizes and text styles. Be careful.' translated asTextFromHtml!
Item was removed:
- ----- Method: FontImporterTool>>editCustomPreviewText: (in category 'preview text - custom') -----
- editCustomPreviewText: aStringOrTextOrNil
- "The user typed something. Use it directly as a new preview text. Note that CMD+S (or Return) means that the user wants to save the text for later."
-
- customPreviewText := aStringOrTextOrNil ifNotNil: [:value | value asString].
- self changed: #previewText.
- self changed: #previewTextButtonLabel.!
Item was removed:
- ----- Method: FontImporterTool>>editModeEnabled (in category 'edit mode') -----
- editModeEnabled
-
- ^ Project current isMorphic
- ifFalse: [false]
- ifTrue: [(editModeWidgets at: #on) first visible]!
Item was removed:
- ----- Method: FontImporterTool>>editModeEnabled: (in category 'edit mode') -----
- editModeEnabled: showEditWidgets
-
- Project current isMorphic ifFalse: [^ self].
-
- showEditWidgets
- ifFalse: [
- (editModeWidgets at: #on) do: [:ea | ea hide; disableLayout: true].
- (editModeWidgets at: #off) do: [:ea | ea show; disableLayout: false]]
- ifTrue: [
- (editModeWidgets at: #on) do: [:ea | ea show; disableLayout: false].
- (editModeWidgets at: #off) do: [:ea | ea hide; disableLayout: true]].!
Item was removed:
- ----- Method: FontImporterTool>>errorText: (in category 'preview text') -----
- errorText: aString
- "Style the error text in a font that can display the characters."
-
- ^ Text
- string: aString
- attribute: (TextFontReference toFont: TextStyle defaultFont)!
Item was removed:
- ----- Method: FontImporterTool>>exploreFont (in category 'actions') -----
- exploreFont
-
- self selectedFont explore.!
Item was removed:
- ----- Method: FontImporterTool>>filename (in category 'accessing') -----
- filename
-
- ^ self currentSelection
- ifNil: ['']
- ifNotNil: [:sel |
- String streamContents: [:stream |
- (sel allFilenames ifEmpty: [{'(unknown file location; image only)' translated}])
- do: [:filename | stream nextPutAll: filename]
- separatedBy: [stream cr ]]]!
Item was removed:
- ----- Method: FontImporterTool>>filenameFont (in category 'ui - layout') -----
- filenameFont
-
- ^ Preferences standardBalloonHelpFont!
Item was removed:
- ----- Method: FontImporterTool>>filenameHeight (in category 'ui - layout') -----
- filenameHeight
-
- ^ ToolBuilder default helpFieldHeightFor: 2 "lines"!
Item was removed:
- ----- Method: FontImporterTool>>fontConfigurationSpecs (in category 'ui - building') -----
- fontConfigurationSpecs
-
- ^ #(
- text pointSizeInput pointSizeInputHelp nil preview
- text lineSpacingInput lineSpacingInputHelp nil preview
- spacer nil nil nil preview
- button adjustXHeight 'Adjust the font''s x-height to match the system''s default font.' 'Adjust x' edit
- text ttExtraScaleInput ttExtraScaleInputHelp nil edit
- text ttExtraGapInput ttExtraGapInputHelp nil edit
- button resetFontMetrics 'Reset all fields to their default value. Disable the edit mode.' 'Reset' edit
- button toggleEditMode editButtonHelp 'Edit' toggle
- )!
Item was removed:
- ----- Method: FontImporterTool>>fontListFrame (in category 'ui - layout') -----
- fontListFrame
-
- ^ LayoutFrame
- fractions: (0 at 0 corner: 0.25 at 1)
- offsets: (0 at 0 corner: 0@ self buttonHeight negated)!
Item was removed:
- ----- Method: FontImporterTool>>fontListMenu: (in category 'font list/tree') -----
- fontListMenu: aMenu
-
- ^ aMenu addTranslatedList: #(
- ('Browse' browseFont 'Browse all glyphs in the font')
- ('Explore' exploreFont 'Explore the font object')
- -
- ('Install' installFont 'Make the font available in the environment but keep the glyph data outside the image')
- ('Install & Load' installAndLoadFont 'Make the font available in the environment including all the glyph data to ensure portability of the image')
- ), (self selectedFont textStyleOrNil ifNil: [#()] ifNotNil: [#(
- -
- ('Uninstall' uninstallFont 'Remove the font from the system')
- )])
- yourself!
Item was removed:
- ----- Method: FontImporterTool>>fontPanelFrame (in category 'ui - layout') -----
- fontPanelFrame
-
- ^ LayoutFrame
- fractions: (0.25 at 0 corner: 1 at 1)
- offsets: (0 at 0 corner: 0@ self buttonHeight negated)!
Item was removed:
- ----- Method: FontImporterTool>>fontSymbolsToUse (in category 'accessing') -----
- fontSymbolsToUse
-
- ^ UserInterfaceTheme knownFontSymbols reject: [:ea | ea beginsWith: #wizard]!
Item was removed:
- ----- Method: FontImporterTool>>initialExtent (in category 'initialize') -----
- initialExtent
-
- ^ 670 at 500!
Item was removed:
- ----- Method: FontImporterTool>>initialize (in category 'initialize') -----
- initialize
-
- super initialize.
-
- previewTextSelector := #textSample.
- self selectTextStyleNamed: self selectedFont textStyleName.!
Item was removed:
- ----- Method: FontImporterTool>>installAndLoadFont (in category 'actions') -----
- installAndLoadFont
-
- self installFont ifTrue: [
- self selectedFont becomeLocalFont.
- self currentSelection parent ifNotNil: [:p | self currentSelection: p].
- self changed: #objectChanged with: self currentSelection].
-
- self flag: #todo. "mt: Warn the user about space constraints!!"!
Item was removed:
- ----- Method: FontImporterTool>>installButtonColor (in category 'ui - installation') -----
- installButtonColor
-
- self currentSelection ifNil: [^ self defaultButtonColor].
-
- ^ self currentSelection isFullyInstalled
- ifTrue: [self uninstallColor]
- ifFalse: [self installColor]!
Item was removed:
- ----- Method: FontImporterTool>>installButtonEnabled (in category 'ui - installation') -----
- installButtonEnabled
-
- ^ self currentSelection
- ifNil: [false]
- ifNotNil: [:handle | handle isProtected not]!
Item was removed:
- ----- Method: FontImporterTool>>installButtonHelp (in category 'ui - installation') -----
- installButtonHelp
-
- self currentSelection ifNil: [^ ''].
-
- ^ self currentSelection isInstalled
- ifTrue: ['Remove all font data from the image. Note that existing texts or text styles may still refer to it for a while longer.' translated]
- ifFalse: ['Include the font data in the image and provide a TextStyle for the font' translated].!
Item was removed:
- ----- Method: FontImporterTool>>installButtonHit (in category 'ui - installation') -----
- installButtonHit
-
- self currentSelection ifNil: [^ self].
-
- self currentSelection isFullyInstalled
- ifTrue: [self uninstallFont]
- ifFalse: [self installFont].
-
- self changed: #installButtonLabel.
- self changed: #installButtonColor.!
Item was removed:
- ----- Method: FontImporterTool>>installButtonLabel (in category 'ui - installation') -----
- installButtonLabel
-
- self currentSelection ifNil: [^ 'Install' translated].
-
- ^ self currentSelection isFullyInstalled
- ifTrue: ['Uninstall' translated]
- ifFalse: [
- self currentSelection isInstalled
- ifTrue: ['Update' translated]
- ifFalse: ['Install' translated] ]!
Item was removed:
- ----- Method: FontImporterTool>>installColor (in category 'ui - colors') -----
- installColor
-
- ^ (UserInterfaceTheme current get: #okColor for: #ListChooser) ifNil: [Color r: 0.49 g: 0.749 b: 0.49]!
Item was removed:
- ----- Method: FontImporterTool>>installFont (in category 'actions') -----
- installFont
- "Install the selected font. Inform tha user that a modification is best reflected with a custom font name so that it is possible to also install the font with its original parameters."
-
- | handle wasRenamed |
- handle := self currentSelection.
- wasRenamed := false.
-
- (handle isModified and: [handle hasModifiedName not]) ifTrue: [
- (Project uiManager
- request: 'You modified the selected font.\Please choose a new name:' translated withCRs
- initialAnswer: 'My ', handle familyName)
- ifEmpty: [^ false]
- ifNotEmpty: [:answer |
- wasRenamed := true.
- handle fontname: answer]].
-
- self currentSelection installFont.
- self selectedFont: nil. "New identity from the handle"
-
- wasRenamed ifTrue: [
- "New child in the tree. So refresh everything."
- allFonts := nil. self changed: #allFonts. ^ true].
-
- self currentSelection parent ifNotNil: [:p | self currentSelection: p].
- self changed: #objectChanged with: self currentSelection.
-
- ^ true!
Item was removed:
- ----- Method: FontImporterTool>>labelOf: (in category 'font list/tree') -----
- labelOf: aHandle
-
- | label numSubfamilies|
- self flag: #performance. "mt: Cache labels?"
-
- label := aHandle fontname.
-
- aHandle isLocalFont ifTrue: [label := '[', label, ']'].
- (aHandle hasChildren and: [(numSubfamilies := aHandle children size) > 1])
- ifTrue: [label := label, ' (', numSubfamilies, ')'].
- aHandle isModified ifTrue: [label := label, ' *'].
- label := label asText.
- aHandle isFullyInstalled
- ifTrue: [label addAttribute: TextEmphasis underlined]
- ifFalse: [aHandle isInstalled ifTrue: [
- label := '!! ' asText, label ]].
- aHandle isSubfamilySupported
- ifFalse: [label addAttribute: TextColor gray].
- ^ label!
Item was removed:
- ----- Method: FontImporterTool>>lineSpacing (in category 'preview text - ui') -----
- lineSpacing
-
- ^ lineSpacing ifNil: [0.0]!
Item was removed:
- ----- Method: FontImporterTool>>lineSpacingInput (in category 'preview text - ui') -----
- lineSpacingInput
- "Redirect through #selectedFontTextStyle to get automatic suggestions e.g., for symbol fonts."
-
- ^ (lineSpacing ifNil: [self selectedFontTextStyle lineSpacing]) asString!
Item was removed:
- ----- Method: FontImporterTool>>lineSpacingInput: (in category 'preview text - ui') -----
- lineSpacingInput: anObject
-
- self currentSelection ifNil: [^ false].
-
- lineSpacing := [anObject asNumber] on: NumberParserError do: [nil].
- self changed: #lineSpacingInput.
- self changed: #selectedFontTextStyle.
-
- ^ true!
Item was removed:
- ----- Method: FontImporterTool>>lineSpacingInputHelp (in category 'preview text - ui') -----
- lineSpacingInputHelp
-
- self editModeEnabled ifFalse: [
- ^ 'Line spacing in the preview box' translated].
-
- ^ '<b>Line spacing</b> in the preview box. A factor of 0.0 means no extra spacing while 1.0 means to double the current line height, which is based on the fonts within each line. The value may be negative.<br><br>Note that line spacing is application-specific and can thus be different for any <b>text style</b> (or text field). You can tweak the font itself through <b>extra line gap</b> to affect all its uses.<br><br>Make empty to reset to default value.' translated asTextFromHtml!
Item was removed:
- ----- Method: FontImporterTool>>offerPreviewTextMenu (in category 'preview text') -----
- offerPreviewTextMenu
-
- | builder menuSpec |
- builder := ToolBuilder default.
- menuSpec := builder pluggableMenuSpec new.
-
- #(textSample codeSample widgetSample nil forssmanSample melvilleSample fontSample) do: [:selector |
- selector ifNil: [menuSpec addLine] ifNotNil: [
- | item marker |
- marker := (customPreviewText isEmptyOrNil and: [previewTextSelector = selector])
- ifTrue: ['<yes>'] ifFalse: ['<no>'].
- item := menuSpec
- add: marker, (self previewTextSelectorLabelFor: selector)
- target: self
- selector: #setPreviewTextSelector:
- argumentList: {selector}.
- item help: (self previewTextSelectorHelpFor: selector)]].
- menuSpec addLine.
-
- (CustomPreviewTexts ifNil: [CustomPreviewTexts := OrderedCollection new])
- do: [:text | | marker |
- marker := customPreviewText = text ifTrue: ['<yes>'] ifFalse: ['<no>'].
- menuSpec
- add: marker, (text contractTo: 40)
- target: self
- selector: #setCustomPreviewText:
- argumentList: {text}].
- CustomPreviewTexts ifNotEmpty: [menuSpec addLine].
-
- menuSpec
- add: 'Discard custom texts' translated
- target: self
- selector: #discardCustomPreviewTexts
- argumentList: #().
-
- builder runModal: (builder open: menuSpec).!
Item was removed:
- ----- Method: FontImporterTool>>okToClose (in category 'ui - building') -----
- okToClose
- "Check for modifications to not installed fonts. Ask the user if those modifications should be discarded. Not that modifications to installed fonts were already applied."
-
- | modifiedFonts |
- modifiedFonts := self allFonts "top level" select: [:ea | ea isModified and: [ea isInstalled not]].
- ^ (super okToClose and: [modifiedFonts isEmpty])
- ifTrue: [true]
- ifFalse: [Project uiManager
- confirm: ('You modified the following fonts:\\' translated,
- (modifiedFonts inject: '' into: [:list :each | list, ' ', each fontname, '\']),
- '\These fonts are not yet installed. Do\you want to discard your changes?' translated) withCRs
- title: 'Discard Changes' translated]!
Item was removed:
- ----- Method: FontImporterTool>>okToRevertChanges: (in category 'preview text') -----
- okToRevertChanges: aspect
-
- aspect = #editCustomPreviewText: ifTrue: [self editCustomPreviewText: nil].
- ^ true!
Item was removed:
- ----- Method: FontImporterTool>>open (in category 'initialize') -----
- open
- ^ToolBuilder open: self!
Item was removed:
- ----- Method: FontImporterTool>>pointSize (in category 'preview text - ui') -----
- pointSize
-
- ^ pointSize ifNil: [TextStyle defaultFont pointSize]!
Item was removed:
- ----- Method: FontImporterTool>>pointSizeInput (in category 'preview text - ui') -----
- pointSizeInput
-
- ^ self pointSize asString!
Item was removed:
- ----- Method: FontImporterTool>>pointSizeInput: (in category 'preview text - ui') -----
- pointSizeInput: anObject
-
- self currentSelection ifNil: [^ false].
-
- pointSize := [anObject asNumber roundTo: 0.5] on: NumberParserError do: [TextStyle defaultFont pointSize].
- pointSize := pointSize max: 1.0.
- self changed: #pointSizeInput.
- self selectedFont: nil.
-
- ^ true!
Item was removed:
- ----- Method: FontImporterTool>>pointSizeInputHelp (in category 'preview text - ui') -----
- pointSizeInputHelp
-
- self editModeEnabled ifFalse: [
- ^ 'Point size in the preview box' translated].
-
- ^ ('<b>Point size</b> in the preview box. The system''s default is currently <b>{1}</b> points. It is recommended to adjust the font''s <b>extra glyph scale</b> and <b>extra line gap</b> using the default point size. Look at other text in the system to assess whether this font would integrate nicely.<br><br>Make empty to reset to default value.' translated
- format: {TextStyle defaultFont pointSize}) asTextFromHtml!
Item was removed:
- ----- Method: FontImporterTool>>prepareEditMode: (in category 'edit mode') -----
- prepareEditMode: container
-
- Project current isMorphic ifFalse: [^ self].
-
- editModeWidgets := Dictionary new
- at: #on put: OrderedCollection new;
- at: #off put: OrderedCollection new;
- yourself.
-
- container allMorphsDo: [:m |
- ((m knownName ifNil: ['']) beginsWith: 'edit')
- ifTrue: [(editModeWidgets at: #on) add: m]
- ifFalse: [((m knownName ifNil: ['']) beginsWith: 'toggle')
- ifTrue: [(editModeWidgets at: #off) add: m]]].
-
- self toggleEditMode. "Turn it off"!
Item was removed:
- ----- Method: FontImporterTool>>previewText (in category 'preview text') -----
- previewText
- "Answer the current preview text. Avoid using a text with font-reference attributes so that any not-yet-installed font does not get spreaded across the system. See #selectedFontTextStyle to learn how the preview is rendered using the selected font."
-
- self customPreviewText ifNotEmpty: [:text | ^ text withCRs].
-
- previewTextSelector = #fontSample ifTrue: [
- ^ self selectedFont ttcDescription sampleText
- ifEmpty: [self errorText: 'This font does not provide a sample text.' translated]].
-
- (previewTextSelector ~= #textSample and: [self selectedFont isSymbolFont])
- ifTrue: [^ self errorText: 'This symbol font does not support the preview text.\Please use ''Text/Symbol'' or type a custom text.' translated withCRs].
-
- self selectedFont isSymbolFont
- ifTrue: [^ self selectedFont symbolSample asString].
- (Text respondsTo: previewTextSelector)
- ifTrue: [^ (Text perform: previewTextSelector) asString].
- previewTextSelector = #widgetSample
- ifTrue: [^ self widgetSample].
-
- ^ ''!
Item was removed:
- ----- Method: FontImporterTool>>previewTextButtonHelp (in category 'preview text') -----
- previewTextButtonHelp
-
- ^ self customPreviewText
- ifNotEmpty: [^ 'Custom ->' "The arrow points to the input field in the UI."]
- ifEmpty: [self previewTextSelectorHelpFor: previewTextSelector]!
Item was removed:
- ----- Method: FontImporterTool>>previewTextButtonLabel (in category 'preview text') -----
- previewTextButtonLabel
-
- ^ self customPreviewText
- ifNotEmpty: ['Custom ->']
- ifEmpty: [self previewTextSelectorLabelFor: previewTextSelector]!
Item was removed:
- ----- Method: FontImporterTool>>previewTextMenu:shifted: (in category 'preview text') -----
- previewTextMenu: aMenu shifted: shifted
- <previewTextMenu>
- "See commentary in StringHolder >> #mainCodePaneMenu:shifted:."
-
- ^ StringHolder codePaneMenu: aMenu shifted: shifted!
Item was removed:
- ----- Method: FontImporterTool>>previewTextPadding (in category 'preview text') -----
- previewTextPadding
- "Static. Give a little bit more space so that the user can focus on the font, not the window ui. For UI themes that use bitmap fonts (i.e., the default 75%, 100%, 125%, and 150% scale factor) use the current font metrics. Otherwise, just use a font-agnostic measure in points. Maybe we can make text-field margins more dynamic (and per-font) in the future."
-
- ^ UserInterfaceTheme current isTTCBased
- ifTrue: [(TextStyle pointsToPixels: 16 "pt" @20 "pt") truncated]
- ifFalse: [(TextStyle defaultFont widthOf: $m) @ TextStyle defaultFont lineGrid]!
Item was removed:
- ----- Method: FontImporterTool>>previewTextSelectorHelpFor: (in category 'preview text') -----
- previewTextSelectorHelpFor: symbol
-
- ^ symbol caseOf: {
- [#textSample] -> ['See the font''s alphabet as a dummy text. For symbol fonts, show a selection of symbols.' translated].
- [#codeSample] -> ['See how the font would render some Smalltalk source code.' translated].
- [#forssmanSample] -> ['See an example of ragged text used in the book "Detailtypografie" by Friedrich Forssman and Ralf de Jong.' translated].
- [#melvilleSample] -> ['See the first two paragraphs of "Moby Dick" by Herman Melville.' translated].
- [#fontSample] -> ['See the example text that was provided by the font designer in the font description itself.' translated asTextFromHtml].
- [#widgetSample] -> ['See how the font would look in a list, tree, or menu widget.' translated].
- } otherwise: [ '' ]!
Item was removed:
- ----- Method: FontImporterTool>>previewTextSelectorLabelFor: (in category 'preview text') -----
- previewTextSelectorLabelFor: symbol
-
- ^ symbol caseOf: {
- [#textSample] -> ['Text/Symbols'].
- [#codeSample] -> ['Source code'].
- [#widgetSample] -> ['Widgets'].
- [#forssmanSample] -> ['Forssman'].
- [#melvilleSample] -> ['Melville'].
- [#fontSample] -> ['Font sample'].
- } otherwise: [ '???' ]!
Item was removed:
- ----- Method: FontImporterTool>>resetFontMetrics (in category 'edit mode - actions') -----
- resetFontMetrics
-
- self selectedFont familyName = TextStyle defaultTTFont familyName
- ifTrue: [^ self inform: 'You should not reset the font that is used as\reference for x-height adjustment. Please\change manually if at all.' translated withCRs].
-
- self toggleEditMode.
-
- pointSize := nil.
- lineSpacing := nil.
-
- self currentSelection ifNotNil: [:fontDescr |
- fontDescr ttExtraScale: nil.
- fontDescr ttExtraGap: nil].
-
- self changed: #objectChanged with: self currentSelection.
- self selectedFont: nil. !
Item was removed:
- ----- Method: FontImporterTool>>selectTextStyleNamed: (in category 'initialize') -----
- selectTextStyleNamed: textStyleName
-
- currentSelection := (self allFonts detect: [:handle | handle textStyleName = self selectedFont textStyleName]).
- self changed: #currentSelection.!
Item was removed:
- ----- Method: FontImporterTool>>selectedFont (in category 'accessing') -----
- selectedFont
-
- ^ selectedFont ifNil: [selectedFont := self currentSelection
- ifNil: [TextStyle defaultTTFont]
- ifNotNil: [:o | o fontOfPointSize: self pointSize] ]!
Item was removed:
- ----- Method: FontImporterTool>>selectedFont: (in category 'accessing') -----
- selectedFont: aTTCFont
-
- selectedFont := aTTCFont.
-
- self changed: #previewText.
- self changed: #selectedFontTextStyle.
-
- self changed: #filename.
- self changed: #copyright.
-
- self changed: #pointSizeInput.
- self changed: #lineSpacingInput.
- self changed: #ttExtraScaleInput.
- self changed: #ttExtraGapInput.
-
- self changed: #installButtonColor.
- self changed: #installButtonLabel.
- self changed: #installButtonEnabled.
-
- self changed: #windowTitle.!
Item was removed:
- ----- Method: FontImporterTool>>selectedFontTextStyle (in category 'accessing') -----
- selectedFontTextStyle
- "Construct a new text style from the #selectedFont."
-
- ^( self currentSelection
- ifNil: [TextStyle defaultTT copy]
- ifNotNil: [:handle | handle textStyleOfPointSize: self pointSize])
- lineSpacing: ((lineSpacing isNil and: [self selectedFont isSymbolFont])
- ifTrue: [ 0.3 ]
- ifFalse: [ self lineSpacing ]);
- yourself
-
- !
Item was removed:
- ----- Method: FontImporterTool>>setCustomPreviewText: (in category 'preview text - custom') -----
- setCustomPreviewText: aString
-
- self editCustomPreviewText: aString.
- self changed: #customPreviewText.!
Item was removed:
- ----- Method: FontImporterTool>>setPreviewTextSelector: (in category 'preview text') -----
- setPreviewTextSelector: symbol
-
- previewTextSelector := symbol.
- self setCustomPreviewText: nil.!
Item was removed:
- ----- Method: FontImporterTool>>toggleEditMode (in category 'edit mode') -----
- toggleEditMode
-
- self editModeEnabled: self editModeEnabled not.!
Item was removed:
- ----- Method: FontImporterTool>>ttExtraGapInput (in category 'edit mode - ui') -----
- ttExtraGapInput
-
- ^ (self currentSelection
- ifNil: [0]
- ifNotNil: [:handle | handle ttExtraGap]) asString!
Item was removed:
- ----- Method: FontImporterTool>>ttExtraGapInput: (in category 'edit mode - ui') -----
- ttExtraGapInput: anObject
-
- self currentSelection ifNil: [^ false].
-
- self currentSelection ttExtraGap: ([anObject asNumber truncated] on: NumberParserError do: [nil]).
- self changed: #ttExtraGapInput.
- self changed: #objectChanged with: self currentSelection.
-
- self selectedFont: nil.
-
- ^ true!
Item was removed:
- ----- Method: FontImporterTool>>ttExtraGapInputHelp (in category 'edit mode - ui') -----
- ttExtraGapInputHelp
-
- | tt |
- tt := self selectedFont ifNotNil: [:f | f isTTCFont ifTrue: [ f ttcDescription ] ].
- ^ ('<b>Extra line gap</b> in font measures. This font''s own value is <b>{1}</b> with units-per-em (UPM) being <b>{2}</b>. Adjust to change the font''s line grid (or "height") to compensate for <b>extra glyph scale</b>. The value may be negative.<br><br>Note that there is also <b>line spacing</b>, which is not per font but per <b>text style</b> and thus application-specific.<br><br>Make empty to reset to default value.' translated
- format: {
- tt ifNil: ['?'] ifNotNil: [tt typographicLineGap].
- tt ifNil: ['?'] ifNotNil: [tt unitsPerEm].
- }) asTextFromHtml!
Item was removed:
- ----- Method: FontImporterTool>>ttExtraScaleInput (in category 'edit mode - ui') -----
- ttExtraScaleInput
-
- ^ (self currentSelection
- ifNil: [1.0]
- ifNotNil: [:handle | handle ttExtraScale]) printShowingDecimalPlaces: 3!
Item was removed:
- ----- Method: FontImporterTool>>ttExtraScaleInput: (in category 'edit mode - ui') -----
- ttExtraScaleInput: anObject
-
- self currentSelection ifNil: [^ false].
-
- self currentSelection ttExtraScale: ([anObject asNumber] on: NumberParserError do: [nil]).
- self changed: #ttExtraScaleInput.
- self changed: #objectChanged with: self currentSelection.
-
- self selectedFont: nil.
-
- ^ true!
Item was removed:
- ----- Method: FontImporterTool>>ttExtraScaleInputHelp (in category 'edit mode - ui') -----
- ttExtraScaleInputHelp
-
- (self selectedFont isNil or: [self selectedFont isTTCFont not])
- ifTrue: [ ^ ''].
-
- ^ ('<b>Extra glyph scale</b> to accommodate varying heights when using different fonts side-by-side. This font has a relative x-height of <b>{1}</b> while the system''s reference is <b>{2}</b>. You can only use values greater than 0.0.<br><br>Note that this does not change the font''s "pixel height" and is thus unrelated to the system''s overall <b>UI scale factor</b>. You may want to adjust <b>extra line gap</b> as well to retain the font''s aesthetics.<br><br>Make empty to reset to default value.' translated
- format: {
- self selectedFont xHeightFraction printShowingDecimalPlaces: 3.
- TextStyle defaultTTFont xHeightFraction printShowingDecimalPlaces: 3 }) asTextFromHtml!
Item was removed:
- ----- Method: FontImporterTool>>uninstallColor (in category 'ui - colors') -----
- uninstallColor
-
- ^ (UserInterfaceTheme current get: #cancel for: #ListChooser) ifNil: [Color r: 1 g: 0.6 b: 0.588]!
Item was removed:
- ----- Method: FontImporterTool>>uninstallFont (in category 'actions') -----
- uninstallFont
-
- (Project uiManager
- confirm: ('Do you want to uninstall the following font?\\ ' translated,
- self currentSelection familyName,
- '\\(There may be references left to this font\in text attributes and text styles.)' translated) withCRs
- title: 'Uninstall Font' translated) ifFalse: [^ false].
-
- self currentSelection uninstallFont.
-
- self currentSelection parent ifNotNil: [:p | self currentSelection: p].
- self changed: #objectChanged with: self currentSelection.
-
- ^ true!
Item was removed:
- ----- Method: FontImporterTool>>widgetSample (in category 'preview text') -----
- widgetSample
-
- ^ self widgetSampleFor: self selectedFont!
Item was removed:
- ----- Method: FontImporterTool>>widgetSampleFor: (in category 'preview text') -----
- widgetSampleFor: font
-
- | widgets data preferredWidth |
- data := ChronologyConstants classPool at: #MonthNames.
- widgets := OrderedCollection new.
- preferredWidth := ((font widthOfString: (data detectMax: [:ea | ea size])) * 1.3) truncated.
-
- "1) List morph"
- widgets add: ((PluggableListMorph on: data list: #value selected: nil changeSelected: nil) vResizing: #shrinkWrap; width: preferredWidth; font: font; yourself).
-
- "2) Menu morph"
- widgets add: (MenuMorph new in: [:menu | data do: [:o | menu add: o action: #yourself. menu lastItem font: font]. menu]).
-
- "3) Buttons"
- widgets add: (Morph new color: Color transparent; changeTableLayout; listDirection: #topToBottom; vResizing: #shrinkWrap; cellGap: (font widthOf: Character space); width: preferredWidth; addAllMorphs: (data collect: [:ea | (PluggableButtonMorph on: ea getState: nil action: #yourself label: #yourself) hResizing: #spaceFill; font: font; fullBounds; in: [:button | MorphicProject useCompactButtons ifFalse: [button vResizing: #rigid; height: button height * 1.6; flag: #magicNumber]]; yourself ])).
-
- ^ Text streamContents: [:sample |
- widgets
- do: [:widget |
- widget textAnchorProperties verticalAlignment: #top.
- sample nextPutAll: (
- Text
- string: Character startOfHeader asString
- attribute: widget asTextAnchor)]
- separatedBy: [sample space: 5]]!
Item was removed:
- ----- Method: FontImporterTool>>windowTitle (in category 'ui - building') -----
- windowTitle
-
- ^ 'Font Importer: ', self selectedFont familyName!
Item was removed:
- ----- Method: Form>>asMorph (in category '*Morphic') -----
- asMorph
- ^ImageMorph new image: self!
Item was removed:
- ----- Method: Form>>iconOrThumbnailOfSize: (in category '*Morphic') -----
- iconOrThumbnailOfSize: aNumberOrPoint
- "Answer an appropiate form to represent the receiver"
- ^ self scaledIntoFormOfSize: aNumberOrPoint!
Item was removed:
- ----- Method: Form>>scaledIntoFormOfSize: (in category '*Morphic') -----
- scaledIntoFormOfSize: aNumberOrPoint
-
- ^ self scaledIntoFormOfSize: aNumberOrPoint smoothing: 8!
Item was removed:
- ----- Method: Form>>scaledIntoFormOfSize:smoothing: (in category '*Morphic') -----
- scaledIntoFormOfSize: aNumberOrPoint smoothing: factor
- "Scale and center the receiver into a form of a given size"
-
- | extent scaledForm result |
-
- extent := aNumberOrPoint asPoint.
- extent = self extent ifTrue: [^ self copy].
-
- scaledForm := self scaledToSize: extent smoothing: factor.
-
- result := self species extent: extent depth: self depth.
- result getCanvas
- translucentImage: scaledForm
- at: extent - scaledForm extent // 2.
-
- ^ result
- !
Item was removed:
- ----- Method: Form>>stencil (in category '*Morphic-Support-image manipulation') -----
- stencil
- "return a 1-bit deep, black-and-white stencil of myself"
-
- | canvas |
- canvas := FormCanvas extent: self extent depth: 1.
- canvas fillColor: (Color white).
-
- canvas stencil: self at: 0 at 0
- sourceRect: (Rectangle origin: 0 at 0 corner: self extent) color: Color black.
-
- ^ canvas form
- !
Item was removed:
- ----- Method: Form>>textAnchorProperties (in category '*Morphic-Text Support') -----
- textAnchorProperties
-
- ^ TextAnchorProperties new!
Item was removed:
- Canvas subclass: #FormCanvas
- instanceVariableNames: 'origin clipRect form port shadowColor'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Support'!
-
- !FormCanvas commentStamp: '<historical>' prior: 0!
- Note that when shadowDrawing is true, shadowStipple may be either a color, for a solid shadow of the given color, or it may be a stipple used to simulate gray shading when the display cannot support alpha blending.!
Item was removed:
- ----- Method: FormCanvas class>>extent: (in category 'instance creation') -----
- extent: aPoint
-
- ^ self extent: aPoint depth: Display depth
- !
Item was removed:
- ----- Method: FormCanvas class>>extent:depth: (in category 'instance creation') -----
- extent: extent depth: depth
-
- ^ self new setForm: (Form extent: extent depth: depth)!
Item was removed:
- ----- Method: FormCanvas class>>extent:depth:origin:clipRect: (in category 'instance creation') -----
- extent: extent depth: depth origin: aPoint clipRect: aRectangle
-
- ^ self new
- setForm: (Form extent: extent depth: depth);
- setOrigin: aPoint clipRect: aRectangle;
- yourself!
Item was removed:
- ----- Method: FormCanvas class>>on: (in category 'instance creation') -----
- on: aForm
-
- ^ self new setForm: aForm
- !
Item was removed:
- ----- Method: FormCanvas class>>test1 (in category 'testing') -----
- test1
- "FormCanvas test1"
-
- | canvas |
- canvas := FormCanvas extent: 200 at 200.
- canvas fillColor: (Color black).
- canvas line: 10 at 10 to: 50 at 30 width: 1 color: (Color red).
- canvas frameRectangle: ((20 at 20) corner: (120 at 120)) width: 4 color: (Color green).
- canvas point: 100 at 100 color: (Color black).
- canvas drawString: 'Hello, World!!' at: 40 at 40 font: nil color: (Color cyan).
- canvas fillRectangle: ((10 at 80) corner: (31 at 121)) color: (Color magenta).
- canvas fillOval: ((10 at 80) corner: (31 at 121)) color: (Color cyan).
- canvas frameOval: ((40 at 80) corner: (61 at 121)) color: (Color blue).
- canvas frameOval: ((70 at 80) corner: (91 at 121)) width: 3 color: (Color red alpha: 0.2).
- canvas fillRectangle: ((130 at 30) corner: (170 at 80)) color: (Color lightYellow).
- canvas showAt: 0 at 0.
- !
Item was removed:
- ----- Method: FormCanvas class>>test2 (in category 'testing') -----
- test2
- "FormCanvas test2"
-
- | baseCanvas p |
- baseCanvas := FormCanvas extent: 200 at 200.
- p := Sensor cursorPoint.
- [Sensor anyButtonPressed] whileFalse: [
- baseCanvas translateBy: (Sensor cursorPoint - p) during:[:canvas|
- canvas fillColor: Color white.
- canvas line: 10 at 10 to: 50 at 30 width: 1 color: Color red.
- canvas frameRectangle: ((20 at 20) corner: (120 at 120)) width: 4 color: Color green.
- canvas point: 100 at 100 color: Color black.
- canvas drawString: 'Hello, World!!' at: 40 at 40 font: nil color: Color cyan.
- canvas fillRectangle: ((10 at 80) corner: (31 at 121)) color: Color magenta.
- canvas fillOval: ((10 at 80) corner: (31 at 121)) color: Color cyan.
- canvas frameOval: ((40 at 80) corner: (61 at 121)) color: Color blue.
- canvas frameOval: ((70 at 80) corner: (91 at 121)) width: 3 color: Color red.
- canvas fillRectangle: ((130 at 30) corner: (170 at 80)) color: Color lightYellow.
- canvas showAt: 0 at 0]].
- !
Item was removed:
- ----- Method: FormCanvas class>>test3 (in category 'testing') -----
- test3
- "FormCanvas test3"
-
- | baseCanvas |
- baseCanvas := FormCanvas extent: 200 at 200.
- baseCanvas fillColor: Color white.
- baseCanvas translateBy: 10 at 10 during:[:canvas|
- canvas shadowColor: (Color black alpha: 0.5).
- canvas line: 10 at 10 to: 50 at 30 width: 1 color: Color red.
- canvas frameRectangle: ((20 at 20) corner: (120 at 120)) width: 4 color: Color green.
- canvas point: 100 at 100 color: Color black.
- canvas drawString: 'Hello, World!!' at: 40 at 40 font: nil color: Color cyan.
- canvas fillRectangle: ((10 at 80) corner: (31 at 121)) color: Color magenta.
- canvas fillOval: ((10 at 80) corner: (31 at 121)) color: Color cyan.
- canvas frameOval: ((40 at 80) corner: (61 at 121)) color: Color blue.
- canvas frameOval: ((70 at 80) corner: (91 at 121)) width: 3 color: Color red.
- canvas fillRectangle: ((130 at 30) corner: (170 at 80)) color: Color lightYellow.
- canvas showAt: 0 at 0.
- ].!
Item was removed:
- ----- Method: FormCanvas>>allocateForm: (in category 'accessing') -----
- allocateForm: extentPoint
- "Allocate a new form which is similar to the receiver"
- ^form allocateForm: extentPoint!
Item was removed:
- ----- Method: FormCanvas>>asBalloonCanvas (in category 'other') -----
- asBalloonCanvas
- ^(BalloonCanvas on: form) setOrigin: origin clipRect: clipRect!
Item was removed:
- ----- Method: FormCanvas>>asShadowDrawingCanvas (in category 'converting') -----
- asShadowDrawingCanvas
- "Note: This is sort of an optimization here since since the logic is all there"
- ^self copy shadowColor: (Color black alpha: 0.5)!
Item was removed:
- ----- Method: FormCanvas>>asShadowDrawingCanvas: (in category 'converting') -----
- asShadowDrawingCanvas: aColor
- "Note: This is sort of an optimization here since since the logic is all there"
- ^self copy shadowColor: aColor!
Item was removed:
- ----- Method: FormCanvas>>balloonFillOval:fillStyle:borderWidth:borderColor: (in category 'drawing-ovals') -----
- balloonFillOval: aRectangle fillStyle: aFillStyle borderWidth: bw borderColor: bc
-
- self asBalloonCanvas
- fillOval: aRectangle
- fillStyle: aFillStyle
- borderWidth: bw
- borderColor: bc!
Item was removed:
- ----- Method: FormCanvas>>balloonFillRectangle:fillStyle: (in category 'private') -----
- balloonFillRectangle: aRectangle fillStyle: aFillStyle
-
- self asBalloonCanvas fillRectangle: aRectangle fillStyle: aFillStyle.!
Item was removed:
- ----- Method: FormCanvas>>balloonFillRoundRect:radius:fillStyle: (in category 'private') -----
- balloonFillRoundRect: aRectangle radius: radius fillStyle: fillStyle
- ^self asBalloonCanvas fillRoundRect: aRectangle radius: radius fillStyle: fillStyle!
Item was removed:
- ----- Method: FormCanvas>>clipBy:during: (in category 'drawing-support') -----
- clipBy: aRectangle during: aBlock
- "Set a clipping rectangle active only during the execution of aBlock.
- Note: In the future we may want to have more general clip shapes - not just rectangles"
- ^aBlock value: (self copyClipRect: aRectangle)!
Item was removed:
- ----- Method: FormCanvas>>clipRect (in category 'accessing') -----
- clipRect
- "Return the currently active clipping rectangle"
- ^ clipRect translateBy: origin negated!
Item was removed:
- ----- Method: FormCanvas>>contentsOfArea:into: (in category 'accessing') -----
- contentsOfArea: aRectangle into: aForm
- | bb |
- self flush.
- bb := BitBlt toForm: aForm.
- bb sourceForm: form; combinationRule: Form over;
- sourceX: (aRectangle left + origin x); sourceY: (aRectangle top + origin y);
- width: aRectangle width; height: aRectangle height;
- copyBits.
- ^aForm!
Item was removed:
- ----- Method: FormCanvas>>copyClipRect: (in category 'copying') -----
- copyClipRect: aRectangle
- ^ self copyOrigin: origin clipRect: (aRectangle translateBy: origin)
- !
Item was removed:
- ----- Method: FormCanvas>>copyOffset: (in category 'copying') -----
- copyOffset: aPoint
- ^ self copyOrigin: origin + aPoint clipRect: clipRect!
Item was removed:
- ----- Method: FormCanvas>>copyOffset:clipRect: (in category 'copying') -----
- copyOffset: aPoint clipRect: sourceClip
- "Make a copy of me offset by aPoint, and further clipped
- by sourceClip, a rectangle in the un-offset coordinates"
- ^ self copyOrigin: aPoint + origin
- clipRect: ((sourceClip translateBy: origin) intersect: clipRect)!
Item was removed:
- ----- Method: FormCanvas>>copyOrigin:clipRect: (in category 'copying') -----
- copyOrigin: aPoint clipRect: aRectangle
- "Return a copy of this canvas with the given origin. The clipping rectangle of this canvas is the intersection of the given rectangle and the receiver's current clipping rectangle. This allows the clipping rectangles of nested clipping morphs to be composed."
- ^ self copy
- setOrigin: aPoint
- clipRect: (clipRect intersect: aRectangle)!
Item was removed:
- ----- Method: FormCanvas>>depth (in category 'accessing') -----
- depth
-
- ^ form depth
- !
Item was removed:
- ----- Method: FormCanvas>>drawPolygon:color:borderWidth:borderColor: (in category 'drawing-polygons') -----
- drawPolygon: vertices color: aColor borderWidth: bw borderColor: bc
- "Generalize for the BalloonCanvas"
- ^self drawPolygon: vertices fillStyle: aColor borderWidth: bw borderColor: bc!
Item was removed:
- ----- Method: FormCanvas>>drawPolygon:fillStyle:borderWidth:borderColor: (in category 'drawing-polygons') -----
- drawPolygon: vertices fillStyle: aFillStyle borderWidth: bw borderColor: bc
- "Use a BalloonCanvas"
- self asBalloonCanvas
- drawPolygon: vertices asArray
- fillStyle: (self shadowColor ifNil:[aFillStyle])
- borderWidth: bw
- borderColor: bc!
Item was removed:
- ----- Method: FormCanvas>>drawString:from:to:at:font:color: (in category 'drawing-text') -----
- drawString: aString from: firstIndex to: lastIndex at: aPoint font: fontOrNil color: c
- | font |
- port colorMap: nil.
- font := fontOrNil ifNil: [TextStyle defaultFont].
- port combinationRule: Form paint.
- font installOn: port
- foregroundColor: (self shadowColor ifNil:[c])
- backgroundColor: Color transparent.
- font displayString: aString on: port
- from: firstIndex to: lastIndex at: (origin + aPoint) kern: 0.!
Item was removed:
- ----- Method: FormCanvas>>drawString:from:to:in:font:color: (in category 'drawing-text') -----
- drawString: aString from: firstIndex to: lastIndex in: bounds font: fontOrNil color: c
- | font portRect |
- port colorMap: nil.
- portRect := port clipRect.
- port clipByX1: bounds left + origin x
- y1: bounds top + origin y
- x2: bounds right + origin x
- y2: bounds bottom + origin y.
- font := fontOrNil ifNil: [TextStyle defaultFont].
- port combinationRule: Form paint.
- font installOn: port
- foregroundColor: (self shadowColor ifNil:[c])
- backgroundColor: Color transparent.
- font displayString: aString asString on: port
- from: firstIndex to: lastIndex at: (bounds topLeft + origin) kern: 0.
- port clipRect: portRect.!
Item was removed:
- ----- Method: FormCanvas>>extent (in category 'accessing') -----
- extent
-
- ^ form extent!
Item was removed:
- ----- Method: FormCanvas>>fillColor: (in category 'drawing') -----
- fillColor: c
- "Note: This always fills, even if the color is transparent."
- self setClearColor: c.
- port fillRect: form boundingBox offset: origin.!
Item was removed:
- ----- Method: FormCanvas>>fillOval:color:borderWidth:borderColor: (in category 'drawing-ovals') -----
- fillOval: r color: fillColor borderWidth: borderWidth borderColor: borderColor
- | rect |
- "draw the border of the oval"
- rect := (r translateBy: origin) truncated.
- (borderWidth = 0 or: [borderColor isTransparent]) ifFalse:[
- self setFillColor: borderColor.
- (r area > 10000 or: [fillColor isTranslucent])
- ifTrue: [port frameOval: rect borderWidth: borderWidth]
- ifFalse: [port fillOval: rect]]. "faster this way"
- "fill the inside"
- fillColor isTransparent ifFalse:
- [self setFillColor: fillColor.
- port fillOval: (rect insetBy: borderWidth)].
- !
Item was removed:
- ----- Method: FormCanvas>>fillOval:fillStyle:borderWidth:borderColor: (in category 'drawing-ovals') -----
- fillOval: aRectangle fillStyle: aFillStyle borderWidth: bw borderColor: bc
- "Fill the given oval."
-
- self flag: #bob. "this and its siblings could be moved up to Canvas with the
- right #balloonFillOval:..."
-
- self shadowColor ifNotNil:
- [^self fillOval: aRectangle color: aFillStyle asColor borderWidth: bw borderColor: bc].
- (aFillStyle isBitmapFill and:[aFillStyle isKindOf: InfiniteForm]) ifTrue:[
- self flag: #fixThis.
- ^self fillOval: aRectangle color: aFillStyle borderWidth: bw borderColor: bc].
- (aFillStyle isSolidFill) ifTrue:[
- ^self fillOval: aRectangle color: aFillStyle asColor borderWidth: bw borderColor: bc].
- "Use a BalloonCanvas instead"
- self balloonFillOval: aRectangle fillStyle: aFillStyle borderWidth: bw borderColor: bc!
Item was removed:
- ----- Method: FormCanvas>>fillRectangle:fillStyle: (in category 'drawing-rectangles') -----
- fillRectangle: aRectangle fillStyle: aFillStyle
- "Fill the given rectangle."
- | pattern |
- self shadowColor ifNotNil:
- [^self fillRectangle: aRectangle color: aFillStyle asColor].
-
- (aFillStyle isKindOf: InfiniteForm) ifTrue: [
- ^self infiniteFillRectangle: aRectangle fillStyle: aFillStyle
- ].
-
- (aFillStyle isSolidFill)
- ifTrue:[^self fillRectangle: aRectangle color: aFillStyle asColor].
- "We have a very special case for filling with infinite forms"
- (aFillStyle isBitmapFill and:[aFillStyle origin = (0 at 0)]) ifTrue:[
- pattern := aFillStyle form.
- (aFillStyle direction = (pattern width @ 0)
- and:[aFillStyle normal = (0 at pattern height)]) ifTrue:[
- "Can use an InfiniteForm"
- ^self fillRectangle: aRectangle color: (InfiniteForm with: pattern)].
- ].
- "Use a BalloonCanvas instead"
- self balloonFillRectangle: aRectangle fillStyle: aFillStyle.!
Item was removed:
- ----- Method: FormCanvas>>fillRoundRect:radius:fillStyle: (in category 'drawing-rectangles') -----
- fillRoundRect: aRectangle radius: radius fillStyle: fillStyle
- fillStyle isTransparent ifTrue:[^self].
- radius asPoint <= (0 at 0)
- ifTrue:[^self fillRectangle: aRectangle fillStyle: fillStyle].
- fillStyle isSolidFill
- ifFalse:[^self balloonFillRoundRect: aRectangle radius: radius fillStyle: fillStyle].
- self setFillColor: (shadowColor ifNil:[fillStyle asColor]).
- ^port fillRoundRect: (aRectangle translateBy: origin) truncated radius: radius.
- !
Item was removed:
- ----- Method: FormCanvas>>finish (in category 'initialization') -----
- finish
- "If there are any pending operations on the receiver complete them. Do not return before all modifications have taken effect."
- form finish!
Item was removed:
- ----- Method: FormCanvas>>flushDisplay (in category 'other') -----
- flushDisplay
- Display deferUpdates: false; forceDisplayUpdate.!
Item was removed:
- ----- Method: FormCanvas>>forceToScreen: (in category 'other') -----
- forceToScreen:rect
- ^Display forceToScreen:rect.
- !
Item was removed:
- ----- Method: FormCanvas>>form (in category 'accessing') -----
- form
-
- ^ form!
Item was removed:
- ----- Method: FormCanvas>>frameAndFillRectangle:fillColor:borderWidth:borderColor: (in category 'drawing-rectangles') -----
- frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth borderColor: borderColor
- | rect |
- rect := r translateBy: origin.
- "draw the border of the rectangle"
- borderColor isTransparent ifFalse:[
- self setFillColor: borderColor.
- (r area > 10000 or: [fillColor isTranslucent]) ifTrue: [
- port frameRect: rect borderWidth: borderWidth.
- ] ifFalse: ["for small rectangles, it's faster to fill the entire outer rectangle
- than to compute and fill the border rects"
- port fillRect: rect offset: origin]].
-
- "fill the inside"
- fillColor isTransparent ifFalse:
- [self setFillColor: fillColor.
- port fillRect: (rect insetBy: borderWidth) offset: origin].!
Item was removed:
- ----- Method: FormCanvas>>frameAndFillRectangle:fillColor:borderWidth:topLeftColor:bottomRightColor: (in category 'drawing-rectangles') -----
- frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth topLeftColor: topLeftColor bottomRightColor: bottomRightColor
-
- | w h rect |
- "First use quick code for top and left borders and fill"
- self frameAndFillRectangle: r
- fillColor: fillColor
- borderWidth: borderWidth
- borderColor: topLeftColor.
-
- "Return here for duplicate colors. Makes translucent borders work better."
- topLeftColor = bottomRightColor ifTrue: [^ self].
-
- "Now use slow code for bevelled bottom and right borders"
- bottomRightColor isTransparent ifFalse: [
- borderWidth isNumber
- ifTrue: [w := h := borderWidth]
- ifFalse: [w := borderWidth x. h := borderWidth y].
- rect := r translateBy: origin.
- self setFillColor: bottomRightColor.
- port
- frameRectRight: rect width: w;
- frameRectBottom: rect height: h].
- !
Item was removed:
- ----- Method: FormCanvas>>frameAndFillRoundRect:radius:fillStyle:borderWidth:borderColor: (in category 'drawing-rectangles') -----
- frameAndFillRoundRect: aRectangle radius: cornerRadius fillStyle: fillStyle borderWidth: bw borderColor: bc
- "Draw a rounded rectangle"
- self shadowColor ifNotNil:[
- ^self fillRoundRect: aRectangle radius: cornerRadius fillStyle: shadowColor.
- ].
- "see if the round rect is degenerate"
- cornerRadius asPoint <= (0 at 0)
- ifTrue:[^self frameAndFillRectangle: aRectangle fillColor: fillStyle asColor borderWidth: bw borderColor: bc].
- "Okay it's a rounded rectangle"
- fillStyle isTransparent ifFalse:["fill interior"
- | innerRect radius |
- innerRect := aRectangle.
- radius := cornerRadius.
- bw isZero ifFalse:[
- innerRect := innerRect insetBy: bw.
- radius := radius - bw.
- ].
- self fillRoundRect: innerRect radius: radius fillStyle: fillStyle.
- ].
- self frameRoundRect: aRectangle radius: cornerRadius width: bw color: bc
- !
Item was removed:
- ----- Method: FormCanvas>>frameRoundRect:radius:width:color: (in category 'drawing-rectangles') -----
- frameRoundRect: aRectangle radius: radius width: borderWidth color: borderColor
- "Frame a rounded rectangle with the given attributes."
- | innerRect |
- (borderWidth isZero or:[borderColor isTransparent])
- ifTrue:[^self].
- radius asPoint <= (0 at 0)
- ifTrue:[^self frameRectangle: aRectangle width: borderWidth color: borderColor].
- "decompose inner rectangle into bezier shape"
- innerRect := aRectangle insetBy: borderWidth.
- innerRect area <= 0
- ifTrue:[^self fillRoundRect: aRectangle radius: radius fillStyle: borderColor].
- self setFillColor: borderColor.
- port
- frameRoundRect: (aRectangle translateBy: origin) truncated
- radius: radius truncated
- borderWidth: borderWidth truncated.
- !
Item was removed:
- ----- Method: FormCanvas>>image:at:sourceRect:rule: (in category 'private') -----
- image: aForm at: aPoint sourceRect: sourceRect rule: rule
- "Draw the portion of the given Form defined by sourceRect at the given point using the given BitBlt combination rule."
- port colorMap: (aForm colormapIfNeededFor: form); fillColor: nil.
- port image: aForm at: aPoint + origin sourceRect: sourceRect rule: rule.
- (form depth = 32 and: [aForm depth = 16])
- ifTrue: [port image: nil at: aPoint + origin sourceRect: sourceRect rule: 40 "fixAlpha:with:"].
- !
Item was removed:
- ----- Method: FormCanvas>>image:at:sourceRect:rule:alpha: (in category 'private') -----
- image: aForm at: aPoint sourceRect: sourceRect rule: rule alpha: sourceAlpha
- "Draw the portion of the given Form defined by sourceRect at the given point using the given BitBlt combination rule."
- port colorMap: (aForm colormapIfNeededFor: form); fillColor: nil.
- port image: aForm at: aPoint + origin sourceRect: sourceRect rule: rule alpha: sourceAlpha.!
Item was removed:
- ----- Method: FormCanvas>>infiniteFillRectangle:fillStyle: (in category 'private') -----
- infiniteFillRectangle: aRectangle fillStyle: aFillStyle
-
- | additionalOffset rInPortTerms clippedPort targetTopLeft clipOffset ex |
-
- "this is a bit of a kludge to get the form to be aligned where I *think* it should be.
- something better is needed, but not now"
-
- additionalOffset := 0 at 0.
- ex := aFillStyle form extent.
- rInPortTerms := aRectangle translateBy: origin.
- clippedPort := port clippedBy: rInPortTerms.
- targetTopLeft := clippedPort clipRect topLeft truncateTo: ex.
- clipOffset := rInPortTerms topLeft - targetTopLeft.
- additionalOffset := (clipOffset \\ ex) - ex.
- ^aFillStyle
- displayOnPort: clippedPort
- offsetBy: additionalOffset
- !
Item was removed:
- ----- Method: FormCanvas>>isShadowDrawing (in category 'testing') -----
- isShadowDrawing
- ^ self shadowColor notNil!
Item was removed:
- ----- Method: FormCanvas>>isVisible: (in category 'testing') -----
- isVisible: aRectangle
- "Optimization"
- (aRectangle right + origin x) < clipRect left ifTrue: [^ false].
- (aRectangle left + origin x) > clipRect right ifTrue: [^ false].
- (aRectangle bottom + origin y) < clipRect top ifTrue: [^ false].
- (aRectangle top + origin y) > clipRect bottom ifTrue: [^ false].
- ^ true
- !
Item was removed:
- ----- Method: FormCanvas>>line:to:brushForm: (in category 'drawing') -----
- line: pt1 to: pt2 brushForm: brush
- | offset |
- offset := origin.
- self setPaintColor: Color black.
- port sourceForm: brush; fillColor: nil;
- sourceRect: brush boundingBox;
- colorMap: (brush colormapIfNeededFor: form);
- drawFrom: (pt1 + offset) to: (pt2 + offset)!
Item was removed:
- ----- Method: FormCanvas>>line:to:width:color: (in category 'drawing') -----
- line: pt1 to: pt2 width: w color: c
- | offset |
- offset := origin - (w // 2) asPoint.
- self setFillColor: c.
- port width: w; height: w;
- drawFrom: (pt1 + offset) to: (pt2 + offset)!
Item was removed:
- ----- Method: FormCanvas>>origin (in category 'accessing') -----
- origin
- "Return the current origin for drawing operations"
- ^ origin!
Item was removed:
- ----- Method: FormCanvas>>paragraph:bounds:color: (in category 'drawing') -----
- paragraph: para bounds: bounds color: c
-
- | scanner |
- self setPaintColor: c.
- scanner := (port clippedBy: (bounds translateBy: origin)) displayScannerFor: para
- foreground: (self shadowColor ifNil:[c]) background: Color transparent
- ignoreColorChanges: self shadowColor notNil.
- para displayOn: (self copyClipRect: bounds) using: scanner at: origin+ bounds topLeft.
- !
Item was removed:
- ----- Method: FormCanvas>>point:color: (in category 'drawing') -----
- point: pt color: c
-
- form colorAt: (pt + origin) put: c.!
Item was removed:
- ----- Method: FormCanvas>>portClass (in category 'private') -----
- portClass
- "Return the class used as port"
- ^BitBlt asGrafPort!
Item was removed:
- ----- Method: FormCanvas>>postCopy (in category 'copying') -----
- postCopy
- "Let the copy have its own grafPort."
-
- super postCopy.
- self resetGrafPort
- !
Item was removed:
- ----- Method: FormCanvas>>printOn: (in category 'printing') -----
- printOn: aStream
- super printOn: aStream.
- aStream nextPutAll:' on: '; print: form.!
Item was removed:
- ----- Method: FormCanvas>>privateClipRect (in category 'private') -----
- privateClipRect
-
- ^clipRect!
Item was removed:
- ----- Method: FormCanvas>>privatePort (in category 'private') -----
- privatePort
-
- ^port!
Item was removed:
- ----- Method: FormCanvas>>privateWarp:transform:at:sourceRect:cellSize: (in category 'private') -----
- privateWarp: aForm transform: aTransform at: extraOffset sourceRect: sourceRect cellSize: cellSize
- "Warp the given using the appropriate transform and offset."
- | globalRect sourceQuad warp tfm |
- tfm := aTransform.
- globalRect := tfm localBoundsToGlobal: sourceRect.
- sourceQuad := (tfm sourceQuadFor: globalRect) collect:[:p| p - sourceRect topLeft].
- extraOffset ifNotNil:[globalRect := globalRect translateBy: extraOffset].
- warp := (WarpBlt toForm: port destForm)
- combinationRule: Form paint;
- sourceQuad: sourceQuad destRect: (globalRect origin corner: globalRect corner+(1 at 1));
- clipRect: port clipRect.
- warp cellSize: cellSize.
- warp sourceForm: aForm.
- warp warpBits!
Item was removed:
- ----- Method: FormCanvas>>render: (in category 'drawing') -----
- render: anObject
- "Do some 3D operations with the object if possible"
- ^self asBalloonCanvas render: anObject!
Item was removed:
- ----- Method: FormCanvas>>reset (in category 'initialization') -----
- reset
-
- origin := 0 at 0. "origin of the top-left corner of this cavas"
- form ifNil:[
- "This code path will never be executed after the changes in setForm:
- are installed, so it can be removed in due time."
- clipRect := (0 at 0 corner: 10000 at 10000).
- ] ifNotNil:[
- clipRect := (0 at 0 corner: form extent). "default clipping rectangle"
- ].
- self shadowColor: nil.!
Item was removed:
- ----- Method: FormCanvas>>resetGrafPort (in category 'private') -----
- resetGrafPort
- "Private!! Create a new grafPort for a new copy."
-
- port := self portClass toForm: form.
- port clipRect: clipRect.
- !
Item was removed:
- ----- Method: FormCanvas>>setClearColor: (in category 'private') -----
- setClearColor: aColor
- "Install a new clear color - e.g., a color is used for clearing the background"
- | clearColor |
- clearColor := aColor ifNil:[Color transparent].
- clearColor isColor ifFalse:[
- (clearColor isKindOf: InfiniteForm) ifFalse:[^self error:'Cannot install color'].
- ^port fillPattern: clearColor; combinationRule: Form over].
- "Okay, so clearColor really *is* a color"
- port sourceForm: nil.
- port combinationRule: Form over.
- port fillPattern: clearColor.
- self depth = 8 ifTrue:[
- "Use a stipple pattern"
- port fillColor: (form balancedPatternFor: clearColor)].
- !
Item was removed:
- ----- Method: FormCanvas>>setFillColor: (in category 'private') -----
- setFillColor: aColor
- "Install a new color used for filling."
- | screen patternWord fillColor |
- fillColor := self shadowColor ifNil:[aColor].
- fillColor ifNil:[fillColor := Color transparent].
- fillColor isColor ifFalse:[
- (fillColor isKindOf: InfiniteForm) ifFalse:[^self error:'Cannot install color'].
- ^port fillPattern: fillColor; combinationRule: Form over].
- "Okay, so fillColor really *is* a color"
- port sourceForm: nil.
- fillColor isTranslucent ifFalse:[
- port combinationRule: Form over.
- port fillPattern: fillColor.
- self depth = 8 ifTrue:[
- "In 8 bit depth it's usually a good idea to use a stipple pattern"
- port fillColor: (form balancedPatternFor: fillColor)].
- ^self].
- "fillColor is some translucent color"
-
- self depth > 8 ifTrue:[
- "BitBlt setup for alpha masked transfer"
- port fillPattern: fillColor.
- self depth = 16
- ifTrue:[port alphaBits: fillColor privateAlpha; combinationRule: 30]
- ifFalse:[port combinationRule: Form blend].
- ^self].
- "Can't represent actual transparency -- use stipple pattern"
- screen := Color translucentMaskFor: fillColor alpha depth: self depth.
- patternWord := form pixelWordFor: fillColor.
- port fillPattern: (screen collect: [:maskWord | maskWord bitAnd: patternWord]).
- port combinationRule: Form paint.
- !
Item was removed:
- ----- Method: FormCanvas>>setForm: (in category 'private') -----
- setForm: aForm
-
- form := aForm.
- port := self portClass toForm: form.
- self reset.!
Item was removed:
- ----- Method: FormCanvas>>setOrigin:clipRect: (in category 'private') -----
- setOrigin: aPoint clipRect: aRectangle
-
- origin := aPoint.
- clipRect := aRectangle.
- port clipRect: aRectangle.
- !
Item was removed:
- ----- Method: FormCanvas>>setPaintColor: (in category 'private') -----
- setPaintColor: aColor
- "Install a new color used for filling."
- | paintColor screen patternWord |
- paintColor := self shadowColor ifNil:[aColor].
- paintColor ifNil:[paintColor := Color transparent].
- paintColor isColor ifFalse:[
- (paintColor isKindOf: InfiniteForm) ifFalse:[^self error:'Cannot install color'].
- ^port fillPattern: paintColor; combinationRule: Form paint].
- "Okay, so paintColor really *is* a color"
- port sourceForm: nil.
- (paintColor isTranslucent) ifFalse:[
- port fillPattern: paintColor.
- port combinationRule: Form paint.
- self depth = 8 ifTrue:[
- port fillColor: (form balancedPatternFor: paintColor)].
- ^self].
- "paintColor is translucent color"
-
- self depth > 8 ifTrue:[
- "BitBlt setup for alpha mapped transfer"
- port fillPattern: paintColor.
- self depth = 16
- ifTrue:[port alphaBits: paintColor privateAlpha; combinationRule: 31]
- ifFalse:[port combinationRule: Form blend].
- ^self].
-
- "Can't represent actual transparency -- use stipple pattern"
- screen := Color translucentMaskFor: paintColor alpha depth: self depth.
- patternWord := form pixelWordFor: paintColor.
- port fillPattern: (screen collect: [:maskWord | maskWord bitAnd: patternWord]).
- port combinationRule: Form paint
- !
Item was removed:
- ----- Method: FormCanvas>>shadowColor (in category 'accessing') -----
- shadowColor
- ^shadowColor!
Item was removed:
- ----- Method: FormCanvas>>shadowColor: (in category 'accessing') -----
- shadowColor: aColor
- shadowColor := aColor!
Item was removed:
- ----- Method: FormCanvas>>showAt: (in category 'other') -----
- showAt: pt
-
- ^ form displayAt: pt!
Item was removed:
- ----- Method: FormCanvas>>showAt:invalidRects: (in category 'other') -----
- showAt: pt invalidRects: updateRects
- "Show the receiver's bits (i.e, the form it is currently drawing on) on the screen, which is represented by the global Display form.
-
- NOTE THAT #copyBits has the side effect of calling #primShowRectLeft:right:top:bottom: if the blitting target is that Display form. Thus, it is similar to calling #forceDamageToScreen: with updateRects after modifying Display directly but in deferred-drawing mode.
-
- NOTE THAT not all platforms support deferred updates even though they are not failing in #deferUpdates:. Thus, this method has no practical benefit these days unless forced via #disableDeferredUpdates:."
-
- | blt |
- blt := (BitBlt toForm: Display)
- sourceForm: form;
- combinationRule: Form over.
- updateRects do:
- [:rect |
- blt sourceRect: rect;
- destOrigin: rect topLeft + pt;
- copyBits "...entails #primShowRect:... see above"]!
Item was removed:
- ----- Method: FormCanvas>>stencil:at:sourceRect:color: (in category 'drawing-images') -----
- stencil: stencilForm at: aPoint sourceRect: sourceRect color: aColor
- "Flood this canvas with aColor wherever stencilForm has non-zero pixels"
- self setPaintColor: aColor.
- port colorMap: stencilForm maskingMap.
- port stencil: stencilForm
- at: aPoint + origin
- sourceRect: sourceRect.!
Item was removed:
- ----- Method: FormCanvas>>transformBy:clippingTo:during:smoothing: (in category 'drawing-support') -----
- transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize
-
- "Note: This method has been originally copied from TransformationMorph."
- | innerRect patchRect sourceQuad warp start subCanvas |
- aDisplayTransform isPureTranslation ifTrue: [
- ^ self
- translateBy: (aDisplayTransform localPointToGlobal: 0 at 0) truncated
- clippingTo: aClipRect
- during: aBlock].
- "Prepare an appropriate warp from patch to innerRect"
- innerRect := aClipRect.
- patchRect := (aDisplayTransform globalBoundsToLocal: innerRect) truncated.
- sourceQuad := (aDisplayTransform sourceQuadFor: innerRect)
- collect: [:p | p - patchRect topLeft].
- warp := self warpFrom: sourceQuad toRect: innerRect.
- warp cellSize: cellSize.
-
- "Render the submorphs visible in the clipping rectangle, as patchForm"
- start := (self depth = 1 and: [self isShadowDrawing not])
- "If this is true B&W, then we need a first pass for erasure."
- ifTrue: [1] ifFalse: [2].
- start to: 2 do:
- [:i | "If i=1 we first make a shadow and erase it for opaque whites in B&W"
- subCanvas := self class extent: patchRect extent depth: self depth.
- i=1 ifTrue: [subCanvas shadowColor: Color black.
- warp combinationRule: Form erase]
- ifFalse: [self isShadowDrawing ifTrue:
- [subCanvas shadowColor: self shadowColor].
- warp combinationRule: (self depth = 32
- ifTrue: [Form blendAlphaScaled]
- ifFalse: [Form paint])].
- subCanvas
- translateBy: patchRect topLeft negated
- during: aBlock.
- warp sourceForm: subCanvas form; warpBits.
- warp sourceForm: nil. subCanvas := nil "release space for next loop"]
- !
Item was removed:
- ----- Method: FormCanvas>>translateBy:during: (in category 'drawing-support') -----
- translateBy: delta during: aBlock
- "Set a translation only during the execution of aBlock."
- ^aBlock value: (self copyOffset: delta)!
Item was removed:
- ----- Method: FormCanvas>>translateTo:clippingTo:during: (in category 'drawing-support') -----
- translateTo: newOrigin clippingTo: aRectangle during: aBlock
- "Set a new origin and clipping rectangle only during the execution of aBlock."
- aBlock value: (self copyOrigin: newOrigin clipRect: aRectangle)!
Item was removed:
- ----- Method: FormCanvas>>warpFrom:toRect: (in category 'other') -----
- warpFrom: sourceQuad toRect: destRect
- ^ (WarpBlt toForm: port destForm)
- combinationRule: Form paint;
- sourceQuad: sourceQuad destRect: (destRect translateBy: origin);
- clipRect: clipRect!
Item was removed:
- ----- Method: FormCanvas>>warpImage:transform:at:sourceRect:cellSize: (in category 'drawing-images') -----
- warpImage: aForm transform: aTransform at: extraOffset sourceRect: sourceRect cellSize: cellSize
- "Warp the given using the appropriate transform and offset."
- | tfm |
- tfm := (MatrixTransform2x3 withOffset: origin) composedWithLocal: aTransform.
- ^self privateWarp: aForm transform: tfm at: extraOffset sourceRect: sourceRect cellSize: cellSize!
Item was removed:
- RectangleMorph subclass: #GradientDisplayMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
Item was removed:
- ----- Method: GradientDisplayMorph>>colorRamp (in category 'accessing') -----
- colorRamp
- ^self fillStyle colorRamp!
Item was removed:
- ----- Method: GradientDisplayMorph>>colorRamp: (in category 'accessing') -----
- colorRamp: aColorRamp
- self fillStyle colorRamp: aColorRamp!
Item was removed:
- ----- Method: GradientDisplayMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- "Draw a hatch pattern first."
- aCanvas
- fillRectangle: self innerBounds
- fillStyle: (InfiniteForm with: ColorPresenterMorph hatchForm).
- super drawOn: aCanvas!
Item was removed:
- ----- Method: GradientDisplayMorph>>initialize (in category 'initialization') -----
- initialize
- | fill colorRamp |
- super initialize.
- "self hResizing: #spaceFill. "
- colorRamp := {0.0 -> Color green. 0.3 -> Color red. 0.7 -> Color black. 1.0 -> Color blue}.
- fill := GradientFillStyle ramp: colorRamp.
- fill origin: 0 at 0.
- fill direction: self bounds extent x @ 0.
- fill radial: false.
- self fillStyle: fill!
Item was removed:
- RectangleMorph subclass: #GradientEditor
- instanceVariableNames: 'gradientDisplay rampMorphs selectedSketch row text target selector morph'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
Item was removed:
- ----- Method: GradientEditor class>>on:selector:forMorph:colorRamp: (in category 'instance creation') -----
- on: aTarget selector: aSelector forMorph: aMorph colorRamp: aColorRamp
- ^self new
- setTarget: aTarget
- selector: aSelector
- forMorph: aMorph
- colorRamp: aColorRamp.
-
- !
Item was removed:
- ----- Method: GradientEditor>>addButtonRow (in category 'initialization') -----
- addButtonRow
- | button button2 buttonRow button3 |
- buttonRow := RectangleMorph new borderWidth: 0;
- color: Color transparent;
- layoutPolicy: TableLayout new;
- hResizing: #spaceFill;
- vResizing: #spaceFill;
- cellPositioning: #center;
- listCentering: #topLeft;
- listDirection: #LeftToRight;
- reverseTableCells: true;
- cellGap: 4.
-
- button := PluggableButtonMorph on: self
- getState: nil
- action: #addHandle
- label: #addColorButtonLabel.
- button hResizing: #spaceFill;
- vResizing: #spaceFill.
- buttonRow addMorph: button.
-
- button2 := PluggableButtonMorph on: self
- getState: nil
- action: #deleteHandle
- label: #removeColorButtonLabel.
- button2 hResizing: #spaceFill;
- vResizing: #spaceFill.
- buttonRow addMorph: button2.
-
- button3 := PluggableButtonMorph on: self
- getState: nil
- action: #delete
- label: #closeButtonLabel.
- button3 hResizing: #spaceFill;
- vResizing: #spaceFill.
- buttonRow addMorph: button3.
-
- self addMorph: buttonRow!
Item was removed:
- ----- Method: GradientEditor>>addColorButtonLabel (in category 'initialization') -----
- addColorButtonLabel
- ^ 'Add color' translated!
Item was removed:
- ----- Method: GradientEditor>>addHandle (in category 'change reporting') -----
- addHandle
- self addHandleForColor: Color random position: 0.5.
- self updateColorRamp!
Item was removed:
- ----- Method: GradientEditor>>addHandleForColor:position: (in category 'change reporting') -----
- addHandleForColor: aColor position: aPosition
- | handleInstance colorIcon delta |
- handleInstance := self handle.
- colorIcon := SketchMorph
- withForm: ((aColor iconOrThumbnailOfSize: 20) borderWidth: 1 color: Color black)..
- self eventHandler: colorIcon target: colorIcon.
- self eventHandler: handleInstance target: self.
- row addMorph: handleInstance.
- delta := gradientDisplay left - 10 + (gradientDisplay width * aPosition).
- handleInstance position: delta @ (gradientDisplay top - 18).
- colorIcon position: delta @ (gradientDisplay bottom + 5).
- handleInstance addMorph: colorIcon.
- rampMorphs addLast: handleInstance.
-
- !
Item was removed:
- ----- Method: GradientEditor>>addHandles (in category 'change reporting') -----
- addHandles
- | handle colorRamp |
- rampMorphs := OrderedCollection new.
- colorRamp := gradientDisplay colorRamp asOrderedCollection.
- handle := self handle.
- colorRamp
- do: [:i |
- self addHandleForColor: i value position: i key
- ].
-
- self changed.!
Item was removed:
- ----- Method: GradientEditor>>changeColor:event:target: (in category 'change reporting') -----
- changeColor: aSketchMorph event: evt target: aMorph
- | newColor |
- newColor := aSketchMorph rotatedForm colorAt: aSketchMorph rotatedForm center.
- selectedSketch := aSketchMorph.
- self changeColorTarget: self selector: #updateColor: originalColor: newColor value hand: evt hand.
- !
Item was removed:
- ----- Method: GradientEditor>>closeButtonLabel (in category 'initialization') -----
- closeButtonLabel
- ^ 'Close' translated!
Item was removed:
- ----- Method: GradientEditor>>colorRamp (in category 'accessing') -----
- colorRamp
- ^gradientDisplay fillStyle colorRamp asArray printString.
- !
Item was removed:
- ----- Method: GradientEditor>>colorRamp: (in category 'accessing') -----
- colorRamp: aColorRamp
- gradientDisplay colorRamp: aColorRamp.
- self changed: #colorRamp.
- self changed
-
- !
Item was removed:
- ----- Method: GradientEditor>>colorRampExpression: (in category 'accessing') -----
- colorRampExpression: aString
- "Set my color by evaluating aString, a Smalltalk expression which results in a Color instance."
- | col |
-
- {aString.}
- detect:
- [ : each | ([ col := Compiler evaluate: each ]
- on: Error
- do:
- [ : err | nil ]) notNil ]
- ifNone: [ nil ].
- col ifNotNil: [ self colorRamp: col.
- rampMorphs do:[ :each| each delete].
- self addHandles; updateColorRamp. ]!
Item was removed:
- ----- Method: GradientEditor>>colorRampExpressionMorph (in category 'initialization') -----
- colorRampExpressionMorph
- | inputField builder |
- builder := ToolBuilder default.
- inputField := (builder build: (builder pluggableInputFieldSpec new
- model: self;
- getText: #colorRamp;
- setText: #colorRampExpression:;
- softLineWrap: true)).
- inputField
- hResizing: #spaceFill ;
- vResizing: #spaceFill ;
-
- height: (Preferences standardDefaultTextFont height * 3/2).
- ^ inputField!
Item was removed:
- ----- Method: GradientEditor>>deleteHandle (in category 'change reporting') -----
- deleteHandle
- rampMorphs do:[ :i | (i color == Color black) ifTrue:[ rampMorphs remove: i. row removeMorph: i]].
- self updateColorRamp
-
- !
Item was removed:
- ----- Method: GradientEditor>>eventHandler:target: (in category 'event handling') -----
- eventHandler: anInstance target: aTarget
- (anInstance isKindOf: SketchMorph)
- ifTrue: [anInstance
- on: #mouseUp
- send: #changeColor:event:target:
- to: self
- withValue: aTarget]
- ifFalse: [anInstance
- on: #mouseDown
- send: #limitHandleMove:event:from:
- to: self
- withValue: aTarget.
- anInstance
- on: #mouseMove
- send: #limitHandleMove:event:from:
- to: self
- withValue: aTarget]!
Item was removed:
- ----- Method: GradientEditor>>handle (in category 'initialization') -----
- handle
- | handle |
- handle := PolygonMorph
- vertices: (Array
- with: 0 @ 0
- with: 16 @ 0
- with: 8 @ 16)
- color: Color white darker
- borderWidth: 1
- borderColor: Color black.
- ^ handle
- addMorph: ((RectangleMorph
- newBounds: (8 @ 18 extent: 1 @ (gradientDisplay height - 2))
- color: Color orange)
- borderWidth: 0)!
Item was removed:
- ----- Method: GradientEditor>>initialize (in category 'initialization') -----
- initialize
- super initialize.
- self myLayout.
- self extent: 500 @ 200.
- row := RectangleMorph new extent: self width @ 100;
- color: Color transparent;
- borderStyle: BorderStyle inset.
- row addMorph: (gradientDisplay := GradientDisplayMorph new position: 20 @ 20;
- extent: self width - 40 @ 40).
- gradientDisplay fillStyle direction: gradientDisplay width @ 0.
- self addMorph: row.
- self addButtonRow.
- self addMorph: self colorRampExpressionMorph!
Item was removed:
- ----- Method: GradientEditor>>limitHandleMove:event:from: (in category 'change reporting') -----
- limitHandleMove: association event: evt from: handle
- | p newBounds |
- rampMorphs do:[ : i | i color: (Color white darker)].
- newBounds := gradientDisplay bounds.
- newBounds := (newBounds left: (newBounds left - 10)).
- newBounds := (newBounds right: (newBounds right - 10)).
- p := (evt cursorPoint - (10 at 0)) adhereTo: newBounds.
- handle position: (p x )@ (handle position y).
- handle color: Color black.
- self updateColorRamp!
Item was removed:
- ----- Method: GradientEditor>>morph: (in category 'accessing') -----
- morph: aMorph
- ^morph := aMorph!
Item was removed:
- ----- Method: GradientEditor>>myLayout (in category 'initialization') -----
- myLayout
- self color: (Color white darker) ;
- cornerStyle: #rounded ;
- borderWidth: 0;
- layoutPolicy: TableLayout new;
- hResizing: #shrinkWrap;
- vResizing: #shrinkWrap;
- cellPositioning: #center;
- listCentering: #topLeft;
- layoutInset: 4;
- listDirection: #topToBottom;
- reverseTableCells: true;
- wrapCentering: #topLeft;
- cellGap: 4!
Item was removed:
- ----- Method: GradientEditor>>removeColorButtonLabel (in category 'initialization') -----
- removeColorButtonLabel
- ^ 'Remove color' translated!
Item was removed:
- ----- Method: GradientEditor>>selector: (in category 'accessing') -----
- selector: aSelector
- ^selector := aSelector!
Item was removed:
- ----- Method: GradientEditor>>setTarget:selector:forMorph:colorRamp: (in category 'initialization') -----
- setTarget: aTarget selector: aSelector forMorph:aMorph colorRamp: aColorRamp
-
- self target: aTarget; selector: aSelector; morph: aMorph; colorRamp: aColorRamp; addHandles
-
- !
Item was removed:
- ----- Method: GradientEditor>>target: (in category 'accessing') -----
- target: aTarget
- ^target := aTarget!
Item was removed:
- ----- Method: GradientEditor>>updateColor: (in category 'change reporting') -----
- updateColor: aColor
- selectedSketch rotatedForm floodFill: aColor at: selectedSketch rotatedForm center.
- self updateColorRamp
- !
Item was removed:
- ----- Method: GradientEditor>>updateColorRamp (in category 'change reporting') -----
- updateColorRamp
- | newAssociation newKey newColor sketch colorRamp |
-
- self updateRampMorphs.
- colorRamp := OrderedCollection new.
- rampMorphs
- do: [:i |
- newKey := ((i position x - gradientDisplay left / gradientDisplay width) asFloat roundUpTo: 0.01)
- min: 1.0
- max: 0.0.
- sketch := i findA: SketchMorph.
- newColor := sketch rotatedForm colorAt: sketch rotatedForm center.
- newAssociation := newKey -> newColor.
- colorRamp addLast: newAssociation].
- colorRamp := colorRamp sorted.
- gradientDisplay colorRamp: colorRamp.
- gradientDisplay fillStyle direction: gradientDisplay extent x @ 0.
- self changed.
- target ifNotNil:[
- target perform: selector
- with: colorRamp
- with: morph].
- self changed: #colorRamp!
Item was removed:
- ----- Method: GradientEditor>>updateRampMorphs (in category 'change reporting') -----
- updateRampMorphs
- rampMorphs do:[ :i | i isInWorld ifFalse:[ rampMorphs remove: i]]!
Item was removed:
- ----- Method: GradientFillStyle>>addFillStyleMenuItems:hand:from: (in category '*Morphic-Balloon') -----
- addFillStyleMenuItems: aMenu hand: aHand from: aMorph
- "Add the items for changing the current fill style of the receiver"
- self isRadialFill ifTrue:[
- aMenu add: 'linear gradient' translated target: self selector: #beLinearGradientIn: argument: aMorph.
- ] ifFalse:[
- aMenu add: 'radial gradient' translated target: self selector: #beRadialGradientIn: argument: aMorph.
- ].
- aMenu addLine.
- aMenu add: 'change color ramp' translated target: self selector: #changeColorRampIn:event: argument: aMorph.
- aMenu addLine.
- super addFillStyleMenuItems: aMenu hand: aHand from: aMorph.!
Item was removed:
- ----- Method: GradientFillStyle>>addNewColorIn:event: (in category '*Morphic-Balloon') -----
- addNewColorIn: aMorph event: evt
- ^self inform:'not yet implemented'!
Item was removed:
- ----- Method: GradientFillStyle>>beLinearGradientIn: (in category '*Morphic-Balloon') -----
- beLinearGradientIn: aMorph
- self radial: false.
- aMorph changed.!
Item was removed:
- ----- Method: GradientFillStyle>>beRadialGradientIn: (in category '*Morphic-Balloon') -----
- beRadialGradientIn: aMorph
- self radial: true.
- aMorph changed.!
Item was removed:
- ----- Method: GradientFillStyle>>changeColorRampIn:event: (in category '*Morphic-Balloon') -----
- changeColorRampIn: aMorph event: evt
- ^self changeColorSelector: #colorRamp:forMorph: hand: evt hand morph: aMorph originalColor:aMorph fillStyle colorRamp!
Item was removed:
- ----- Method: GradientFillStyle>>changeColorSelector:hand:morph:originalColor: (in category '*Morphic-Balloon') -----
- changeColorSelector: aSymbol hand: aHand morph: aMorph originalColor: originalColor
- "Change either the firstColor or the lastColor (depending on aSymbol). Put up a color picker to hande it. We always use a modal picker so that the user can adjust both colors concurrently."
-
- ^(GradientEditor on: self selector: aSymbol forMorph: aMorph colorRamp: originalColor) openNear: aMorph fullBoundsInWorld.
-
-
- "NewColorPickerMorph useIt
- ifTrue:
- [ (NewColorPickerMorph
- on: self
- originalColor: originalColor
- setColorSelector: aSymbol) openNear: aMorph fullBoundsInWorld ]
- ifFalse:
- [ ColorPickerMorph new
- initializeModal: false ;
- sourceHand: aHand ;
- target: self ;
- selector: aSymbol ;
- argument: aMorph ;
- originalColor: originalColor ;
-
- putUpFor: aMorph
- near: aMorph fullBoundsInWorld ]"!
Item was removed:
- ----- Method: GradientFillStyle>>changeFirstColorIn:event: (in category '*Morphic-Balloon') -----
- changeFirstColorIn: aMorph event: evt
- ^self changeColorSelector: #firstColor:forMorph:hand: hand: evt hand morph: aMorph originalColor: colorRamp first value!
Item was removed:
- ----- Method: GradientFillStyle>>changeSecondColorIn:event: (in category '*Morphic-Balloon') -----
- changeSecondColorIn: aMorph event: evt
- ^self changeColorSelector: #lastColor:forMorph:hand: hand: evt hand morph: aMorph originalColor: colorRamp last value!
Item was removed:
- ----- Method: GradientFillStyle>>colorRamp:forMorph: (in category '*Morphic-Balloon') -----
- colorRamp: aColorRamp forMorph: aMorph
- colorRamp :=aColorRamp.
- isTranslucent := nil.
- pixelRamp := nil.
- aMorph changed.!
Item was removed:
- ----- Method: GradientFillStyle>>firstColor:forMorph:hand: (in category '*Morphic-Balloon') -----
- firstColor: aColor forMorph: aMorph hand: aHand
- colorRamp first value: aColor.
- isTranslucent := nil.
- pixelRamp := nil.
- aMorph changed.!
Item was removed:
- ----- Method: GradientFillStyle>>lastColor:forMorph:hand: (in category '*Morphic-Balloon') -----
- lastColor: aColor forMorph: aMorph hand: aHand
- colorRamp last value: aColor.
- isTranslucent := nil.
- pixelRamp := nil.
- aMorph changed.!
Item was removed:
- BitBlt subclass: #GrafPort
- instanceVariableNames: 'alpha fillPattern lastFont lastFontForegroundColor lastFontBackgroundColor'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Support'!
Item was removed:
- ----- Method: GrafPort>>alphaBits: (in category 'accessing') -----
- alphaBits: a
- alpha := a!
Item was removed:
- ----- Method: GrafPort>>clippedBy: (in category 'copying') -----
- clippedBy: aRectangle
- ^ self copy clipBy: aRectangle!
Item was removed:
- ----- Method: GrafPort>>contentsOfArea:into: (in category 'accessing') -----
- contentsOfArea: aRectangle into: aForm
- destForm
- displayOn: aForm
- at: aRectangle origin
- clippingBox: (0 at 0 extent: aRectangle extent).
- ^aForm!
Item was removed:
- ----- Method: GrafPort>>copyBits (in category 'copying') -----
- copyBits
- "Override copybits to do translucency if desired"
-
- (combinationRule >= 30 and: [combinationRule <= 31])
- ifTrue: [
- self copyBitsTranslucent: (alpha ifNil: [255])]
- ifFalse: [super copyBits]!
Item was removed:
- ----- Method: GrafPort>>displayScannerFor:foreground:background:ignoreColorChanges: (in category 'accessing') -----
- displayScannerFor: para foreground: foreColor background: backColor ignoreColorChanges: shadowMode
- ^ (DisplayScanner new text: para text textStyle: para textStyle
- foreground: foreColor background: backColor fillBlt: self
- ignoreColorChanges: shadowMode)
- setPort: self shallowCopy
- !
Item was removed:
- ----- Method: GrafPort>>fillOval: (in category 'drawing support') -----
- fillOval: rect
- | centerX centerY nextY yBias xBias outer nextOuterX |
- rect area <= 0 ifTrue: [^ self].
- height := 1.
- yBias := rect height odd ifTrue: [0] ifFalse: [-1].
- xBias := rect width odd ifTrue: [1] ifFalse: [0].
- centerX := rect center x.
- centerY := rect center y.
- outer := EllipseMidpointTracer new on: rect.
- nextY := rect height // 2.
- [nextY > 0] whileTrue:[
- nextOuterX := outer stepInY.
- width := (nextOuterX bitShift: 1) + xBias.
- destX := centerX - nextOuterX.
- destY := centerY - nextY.
- self copyBits.
- destY := centerY + nextY + yBias.
- self copyBits.
- nextY := nextY - 1.
- ].
- destY := centerY.
- height := 1 + yBias.
- width := rect width.
- destX := rect left.
- self copyBits.
- !
Item was removed:
- ----- Method: GrafPort>>fillPattern: (in category 'accessing') -----
- fillPattern: anObject
- fillPattern := anObject.
- self fillColor: anObject.!
Item was removed:
- ----- Method: GrafPort>>fillRect:offset: (in category 'drawing support') -----
- fillRect: rect offset: aPoint
- "The offset is really just for stupid InfiniteForms."
- | fc |
- fillPattern class == InfiniteForm ifTrue:[
- fc := halftoneForm.
- self fillColor: nil.
- fillPattern displayOnPort: ((self clippedBy: rect) colorMap: nil) at: aPoint.
- halftoneForm := fc.
- ^self].
-
- destX := rect left.
- destY := rect top.
- sourceX := 0.
- sourceY := 0.
- width := rect width.
- height := rect height.
- self copyBits.!
Item was removed:
- ----- Method: GrafPort>>fillRoundRect:radius: (in category 'drawing support') -----
- fillRoundRect: aRectangle radius: radius
- | nextY outer nextOuterX ovalDiameter rectExtent rectOffset rectX rectY rectWidth rectHeight ovalRadius ovalRect |
- aRectangle area <= 0 ifTrue: [^ self].
- ovalDiameter := (radius * 2) asPoint min: aRectangle extent.
- (ovalDiameter x <= 0 or:[ovalDiameter y <= 0]) ifTrue:[
- ^self fillRect: aRectangle offset: 0 at 0.
- ].
- "force diameter to be even - this simplifies lots of stuff"
- ovalRadius := (ovalDiameter x // 2) @ (ovalDiameter y // 2).
- (ovalRadius x <= 0 or:[ovalRadius y <= 0]) ifTrue:[
- ^self fillRect: aRectangle offset: 0 at 0.
- ].
- ovalDiameter := ovalRadius * 2.
- rectExtent := aRectangle extent - ovalDiameter.
- rectWidth := rectExtent x.
- rectHeight := rectExtent y.
- rectOffset := aRectangle origin + ovalRadius.
- rectX := rectOffset x.
- rectY := rectOffset y.
-
- ovalRect := ovalRadius negated extent: ovalDiameter.
-
- height := 1.
- outer := EllipseMidpointTracer new on: ovalRect.
- nextY := ovalRadius y.
- "upper and lower portions of round rect"
- [nextY > 0] whileTrue:[
- nextOuterX := outer stepInY.
- width := nextOuterX * 2 + rectWidth.
- destX := rectX - nextOuterX.
- destY := rectY - nextY.
- self copyBits.
- destY := rectY + nextY + rectHeight - 1.
- self copyBits.
- nextY := nextY - 1.
- ].
- destX := aRectangle left.
- destY := rectOffset y.
- height := rectHeight.
- width := aRectangle width.
- self copyBits.
- !
Item was removed:
- ----- Method: GrafPort>>frameOval:borderWidth: (in category 'drawing support') -----
- frameOval: rect borderWidth: borderWidth
- | centerX centerY nextY yBias xBias wp outer inner nextOuterX nextInnerX fillAlpha |
- rect area <= 0 ifTrue: [^ self].
- height := 1.
- wp := borderWidth asPoint.
- yBias := rect height odd ifTrue: [0] ifFalse: [-1].
- xBias := rect width odd ifTrue: [1] ifFalse: [0].
- centerX := rect center x.
- centerY := rect center y.
- outer := EllipseMidpointTracer new on: rect.
- inner := EllipseMidpointTracer new on: (rect insetBy: wp).
- nextY := rect height // 2.
- 1 to: (wp y min: nextY) do:[:i|
- nextOuterX := outer stepInY.
- width := (nextOuterX bitShift: 1) + xBias.
- destX := centerX - nextOuterX.
- destY := centerY - nextY.
- self copyBits.
- destY := centerY + nextY + yBias.
- self copyBits.
- nextY := nextY - 1.
- ].
- [nextY > 0] whileTrue:[
- nextOuterX := outer stepInY.
- nextInnerX := inner stepInY.
- destX := centerX - nextOuterX.
- destY := centerY - nextY.
- width := nextOuterX - nextInnerX.
- self copyBits.
- destX := centerX + nextInnerX + xBias.
- self copyBits.
- destX := centerX - nextOuterX.
- destY := centerY + nextY + yBias.
- self copyBits.
- destX := centerX + nextInnerX + xBias.
- self copyBits.
- nextY := nextY - 1.
- ].
- destY := centerY.
- height := 1 + yBias.
- width := wp x.
- destX := rect left.
- self copyBits.
- destX := rect right - wp x.
- self copyBits.
- !
Item was removed:
- ----- Method: GrafPort>>frameRect:borderWidth: (in category 'drawing support') -----
- frameRect: rect borderWidth: borderWidth
- sourceX := 0.
- sourceY := 0.
- (rect areasOutside: (rect insetBy: borderWidth)) do:
- [:edgeStrip | self destRect: edgeStrip; copyBits].
- !
Item was removed:
- ----- Method: GrafPort>>frameRectBottom:height: (in category 'drawing support') -----
- frameRectBottom: rect height: h
-
- destX := rect left + 1.
- destY := rect bottom - 1.
- width := rect width - 2.
- height := 1.
- 1 to: h do: [:i |
- self copyBits.
- destX := destX + 1.
- destY := destY - 1.
- width := width - 2].
- !
Item was removed:
- ----- Method: GrafPort>>frameRectRight:width: (in category 'drawing support') -----
- frameRectRight: rect width: w
-
- width := 1.
- height := rect height - 1.
- destX := rect right - 1.
- destY := rect top + 1.
- 1 to: w do: [:i |
- self copyBits.
- destX := destX - 1.
- destY := destY + 1.
- height := height - 2].
- !
Item was removed:
- ----- Method: GrafPort>>frameRoundRect:radius:borderWidth: (in category 'drawing support') -----
- frameRoundRect: aRectangle radius: radius borderWidth: borderWidth
- | nextY outer nextOuterX ovalDiameter rectExtent rectOffset rectX rectY rectWidth rectHeight ovalRadius ovalRect innerRadius innerDiameter innerRect inner nextInnerX wp |
- aRectangle area <= 0 ifTrue: [^ self].
- ovalDiameter := (radius * 2) asPoint min: aRectangle extent.
- (ovalDiameter x <= 0 or:[ovalDiameter y <= 0]) ifTrue:[
- ^self fillRect: aRectangle offset: 0 at 0.
- ].
- "force diameter to be even - this simplifies lots of stuff"
- ovalRadius := (ovalDiameter x // 2) @ (ovalDiameter y // 2).
- (ovalRadius x <= 0 or:[ovalRadius y <= 0]) ifTrue:[
- ^self fillRect: aRectangle offset: 0 at 0.
- ].
- wp := borderWidth asPoint.
- ovalDiameter := ovalRadius * 2.
- innerRadius := ovalRadius - borderWidth max: 0 at 0.
- innerDiameter := innerRadius * 2.
-
- rectExtent := aRectangle extent - ovalDiameter.
- rectWidth := rectExtent x.
- rectHeight := rectExtent y.
-
- rectOffset := aRectangle origin + ovalRadius.
- rectX := rectOffset x.
- rectY := rectOffset y.
-
- ovalRect := 0 at 0 extent: ovalDiameter.
- innerRect := 0 at 0 extent: innerDiameter.
-
- height := 1.
- outer := EllipseMidpointTracer new on: ovalRect.
- inner := EllipseMidpointTracer new on: innerRect.
-
- nextY := ovalRadius y.
-
- 1 to: (wp y min: nextY) do:[:i|
- nextOuterX := outer stepInY.
- width := nextOuterX * 2 + rectWidth.
- destX := rectX - nextOuterX.
- destY := rectY - nextY.
- self copyBits.
- destY := rectY + nextY + rectHeight - 1.
- self copyBits.
- nextY := nextY - 1.
- ].
- [nextY > 0] whileTrue:[
- nextOuterX := outer stepInY.
- nextInnerX := inner stepInY.
- destX := rectX - nextOuterX.
- destY := rectY - nextY.
- width := nextOuterX - nextInnerX.
- self copyBits.
- destX := rectX + nextInnerX + rectWidth.
- self copyBits.
- destX := rectX - nextOuterX.
- destY := rectY + nextY + rectHeight-1.
- self copyBits.
- destX := rectX + nextInnerX + rectWidth.
- self copyBits.
- nextY := nextY - 1.
- ].
-
- destX := aRectangle left.
- destY := rectOffset y.
- height := rectHeight.
- width := wp x.
- self copyBits.
- destX := aRectangle right - width.
- self copyBits.
- innerRadius y = 0 ifTrue:[
- destX := aRectangle left + wp x.
- destY := rectY.
- width := aRectangle width - (wp x * 2).
- height := wp y - ovalRadius y.
- self copyBits.
- destY := aRectangle bottom - wp y.
- self copyBits.
- ].!
Item was removed:
- ----- Method: GrafPort>>image:at:sourceRect:rule: (in category 'drawing support') -----
- image: aForm at: aPoint sourceRect: sourceRect rule: rule
- "Draw the portion of the given Form defined by sourceRect at the given point using the given BitBlt combination rule."
-
- sourceForm := aForm.
- combinationRule := rule.
- self sourceRect: sourceRect.
- self destOrigin: aPoint.
- self copyBits!
Item was removed:
- ----- Method: GrafPort>>image:at:sourceRect:rule:alpha: (in category 'drawing support') -----
- image: aForm at: aPoint sourceRect: sourceRect rule: rule alpha: sourceAlpha
- "Draw the portion of the given Form defined by sourceRect at the given point using the given BitBlt combination rule."
-
- sourceForm := aForm.
- combinationRule := rule.
- self sourceRect: sourceRect.
- self destOrigin: aPoint.
- self copyBitsTranslucent: (alpha := (sourceAlpha * 255) truncated min: 255 max: 0).!
Item was removed:
- ----- Method: GrafPort>>installStrikeFont: (in category 'private') -----
- installStrikeFont: aStrikeFont
-
- ^ self installStrikeFont: aStrikeFont foregroundColor: (lastFontForegroundColor ifNil: [Color black]) backgroundColor: (lastFontBackgroundColor ifNil: [Color transparent]).
- !
Item was removed:
- ----- Method: GrafPort>>installStrikeFont:foregroundColor:backgroundColor: (in category 'private') -----
- installStrikeFont: aStrikeFont foregroundColor: foregroundColor backgroundColor: backgroundColor
- super installStrikeFont: aStrikeFont foregroundColor: foregroundColor backgroundColor: backgroundColor.
- aStrikeFont glyphs depth = 1 ifTrue: [
- alpha := foregroundColor privateAlpha.
- "dynamically switch between blend modes to support translucent text"
- "To handle the transition from TTCFont to StrikeFont, rule 34 must be taken into account."
- alpha = 255 ifTrue:[
- combinationRule = 30 ifTrue: [combinationRule := Form over].
- combinationRule = 31 ifTrue: [combinationRule := Form paint].
- combinationRule = 34 ifTrue: [combinationRule := Form paint].
- combinationRule = 41 ifTrue: [combinationRule := Form paint]. "41 is SPRmode"
- ] ifFalse:[
- combinationRule = Form over ifTrue: [combinationRule := 30].
- combinationRule = Form paint ifTrue: [combinationRule := 31].
- combinationRule = 34 ifTrue: [combinationRule := 31].
- combinationRule = 41 ifTrue: [combinationRule := 31]. "41 is SPR mode"
- ]
- ].
- lastFont := aStrikeFont.
- lastFontForegroundColor := foregroundColor.
- lastFontBackgroundColor := backgroundColor.
- !
Item was removed:
- ----- Method: GrafPort>>installTTCFont: (in category 'private') -----
- installTTCFont: aTTCFont
-
- aTTCFont foregroundColor: (lastFontForegroundColor ifNil: [Color black]).
-
- ^ self installTTCFont: aTTCFont foregroundColor: aTTCFont foregroundColor backgroundColor: (lastFontBackgroundColor ifNil: [Color transparent]).
- !
Item was removed:
- ----- Method: GrafPort>>installTTCFont:foregroundColor:backgroundColor: (in category 'private') -----
- installTTCFont: aTTCFont foregroundColor: foregroundColor backgroundColor: backgroundColor
-
- super installTTCFont: aTTCFont foregroundColor: foregroundColor backgroundColor: backgroundColor.
- lastFont := aTTCFont.
- lastFontForegroundColor := foregroundColor.
- lastFontBackgroundColor := backgroundColor.
- !
Item was removed:
- ----- Method: GrafPort>>lastFont (in category 'private') -----
- lastFont
-
- ^ lastFont.
- !
Item was removed:
- ----- Method: GrafPort>>lastFontForegroundColor (in category 'accessing') -----
- lastFontForegroundColor
- ^lastFontForegroundColor!
Item was removed:
- ----- Method: GrafPort>>stencil:at:sourceRect: (in category 'drawing support') -----
- stencil: stencilForm at: aPoint sourceRect: aRect
- "Paint using aColor wherever stencilForm has non-zero pixels"
- self sourceForm: stencilForm;
- destOrigin: aPoint;
- sourceRect: aRect.
- self copyBits!
Item was removed:
- LayoutPolicy subclass: #GridLayout
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Layouts'!
Item was removed:
- ----- Method: GridLayout>>griddedPoint:in: (in category 'layout') -----
- griddedPoint: ungriddedPoint in: container
- "For convenience only. Manually grid a point from the outside."
-
- | properties |
- properties := container assureGridLayoutProperties.
- ^ ((ungriddedPoint - container position - properties origin)
- grid: properties modulus)
- + container position + properties origin!
Item was removed:
- ----- Method: GridLayout>>isGridLayout (in category 'testing') -----
- isGridLayout
-
- ^ true!
Item was removed:
- ----- Method: GridLayout>>layout:in: (in category 'layout') -----
- layout: container in: box
- "Moves and resizes the container's submorphs to snap to the grid cells. Ignore edge-adhereing morphs such as docking bars."
-
- | properties cellOrigin cellExtent |
- properties := container assureGridLayoutProperties.
- container submorphsDo: [:morph |
- (morph disableLayout or: [morph hasProperty: #edgeToAdhereTo]) ifFalse: [
- cellOrigin := ((morph position - container position - properties origin)
- grid: properties modulus)
- + container position + properties origin.
- cellExtent := (morph extent grid: properties modulus) max: properties modulus "= minExtent".
- morph layoutInBounds: (cellOrigin extent: cellExtent) positioning: properties cellPositioning]].!
Item was removed:
- LayoutProperties subclass: #GridLayoutProperties
- instanceVariableNames: 'origin modulus layoutInset'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Layouts'!
Item was removed:
- ----- Method: GridLayoutProperties>>cellPositioning (in category 'accessing') -----
- cellPositioning
-
- ^ #topLeft!
Item was removed:
- ----- Method: GridLayoutProperties>>includesGridLayoutProperties (in category 'testing') -----
- includesGridLayoutProperties
-
- ^ true!
Item was removed:
- ----- Method: GridLayoutProperties>>initialize (in category 'initialize') -----
- initialize
-
- super initialize.
-
- origin := 0 at 0.
- modulus := 8 at 8.
- layoutInset := 0.!
Item was removed:
- ----- Method: GridLayoutProperties>>layoutInset (in category 'accessing') -----
- layoutInset
-
- self flag: #todo. "mt: Move up to LayoutProperties."
- ^ layoutInset!
Item was removed:
- ----- Method: GridLayoutProperties>>layoutInset: (in category 'accessing') -----
- layoutInset: anObject
-
- self flag: #todo. "mt: Move up to LayoutProperties."
- layoutInset := anObject.!
Item was removed:
- ----- Method: GridLayoutProperties>>modulus (in category 'accessing') -----
- modulus
-
- ^ modulus!
Item was removed:
- ----- Method: GridLayoutProperties>>modulus: (in category 'accessing') -----
- modulus: anObject
-
- modulus := anObject.!
Item was removed:
- ----- Method: GridLayoutProperties>>origin (in category 'accessing') -----
- origin
-
- self flag: #discuss. "mt: Is this really needed? We could easily configure this through #layoutInset."
- ^ origin!
Item was removed:
- ----- Method: GridLayoutProperties>>origin: (in category 'accessing') -----
- origin: anObject
-
- origin := anObject.!
Item was removed:
- BracketSliderMorph subclass: #HColorSelectorMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !HColorSelectorMorph commentStamp: 'gvc 5/18/2007 12:58' prior: 0!
- ColorComponentSelector showing a hue rainbow palette.!
Item was removed:
- ----- Method: HColorSelectorMorph>>color: (in category 'accessing') -----
- color: aColor
- "Ignore to preserve fill style."
- !
Item was removed:
- ----- Method: HColorSelectorMorph>>defaultFillStyle (in category 'accessing - ui') -----
- defaultFillStyle
- "Answer the hue gradient."
-
- ^(GradientFillStyle colors: ((0.0 to: 359.9 by: 0.1) collect: [:a | Color h: a s: 1.0 v: 1.0]))
- origin: self topLeft;
- direction: (self orientation == #horizontal
- ifTrue: [self width at 0]
- ifFalse: [0 at self height])!
Item was removed:
- Morph subclass: #HSVAColorSelectorMorph
- instanceVariableNames: 'hsvMorph aMorph'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !HSVAColorSelectorMorph commentStamp: 'gvc 5/18/2007 12:55' prior: 0!
- Colour selector featuring a saturation/volume area, hue selection strip and alpha selection strip.!
Item was removed:
- ----- Method: HSVAColorSelectorMorph>>aMorph (in category 'accessing') -----
- aMorph
- "The alpha-selector morph."
- ^ aMorph!
Item was removed:
- ----- Method: HSVAColorSelectorMorph>>aMorph: (in category 'accessing') -----
- aMorph: anAColorSelectorMorph
- "The alpha-selector morph."
- aMorph := anAColorSelectorMorph!
Item was removed:
- ----- Method: HSVAColorSelectorMorph>>alphaSelected: (in category 'accessing') -----
- alphaSelected: aFloat
- "The alpha has changed."
-
- self triggerSelectedColor!
Item was removed:
- ----- Method: HSVAColorSelectorMorph>>colorSelected: (in category 'accessing') -----
- colorSelected: aColor
- "A color has been selected. Set the base color for the alpha channel."
-
- self aMorph color: aColor.
- self triggerSelectedColor!
Item was removed:
- ----- Method: HSVAColorSelectorMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "Answer the default color/fill style for the receiver."
-
- ^Color transparent
- !
Item was removed:
- ----- Method: HSVAColorSelectorMorph>>hsvMorph (in category 'accessing') -----
- hsvMorph
- "Answer the value of hsvMorph"
-
- ^ hsvMorph!
Item was removed:
- ----- Method: HSVAColorSelectorMorph>>hsvMorph: (in category 'accessing') -----
- hsvMorph: anObject
- "Set the value of hsvMorph"
-
- hsvMorph := anObject!
Item was removed:
- ----- Method: HSVAColorSelectorMorph>>initialize (in category 'initialization') -----
- initialize
- "Initialize the receiver."
-
- super initialize.
- self
- extent: 180 at 168;
- changeTableLayout;
- cellGap: 4;
- aMorph: self newAColorMorph;
- hsvMorph: self newHSVColorMorph;
- addMorphBack: self hsvMorph;
- addMorphBack: self aMorph.
- self aMorph color: self hsvMorph selectedColor!
Item was removed:
- ----- Method: HSVAColorSelectorMorph>>newAColorMorph (in category 'private - initialization') -----
- newAColorMorph
- "Answer a new alpha color morph."
-
- ^AColorSelectorMorph new
- model: self;
- hResizing: #spaceFill;
- vResizing: #rigid;
- setValueSelector: #alphaSelected:;
- extent: 50 at 24!
Item was removed:
- ----- Method: HSVAColorSelectorMorph>>newHSVColorMorph (in category 'private - initialization') -----
- newHSVColorMorph
- "Answer a new hue/saturation/volume color morph."
-
- ^HSVColorSelectorMorph new
- hResizing: #spaceFill;
- vResizing: #spaceFill;
- when: #colorSelected send: #colorSelected: to: self!
Item was removed:
- ----- Method: HSVAColorSelectorMorph>>selectedColor (in category 'accessing') -----
- selectedColor
- "Answer the selected color."
-
- ^self hsvMorph selectedColor alpha: self aMorph value!
Item was removed:
- ----- Method: HSVAColorSelectorMorph>>selectedColor: (in category 'accessing') -----
- selectedColor: aColor
- "Set the hue and sv components."
-
- self aMorph value: aColor alpha.
- self hsvMorph selectedColor: aColor asNontranslucentColor!
Item was removed:
- ----- Method: HSVAColorSelectorMorph>>triggerSelectedColor (in category 'events') -----
- triggerSelectedColor
- "Trigger the event for the selected colour"
- self
- triggerEvent: #selectedColor
- with: self selectedColor.
- self changed: #selectedColor!
Item was removed:
- Morph subclass: #HSVColorSelectorMorph
- instanceVariableNames: 'svMorph hMorph'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !HSVColorSelectorMorph commentStamp: 'gvc 5/18/2007 12:55' prior: 0!
- Colour selector featuring a saturation/volume area and a hue selection strip.!
Item was removed:
- ----- Method: HSVColorSelectorMorph>>colorSelected: (in category 'accessing') -----
- colorSelected: aColor
- "A color has been selected. Make the hue match."
-
- "self hMorph value: aColor hue / 360.
- self svMorph basicColor: (Color h: aColor hue s: 1.0 v: 1.0)."
- self triggerEvent: #colorSelected with: aColor!
Item was removed:
- ----- Method: HSVColorSelectorMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "Answer the default color/fill style for the receiver."
-
- ^Color transparent
- !
Item was removed:
- ----- Method: HSVColorSelectorMorph>>hMorph (in category 'accessing') -----
- hMorph
- "Answer the value of hMorph"
-
- ^ hMorph!
Item was removed:
- ----- Method: HSVColorSelectorMorph>>hMorph: (in category 'accessing') -----
- hMorph: anObject
- "Set the value of hMorph"
-
- hMorph := anObject!
Item was removed:
- ----- Method: HSVColorSelectorMorph>>hue: (in category 'accessing') -----
- hue: aFloat
- "Set the hue in the range 0.0 - 1.0. Update the SV morph and hMorph."
-
- self hMorph value: aFloat.
- self svMorph color: (Color h: aFloat * 359.9 s: 1.0 v: 1.0)!
Item was removed:
- ----- Method: HSVColorSelectorMorph>>initialize (in category 'initialization') -----
- initialize
- "Initialize the receiver."
-
- super initialize.
- self
- borderWidth: 0;
- changeTableLayout;
- cellGap: 4;
- listDirection: #leftToRight;
- cellPositioning: #topLeft;
- svMorph: self newSVColorMorph;
- hMorph: self newHColorMorph;
- addMorphBack: self svMorph;
- addMorphBack: self hMorph;
- extent: 192 at 152;
- hue: 0.5!
Item was removed:
- ----- Method: HSVColorSelectorMorph>>newHColorMorph (in category 'private - initialization') -----
- newHColorMorph
- "Answer a new hue color morph."
-
- ^HColorSelectorMorph new
- model: self;
- setValueSelector: #hue:;
- hResizing: #rigid;
- vResizing: #spaceFill;
- extent: 36 at 36!
Item was removed:
- ----- Method: HSVColorSelectorMorph>>newSVColorMorph (in category 'private - initialization') -----
- newSVColorMorph
- "Answer a new saturation/volume color morph."
-
- ^SVColorSelectorMorph new
- extent: 152 at 152;
- hResizing: #spaceFill;
- vResizing: #spaceFill;
- when: #colorSelected send: #colorSelected: to: self!
Item was removed:
- ----- Method: HSVColorSelectorMorph>>selectedColor (in category 'accessing') -----
- selectedColor
- "Answer the selected color."
-
- ^self svMorph selectedColor!
Item was removed:
- ----- Method: HSVColorSelectorMorph>>selectedColor: (in category 'accessing') -----
- selectedColor: aColor
- "Set the hue and sv components."
-
- self hue: aColor hue / 360.
- self svMorph selectedColor: aColor!
Item was removed:
- ----- Method: HSVColorSelectorMorph>>svMorph (in category 'accessing') -----
- svMorph
- "Answer the value of svMorph"
-
- ^ svMorph!
Item was removed:
- ----- Method: HSVColorSelectorMorph>>svMorph: (in category 'accessing') -----
- svMorph: anObject
- "Set the value of svMorph"
-
- svMorph := anObject!
Item was removed:
- SimpleHaloMorph subclass: #HaloMorph
- instanceVariableNames: 'innerTarget angleOffset minExtent growingOrRotating directionArrowAnchor haloBox simpleMode originalExtent'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !HaloMorph commentStamp: '<historical>' prior: 0!
- This morph provides a halo of handles for its target morph. Dragging, duplicating, rotating, and resizing to be done by mousing down on the appropriate handle. There are also handles for help and for a menu of infrequently used operations.!
Item was removed:
- ----- Method: HaloMorph>>acceptNameEdit (in category 'initialization') -----
- acceptNameEdit
- "If the name is currently under edit, accept the changes"
-
- | label |
- (label := self findA: NameStringInHalo) ifNotNil:
- [label hasFocus ifTrue:
- [label lostFocusWithoutAccepting]]!
Item was removed:
- ----- Method: HaloMorph>>addChooseGraphicHandle: (in category 'handles') -----
- 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]
- !
Item was removed:
- ----- Method: HaloMorph>>addCircleHandles (in category 'private') -----
- addCircleHandles
- | box |
- simpleMode := false.
- target isWorldMorph ifTrue: [^ self addHandlesForWorldHalos].
-
- self removeAllMorphs. "remove old handles, if any"
- self updateBounds.
- box := self basicBox.
-
- target addHandlesTo: self box: box.
-
- self addName.
- growingOrRotating := false.
- self layoutChanged.
- self changed.!
Item was removed:
- ----- Method: HaloMorph>>addCollapseHandle: (in category 'handles') -----
- addCollapseHandle: handleSpec
- "Add the collapse handle, with all of its event handlers set up, unless the target's owner is not the world or the hand."
-
- | collapseHandle |
- (target owner notNil "nil happens, amazingly"
- and: [target owner isWorldOrHandMorph])
- ifFalse: [^ self].
- collapseHandle := self addHandle: handleSpec
- on: #mouseDown send: #mouseDownInCollapseHandle:with: to: self.
- collapseHandle on: #mouseUp send: #maybeCollapse:with: to: self.
- collapseHandle on: #mouseMove send: #setDismissColor:with: to: self
- !
Item was removed:
- ----- Method: HaloMorph>>addDebugHandle: (in category 'handles') -----
- addDebugHandle: handleSpec
- Preferences debugHaloHandle ifTrue:
- [self addHandle: handleSpec
- on: #mouseDown send: #doDebug:with: to: self]
- !
Item was removed:
- ----- Method: HaloMorph>>addDirectionHandles (in category 'private') -----
- addDirectionHandles
-
- | centerHandle d w directionShaft patch patchColor crossHairColor |
- self showingDirectionHandles ifFalse: [^ self].
-
- directionArrowAnchor := (target point: target referencePosition in: self world) rounded.
- patch := target imageFormForRectangle: (Rectangle center: directionArrowAnchor extent: 3 at 3).
- patchColor := patch colorAt: 1 at 1.
-
- (directionShaft := LineMorph newSticky makeForwardArrow)
- borderWidth: 2; borderColor: (Color green orColorUnlike: patchColor).
- self positionDirectionShaft: directionShaft.
- self addMorphFront: directionShaft.
- directionShaft setCenteredBalloonText: 'Set forward direction' translated;
- on: #mouseDown send: #doDirection:with: to: self;
- on: #mouseMove send: #trackDirectionArrow:with: to: self;
- on: #mouseUp send: #setDirection:with: to: self.
-
- d := 15. "diameter" w := 3. "borderWidth"
- crossHairColor := Color red orColorUnlike: patchColor.
- (centerHandle := EllipseMorph newBounds: (0 at 0 extent: d at d) color: Color transparent)
- borderWidth: w; borderColor: (Color blue orColorUnlike: patchColor);
- addMorph: (LineMorph from: (d//2)@w to: (d//2)@(d-w-1) color: crossHairColor width: 1) lock;
- addMorph: (LineMorph from: w@(d//2) to: (d-w-1)@(d//2) color: crossHairColor width: 1) lock;
- align: centerHandle bounds center with: directionArrowAnchor.
- centerHandle wantsYellowButtonMenu: false.
- self addMorph: centerHandle.
- centerHandle setCenteredBalloonText: 'Rotation center (hold down the shift key and drag from here to change it)' translated;
- on: #mouseDown send: #prepareToTrackCenterOfRotation:with: to: self;
- on: #mouseMove send: #trackCenterOfRotation:with: to: self;
- on: #mouseUp send: #setCenterOfRotation:with: to: self
- !
Item was removed:
- ----- Method: HaloMorph>>addDismissHandle: (in category 'handles') -----
- addDismissHandle: handleSpec
- "Add the dismiss handle according to the spec, unless selectiveHalos is on and my target resists dismissal"
-
- | dismissHandle |
- (target okayToAddDismissHandle or: [Preferences selectiveHalos not]) ifTrue:
- [dismissHandle := self addHandle: handleSpec
- on: #mouseDown send: #mouseDownInDimissHandle:with: to: self.
- dismissHandle on: #mouseUp send: #maybeDismiss:with: to: self.
- dismissHandle on: #mouseDown send: #setDismissColor:with: to: self.
- dismissHandle on: #mouseMove send: #setDismissColor:with: to: self]
- !
Item was removed:
- ----- Method: HaloMorph>>addDragHandle: (in category 'handles') -----
- addDragHandle: haloSpec
- (self addHandle: haloSpec on: #mouseDown send: #startDrag:with: to: self)
- on: #mouseMove send: #doDrag:with: to: self
-
-
- !
Item was removed:
- ----- Method: HaloMorph>>addDupHandle: (in category 'handles') -----
- addDupHandle: haloSpec
- "Add the halo that offers duplication, or, when shift is down, make-sibling"
-
- | aSelector |
- aSelector := innerTarget couldMakeSibling
- ifTrue:
- [#doDupOrMakeSibling:with:]
- ifFalse:
- [#doDup:with:].
-
- self addHandle: haloSpec on: #mouseDown send: aSelector to: self
-
- !
Item was removed:
- ----- Method: HaloMorph>>addFewerHandlesHandle: (in category 'handles') -----
- addFewerHandlesHandle: haloSpec
- self addHandle: haloSpec on: #mouseDown send: #addSimpleHandles to: self
- !
Item was removed:
- ----- Method: HaloMorph>>addFontEmphHandle: (in category 'handles') -----
- addFontEmphHandle: haloSpec
- (innerTarget isTextMorph)
- ifTrue:
- [self
- addHandle: haloSpec
- on: #mouseUp
- send: #chooseEmphasisOrAlignment
- to: innerTarget]!
Item was removed:
- ----- Method: HaloMorph>>addFontSizeHandle: (in category 'handles') -----
- addFontSizeHandle: haloSpec
- (innerTarget isTextMorph)
- ifTrue:
- [self
- addHandle: haloSpec
- on: #mouseUp
- send: #chooseFont
- to: innerTarget]!
Item was removed:
- ----- Method: HaloMorph>>addFontStyleHandle: (in category 'handles') -----
- addFontStyleHandle: haloSpec
- (innerTarget isTextMorph)
- ifTrue:
- [self
- addHandle: haloSpec
- on: #mouseUp
- send: #chooseStyle
- to: innerTarget]!
Item was removed:
- ----- Method: HaloMorph>>addFullHandles (in category 'private') -----
- addFullHandles
- "Later, obey a preference to choose between circle-iconic and solid-circles"
- self addCircleHandles!
Item was removed:
- ----- Method: HaloMorph>>addGrabHandle: (in category 'handles') -----
- addGrabHandle: haloSpec
- "If appropriate, add the black halo handle for picking up the target"
-
- innerTarget okayToAddGrabHandle ifTrue:
- [self addHandle: haloSpec on: #mouseDown send: #doGrab:with: to: self]
-
- !
Item was removed:
- ----- Method: HaloMorph>>addGraphicalHandle:at:on:send:to: (in category 'private') -----
- addGraphicalHandle: formKey at: aPoint on: eventName send: selector to: recipient
- "Add the supplied form as a graphical handle centered at the given point, and set it up to respond to the given event by sending the given selector to the given recipient. Return the handle."
- | handle |
- handle := self addGraphicalHandleFrom: formKey at: aPoint.
- handle on: eventName send: selector to: recipient.
- handle setBalloonText: (target balloonHelpTextForHandle: handle) translated.
- ^ handle
- !
Item was removed:
- ----- Method: HaloMorph>>addGraphicalHandleFrom:at: (in category 'private') -----
- addGraphicalHandleFrom: formKey at: aPoint
- "Add the supplied form as a graphical handle centered at the given point. Return the handle."
- | handle aForm |
- aForm := (ScriptingSystem formAtKey: formKey) ifNil: [ScriptingSystem formAtKey: #SolidMenu].
- handle := ImageMorph new image: aForm; bounds: (Rectangle center: aPoint extent: aForm extent).
- handle borderColor: Color black; borderWidth: 2.
- handle wantsYellowButtonMenu: false.
- self addMorph: handle.
- handle on: #mouseUp send: #endInteraction: to: self.
- ^ handle
- !
Item was removed:
- ----- Method: HaloMorph>>addGrowHandle: (in category 'handles') -----
- addGrowHandle: haloSpec
- target isFlexMorph ifFalse:
- [(self addHandle: haloSpec
- on: #mouseDown send: #startGrow:with: to: self)
- on: #mouseMove send: #doGrow:with: to: self]
- "This or addScaleHandle:, but not both, will prevail at any one time"
- !
Item was removed:
- ----- Method: HaloMorph>>addHandle:on:send:to: (in category 'private') -----
- addHandle: handleSpec on: eventName send: selector to: recipient
- "Add a handle within the halo box as per the haloSpec, and set
- it up to respond to the given event by sending the given
- selector to the given recipient. Return the handle."
- | handle aPoint |
-
- aPoint := self
- positionIn: haloBox
- horizontalPlacement: handleSpec horizontalPlacement
- verticalPlacement: handleSpec verticalPlacement.
-
- handle := self
- addHandleAt: aPoint
- color: (Color colorFrom: handleSpec color)
- icon: handleSpec iconSymbol
- on: eventName
- send: selector
- to: recipient.
-
- ^ handle!
Item was removed:
- ----- Method: HaloMorph>>addHandleAt:color:icon:on:send:to: (in category 'private') -----
- addHandleAt: aPoint color: aColor icon: iconName on: eventName send: selector to: recipient
- "Add a handle centered at the given point with the given color,
- and set it up to respond to the given event by sending the
- given selector to the given recipient. Return the handle."
- | handle |
- handle := self createHandleAt: aPoint color: (aColor alpha: 0.8) iconName: iconName.
- self addMorph: handle.
-
- handle on: #mouseUp send: #endInteraction: to: self.
- handle on: eventName send: selector to: recipient.
- handle setBalloonText: (target balloonHelpTextForHandle: handle) translated.
-
- ^ handle !
Item was removed:
- ----- Method: HaloMorph>>addHandleAt:color:on:send:to: (in category 'private') -----
- addHandleAt: aPoint color: aColor on: eventName send: selector to: recipient
- ^ self addHandleAt: aPoint color: aColor icon: nil on: eventName send: selector to: recipient
- !
Item was removed:
- ----- Method: HaloMorph>>addHandles (in category 'private') -----
- addHandles
- simpleMode == true
- ifTrue:
- [self addSimpleHandles]
- ifFalse:
- [self addCircleHandles]
- !
Item was removed:
- ----- Method: HaloMorph>>addHandlesForWorldHalos (in category 'private') -----
- addHandlesForWorldHalos
- "Add handles for world halos, like the man said"
-
- | box w |
- w := self world ifNil:[target world].
- self removeAllMorphs. "remove old handles, if any"
- self bounds: target bounds.
- box := w bounds insetBy: self handleSize // 2.
- target addWorldHandlesTo: self box: box.
-
- Preferences uniqueNamesInHalos ifTrue:
- [innerTarget assureExternalName].
- self
- addNameBeneath: ((box insetBy: (0 at 0 corner: 0 at 10))
- scaleBy: RealEstateAgent scaleFactor)
- string: innerTarget externalName.
- growingOrRotating := false.
- self layoutChanged.
- self changed.
- !
Item was removed:
- ----- Method: HaloMorph>>addHelpHandle: (in category 'handles') -----
- addHelpHandle: haloSpec
- target balloonText ifNotNil:
- [(self addHandle: haloSpec on: #mouseDown send: #mouseDownOnHelpHandle: to: innerTarget)
- on: #mouseUp send: #deleteBalloon to: innerTarget]
- !
Item was removed:
- ----- Method: HaloMorph>>addMakeSiblingHandle: (in category 'handles') -----
- addMakeSiblingHandle: haloSpec
- "Add the halo handle that allows a sibling instance to be torn off, or, if the shift key is down, for a deep-copy duplicate to be made."
-
- self addHandle: haloSpec on: #mouseDown send: #doMakeSiblingOrDup:with: to: self
-
- !
Item was removed:
- ----- Method: HaloMorph>>addMenuHandle: (in category 'handles') -----
- addMenuHandle: haloSpec
- self addHandle: haloSpec on: #mouseDown send: #doMenu:with: to: self!
Item was removed:
- ----- Method: HaloMorph>>addName (in category 'private') -----
- addName
- "Add a name readout at the bottom of the halo."
-
- Preferences uniqueNamesInHalos ifTrue:
- [target assureExternalName].
-
- self addNameBeneath: self basicBox string: target externalName
- !
Item was removed:
- ----- Method: HaloMorph>>addNameBeneath:string: (in category 'private') -----
- addNameBeneath: outerRectangle string: aString
- "Add a name display centered beneath the bottom of the outer rectangle. Return the handle."
-
- | nameMorph namePosition w |
- w := self world ifNil:[target world].
- nameMorph := NameStringInHalo contents: aString font: Preferences standardHaloLabelFont.
- nameMorph wantsYellowButtonMenu: false.
- nameMorph color: Color black.
- nameMorph useStringFormat; target: innerTarget; putSelector: #tryToRenameTo:.
- namePosition := outerRectangle bottomCenter -
- ((nameMorph width // 2) @ (self handleSize negated // 2 - 1)).
- nameMorph position: (namePosition min: w viewBox bottomRight - nameMorph extent y + 2).
- nameMorph balloonTextSelector: #objectNameInHalo.
- self addMorph: nameMorph.
- ^ nameMorph!
Item was removed:
- ----- Method: HaloMorph>>addPaintBgdHandle: (in category 'handles') -----
- addPaintBgdHandle: haloSpec
- (innerTarget isKindOf: PasteUpMorph) ifTrue:
- [self addHandle: haloSpec
- on: #mouseDown send: #paintBackground to: innerTarget].
- !
Item was removed:
- ----- Method: HaloMorph>>addPoohHandle: (in category 'handles') -----
- addPoohHandle: handleSpec
- (innerTarget isKindOf: (Smalltalk at: #WonderlandCameraMorph ifAbsent:[nil])) ifTrue:
- [self addHandle: handleSpec on: #mouseDown send: #strokeMode to: innerTarget]
- !
Item was removed:
- ----- Method: HaloMorph>>addRecolorHandle: (in category 'handles') -----
- addRecolorHandle: haloSpec
- "Add a recolor handle to the receiver, if appropriate"
-
- | recolorHandle |
-
- "since this halo now opens a more general properties panel, allow it in all cases"
- "innerTarget canSetColor ifTrue:"
-
- recolorHandle := self addHandle: haloSpec on: #mouseUp send: #doRecolor:with: to: self.
- recolorHandle on: #mouseUp send: #doRecolor:with: to: self
-
- !
Item was removed:
- ----- Method: HaloMorph>>addRepaintHandle: (in category 'handles') -----
- addRepaintHandle: haloSpec
- (innerTarget isSketchMorph) ifTrue:
- [self addHandle: haloSpec
- on: #mouseDown send: #editDrawing to: innerTarget]
- !
Item was removed:
- ----- Method: HaloMorph>>addRotateHandle: (in category 'handles') -----
- addRotateHandle: haloSpec
- (self addHandle: haloSpec on: #mouseDown send: #startRot:with: to: self)
- on: #mouseMove send: #doRot:with: to: self
-
- !
Item was removed:
- ----- Method: HaloMorph>>addScaleHandle: (in category 'handles') -----
- addScaleHandle: haloSpec
-
- (target isFlexMorph and: [target renderedMorph ~~ target])
- ifTrue: [(self addHandle: haloSpec
- on: #mouseDown send: #startScale:with: to: self)
- on: #mouseMove send: #doScale:with: to: self]
- ifFalse: [(self addHandle: haloSpec
- on: #mouseDown send: #startGrow:with: to: self)
- on: #mouseMove send: #doGrow:with: to: self].
- !
Item was removed:
- ----- Method: HaloMorph>>addScriptHandle: (in category 'handles') -----
- addScriptHandle: haloSpec
- "If the halo's innerTarget claims it wants a Script handle, add one to the receiver, forming it as per haloSpec"
-
- innerTarget wantsScriptorHaloHandle ifTrue:
- [self addHandle: haloSpec
- on: #mouseUp send: #editButtonsScript to: innerTarget]
- !
Item was removed:
- ----- Method: HaloMorph>>addSimpleHandles (in category 'private') -----
- addSimpleHandles
- target isWorldMorph ifTrue: [^ self addHandlesForWorldHalos].
- self removeAllMorphs. "remove old handles, if any"
- self updateBounds.
- self innerTarget addSimpleHandlesTo: self box: self basicBoxForSimpleHalos
-
- !
Item was removed:
- ----- Method: HaloMorph>>addSimpleHandlesForWorldHalos (in category 'private') -----
- addSimpleHandlesForWorldHalos
- "Nothing special at present here -- just use the regular handles. Cannot rotate or resize world"
-
- self addHandlesForWorldHalos
- !
Item was removed:
- ----- Method: HaloMorph>>addSimpleHandlesTo:box: (in category 'halos and balloon help') -----
- addSimpleHandlesTo: aHaloMorph box: aBox
- | aHandle |
- simpleMode := true.
-
- target isWorldMorph ifTrue: [^ self addSimpleHandlesForWorldHalos].
-
- self removeAllMorphs. "remove old handles, if any"
-
- self updateBounds.
-
- 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 and: [target renderedMorph ~~ target])
- 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.!
Item was removed:
- ----- Method: HaloMorph>>addSimpleSketchMorphHandlesInBox: (in category 'private') -----
- addSimpleSketchMorphHandlesInBox: box
-
- self addGraphicalHandle: #PaintTab at: box bottomCenter on: #mouseDown send: #editDrawing to: self innerTarget.
-
- self addDirectionHandles!
Item was removed:
- ----- Method: HaloMorph>>addTileHandle: (in category 'handles') -----
- addTileHandle: haloSpec
- "Add the 'tear-off-tile' handle from the spec"
-
- self addHandle: haloSpec on: #mouseDown send: #tearOffTileForTarget:with: to: self
- !
Item was removed:
- ----- Method: HaloMorph>>addViewHandle: (in category 'handles') -----
- addViewHandle: haloSpec
- "Add the 'open viewer' handle from the halo spec"
-
- self addHandle: haloSpec
- on: #mouseDown send: #openViewerForTarget:with: to: self
-
-
- !
Item was removed:
- ----- Method: HaloMorph>>addViewingHandle: (in category 'handles') -----
- addViewingHandle: haloSpec
- "If appropriate, add a special Viewing halo handle to the receiver. On 26 Sept 07, we decided to eliminate this item from the UI, so the code of is method is now commented out...
-
- (innerTarget isKindOf: PasteUpMorph) ifTrue:
- [self addHandle: haloSpec
- on: #mouseDown send: #presentViewMenu to: innerTarget].
- "
- !
Item was removed:
- ----- Method: HaloMorph>>backupAndHideTargetDropShadows (in category 'private') -----
- backupAndHideTargetDropShadows
-
- self setProperty: #targetHadDropShadow toValue: target hasDropShadow.
- self target hasDropShadow: false.!
Item was removed:
- ----- Method: HaloMorph>>basicBox (in category 'private') -----
- basicBox
- | minSide outset anExtent aBox w |
- minSide := 4 * self handleSize.
- outset := 8 * RealEstateAgent scaleFactor.
- anExtent := (self extent + self handleSize + outset) max: minSide asPoint.
- aBox := Rectangle center: self center extent: anExtent.
- w := self world ifNil:[target outermostWorldMorph].
- ^ w
- ifNil:
- [aBox]
- ifNotNil:
- [aBox intersect: (w viewBox insetBy: self handleSize // 2)]
- !
Item was removed:
- ----- Method: HaloMorph>>basicBoxForSimpleHalos (in category 'private') -----
- basicBoxForSimpleHalos
- | w |
- w := self world ifNil:[target outermostWorldMorph].
- ^ ((self haloBoundsFor: target topRendererOrSelf) expandBy: self handleAllowanceForIconicHalos)
- intersect: (w bounds insetBy: 8 at 8)
- !
Item was removed:
- ----- Method: HaloMorph>>changed (in category 'updating') -----
- changed
- "Quicker to invalidate handles individually if target is large (especially the world)"
-
- self extent > (200 at 200)
- ifTrue: [(target notNil and: [target ~~ self world]) ifTrue:
- ["Invalidate 4 outer strips first, thus subsuming separate damage."
- (self fullBounds areasOutside: target bounds) do:
- [:r | self invalidRect: r]].
- self submorphsDo: [:m | m changed]]
- ifFalse: [super changed].
- !
Item was removed:
- ----- Method: HaloMorph>>convertToCurrentVersion:refStream: (in category 'objects from disk') -----
- convertToCurrentVersion: varDict refStream: smartRefStrm
-
- simpleMode ifNil: [simpleMode := false].
- ^super convertToCurrentVersion: varDict refStream: smartRefStrm.
-
- !
Item was removed:
- ----- Method: HaloMorph>>createHandleAt:color:iconName: (in category 'private') -----
- createHandleAt: aPoint color: aColor iconName: iconName
- | bou handle |
- bou := Rectangle center: aPoint extent: self handleSize asPoint.
- Preferences alternateHandlesLook
- ifTrue: [handle := RectangleMorph newBounds: bou color: aColor.
- handle useRoundedCorners.
- self setColor: aColor toHandle: handle]
- ifFalse: [handle := EllipseMorph newBounds: bou color: aColor].
- handle borderWidth: 0;
- wantsYellowButtonMenu: false.
- ""
- iconName isNil
- ifFalse: [| form |
- form := ScriptingSystem formAtKey: iconName.
- form isNil
- ifFalse: [| image |
- image := ImageMorph new.
- image image: form scaleIconToDisplay.
- image color: aColor makeForegroundColor.
- image lock.
- handle addMorphCentered: image]].
- ""
- ^ handle!
Item was removed:
- ----- Method: HaloMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color
- r: 0.6
- g: 0.8
- b: 1.0!
Item was removed:
- ----- Method: HaloMorph>>delete (in category 'submorphs - add/remove') -----
- delete
- "Delete the halo. Tell the target that it no longer has the halo; accept any pending edits to the name; and then either actually delete myself or start to fade out"
-
- self acceptNameEdit.
- self isMagicHalo: false.
-
- Preferences haloTransitions
- ifFalse: [super delete]
- ifTrue: [
- self
- lock; "Just a delete-animation from here on. No interaction."
- stopStepping;
- startStepping;
- startSteppingSelector: #fadeOutFinally].
- !
Item was removed:
- ----- Method: HaloMorph>>directionArrowLength (in category 'private') -----
- directionArrowLength
- ^ 25!
Item was removed:
- ----- Method: HaloMorph>>dismiss (in category 'private') -----
- dismiss
- "Remove my target from the world Seems to be EToy specific."
-
- | w |
- w := self world.
- w ifNotNil: [w stopStepping: target].
- self delete.
- target dismissViaHalo!
Item was removed:
- ----- Method: HaloMorph>>doDebug:with: (in category 'private') -----
- doDebug: evt with: menuHandle
- "Ask hand to invoke the a debugging menu for my inner target. If shift key is down, immediately put up an inspector on the inner target"
-
- | menu |
- evt shiftPressed ifTrue: [
- evt hand removeHalo.
- ^ innerTarget inspectInMorphic: evt].
-
- menu := innerTarget buildDebugMenu: evt hand.
- menu addTitle: (innerTarget externalName truncateWithElipsisTo: 40).
- menu popUpEvent: evt in: self world.
- evt hand removeHalo.!
Item was removed:
- ----- Method: HaloMorph>>doDirection:with: (in category 'private') -----
- doDirection: anEvent with: directionHandle
- "The mouse went down on the forward-direction halo handle; respond appropriately."
-
- anEvent hand obtainHalo: self.
- anEvent shiftPressed
- ifTrue:
- [directionArrowAnchor := (target point: target referencePosition in: self world) rounded.
- self positionDirectionShaft: directionHandle.
- self removeAllHandlesBut: directionHandle.
- directionHandle setProperty: #trackDirectionArrow toValue: true]
- ifFalse:
- [self currentHand spawnBalloonFor: directionHandle]!
Item was removed:
- ----- Method: HaloMorph>>doDrag:with: (in category 'private') -----
- doDrag: evt with: dragHandle
- | thePoint |
- evt hand obtainHalo: self.
- thePoint := target point: evt position - positionOffset from: owner.
- target setConstrainedPosition: thePoint hangOut: true.
- !
Item was removed:
- ----- Method: HaloMorph>>doDup:with: (in category 'private') -----
- doDup: evt with: dupHandle
- "Ask hand to duplicate my target."
-
- (target isSelectionMorph) 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: HaloMorph>>doDupOrMakeSibling:with: (in category 'handles') -----
- doDupOrMakeSibling: evt with: dupHandle
- "Ask hand to duplicate my target, if shift key *not* pressed, or make a sibling if shift key *is* pressed"
-
- ^ (evt shiftPressed and: [target couldMakeSibling])
- ifTrue:
- [dupHandle color: Color green muchDarker.
- self doMakeSibling: evt with: dupHandle]
- ifFalse:
- [self doDup: evt with: dupHandle]!
Item was removed:
- ----- Method: HaloMorph>>doGrab:with: (in category 'private') -----
- doGrab: evt with: grabHandle
- "Ask hand to grab my target."
-
- self obtainHaloForEvent: evt andRemoveAllHandlesBut: grabHandle.
- evt hand grabMorph: target.
- self step. "update position if necessary"
- evt hand addMouseListener: self. "Listen for the drop"!
Item was removed:
- ----- Method: HaloMorph>>doGrow:with: (in category 'private') -----
- doGrow: evt with: growHandle
- "Called while the mouse is down in the grow handle"
-
- | newExtent extentToUse scale |
- evt hand obtainHalo: self.
- newExtent := (target pointFromWorld: evt cursorPoint - positionOffset)
- - target topLeft.
- evt shiftPressed ifTrue: [
- scale := (newExtent x / (originalExtent x max: 1)) min:
- (newExtent y / (originalExtent y max: 1)).
- newExtent := (originalExtent x * scale) asInteger @ (originalExtent y * scale) asInteger
- ].
- (newExtent x < 1 or: [newExtent y < 1 ]) ifTrue: [^ self].
- target renderedMorph setExtentFromHalo: (extentToUse := newExtent).
- growHandle position: evt cursorPoint - (growHandle extent // 2).
- self layoutChanged.
- (self valueOfProperty: #commandInProgress) ifNotNil:
- [:cmd | "Update the final extent"
- cmd redoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: extentToUse]
- !
Item was removed:
- ----- Method: HaloMorph>>doMakeSibling:with: (in category 'private') -----
- doMakeSibling: evt with: dupHandle
- "Ask hand to make a sibling of my target. Only reachable if target is of a uniclass"
-
- target couldMakeSibling ifFalse: [^ self].
-
- target assuredPlayer assureUniClass.
- self obtainHaloForEvent: evt andRemoveAllHandlesBut: dupHandle.
- self setTarget: (target makeSiblings: 1) first.
- evt hand grabMorph: target.
- self step. "update position if necessary"
- evt hand addMouseListener: self. "Listen for the drop"!
Item was removed:
- ----- Method: HaloMorph>>doMakeSiblingOrDup:with: (in category 'handles') -----
- doMakeSiblingOrDup: evt with: dupHandle
- "Ask hand to duplicate my target, if shift key *is* pressed, or make a sibling if shift key *not* pressed"
-
- ^ (evt shiftPressed or: [target couldMakeSibling not])
- ifFalse:
- [self doMakeSibling: evt with: dupHandle]
- ifTrue:
- [dupHandle color: Color green.
- self doDup: evt with: dupHandle]!
Item was removed:
- ----- Method: HaloMorph>>doMenu:with: (in category 'private') -----
- doMenu: evt with: menuHandle
- "Ask hand to invoke the halo menu for my inner target."
-
- | menu |
- menu := innerTarget buildHandleMenu: evt hand.
- innerTarget addTitleForHaloMenu: menu.
- menu popUpEvent: evt in: self world.
- evt hand removeHalo.
- !
Item was removed:
- ----- Method: HaloMorph>>doRecolor:with: (in category 'private') -----
- doRecolor: evt with: aHandle
- "The mouse went down in the 'recolor' halo handle. Allow the user to change the color of the innerTarget"
-
- evt hand obtainHalo: self.
- (aHandle containsPoint: evt cursorPoint)
- ifFalse: "only do it if mouse still in handle on mouse up"
- [self delete.
- target addHalo: evt]
- ifTrue:
- [(Preferences propertySheetFromHalo == evt shiftPressed)
- ifFalse: [innerTarget openAPropertySheet]
- ifTrue: [innerTarget changeColor].
- self showingDirectionHandles ifTrue: [self addHandles]]!
Item was removed:
- ----- Method: HaloMorph>>doResizeTarget: (in category 'dragging or resizing') -----
- doResizeTarget: evt
- | newExtent |
- newExtent := originalExtent + (evt position - positionOffset * 2).
- (newExtent x > 1 and: [ newExtent y > 1 ]) ifTrue:
- [ | oldExtent dockingBarBottom newPosition |
- oldExtent := target extent.
- dockingBarBottom := owner mainDockingBars
- inject: 0
- into: [ : bottomMostBottom : each | bottomMostBottom max: each bottom ].
- target setExtentFromHalo: (newExtent min: owner extent x @ (owner extent y - dockingBarBottom)).
- newPosition := target position - (target extent - oldExtent // 2).
- newPosition := (newPosition x
- min: owner extent x - newExtent x
- max: 0) @
- (newPosition y
- min: owner extent y - newExtent y
- max: dockingBarBottom).
- target
- setConstrainedPosition: newPosition
- hangOut: true ].
- self updateBounds.!
Item was removed:
- ----- Method: HaloMorph>>doRot:with: (in category 'private') -----
- doRot: evt with: rotHandle
- "Update the rotation of my target if it is rotatable. Keep the relevant command object up to date."
-
- | degrees |
- evt hand obtainHalo: self.
- degrees := (evt cursorPoint - (target pointInWorld: target referencePosition)) degrees.
- degrees := degrees - angleOffset degrees.
- degrees := degrees detentBy: 10.0 atMultiplesOf: 90.0 snap: false.
- degrees = 0.0
- ifTrue: [self setColor: Color lightBlue toHandle: rotHandle]
- ifFalse: [self setColor: Color blue toHandle: rotHandle].
- rotHandle submorphsDo:
- [:m | m color: rotHandle color makeForegroundColor].
- self removeAllHandlesBut: rotHandle.
- self showingDirectionHandles ifFalse:
- [self showDirectionHandles: true addHandles: false].
- self addDirectionHandles.
-
- target rotationDegrees: degrees.
-
- rotHandle position: evt cursorPoint - (rotHandle extent // 2).
- (self valueOfProperty: #commandInProgress) ifNotNil:
- [:cmd | "Update the final rotation"
- cmd redoTarget: target renderedMorph selector: #heading: argument: degrees].
- self layoutChanged!
Item was removed:
- ----- Method: HaloMorph>>doScale:with: (in category 'private') -----
- doScale: evt with: scaleHandle
- "Update the scale of my target if it is scalable."
- | newHandlePos colorToUse |
- evt hand obtainHalo: self.
- newHandlePos := evt cursorPoint - (scaleHandle extent // 2).
- target scaleToMatch: newHandlePos.
- colorToUse := target scale = 1.0
- ifTrue: [Color yellow]
- ifFalse: [Color orange].
- self setColor: colorToUse toHandle: scaleHandle.
- scaleHandle
- submorphsDo: [:m | m color: colorToUse makeForegroundColor].
- scaleHandle position: newHandlePos.
- self layoutChanged.
-
- (self valueOfProperty: #commandInProgress) ifNotNil:[:cmd |
- "Update the final extent"
- cmd redoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: target extent
- ].
- !
Item was removed:
- ----- Method: HaloMorph>>drawSubmorphsOn: (in category 'drawing') -----
- drawSubmorphsOn: aCanvas
- | alpha |
- ((alpha := self magicAlpha) = 1.0)
- ifTrue:[^super drawSubmorphsOn: aCanvas].
- ^super drawSubmorphsOn: (aCanvas asAlphaBlendingCanvas: alpha)!
Item was removed:
- ----- Method: HaloMorph>>endInteraction: (in category 'private') -----
- endInteraction: event
- "Clean up after a user interaction with the a halo control"
-
- | m |
- self isMagicHalo: false. "no longer"
- self magicAlpha: 1.0.
- (target isInWorld not or: [owner isNil]) ifTrue: [^self].
- [target isFlexMorph and: [target hasNoScaleOrRotation]] whileTrue:
- [m := target firstSubmorph.
- target removeFlexShell.
- target := m].
- self restoreTargetDropShadows.
- target changedViaHalo: self.
- self isInWorld
- ifTrue:
- ["make sure handles show in front, even if flex shell added"
- self flag: #tofix. "mt: Try to avoid deleting and re-creating an event handler (here: the handle) while handling the event."
- self comeToFront.
- self addHandles.
- event hand newMouseFocus: self].
- (self valueOfProperty: #commandInProgress) ifNotNil:
- [:cmd |
- self rememberCommand: cmd.
- self removeProperty: #commandInProgress].!
Item was removed:
- ----- Method: HaloMorph>>fadeIn (in category 'stepping') -----
- fadeIn
- self magicAlpha >= 1.0 ifTrue:[self stopSteppingSelector: #fadeIn].
- self magicAlpha: ((self magicAlpha + 0.1) min: 1.0)
- !
Item was removed:
- ----- Method: HaloMorph>>fadeInInitially (in category 'stepping') -----
- fadeInInitially
- | max |
- max := self isMagicHalo ifTrue:[0.3] ifFalse:[1.0].
- self magicAlpha >= max ifTrue:[self stopSteppingSelector: #fadeInInitially].
- self magicAlpha: ((self magicAlpha + (max * 0.1)) min: max)
- !
Item was removed:
- ----- Method: HaloMorph>>fadeOut (in category 'stepping') -----
- fadeOut
- self magicAlpha <= 0.3 ifTrue:[self stopSteppingSelector: #fadeOut].
- self magicAlpha: ((self magicAlpha - 0.1) max: 0.3)
- !
Item was removed:
- ----- Method: HaloMorph>>fadeOutFinally (in category 'stepping') -----
- fadeOutFinally
- self magicAlpha <= 0.05 ifTrue:[^super delete].
- self magicAlpha <= 0.3 ifTrue:[
- ^self magicAlpha: (self magicAlpha - 0.03 max: 0.0)].
- self magicAlpha: ((self magicAlpha * 0.5) max: 0.0)
- !
Item was removed:
- ----- Method: HaloMorph>>haloBox: (in category 'accessing') -----
- haloBox: aBox
- haloBox := aBox!
Item was removed:
- ----- Method: HaloMorph>>handleAllowanceForIconicHalos (in category 'private') -----
- handleAllowanceForIconicHalos
- ^ 12!
Item was removed:
- ----- Method: HaloMorph>>handleEntered (in category 'stepping') -----
- handleEntered
- self isMagicHalo ifFalse:[^self].
- self stopStepping; startStepping.
- self startSteppingSelector: #fadeIn.
- !
Item was removed:
- ----- Method: HaloMorph>>handleLeft (in category 'stepping') -----
- handleLeft
- self isMagicHalo ifFalse:[^self].
- self stopStepping; startStepping.
- self startSteppingSelector: #fadeOut.!
Item was removed:
- ----- Method: HaloMorph>>handleListenEvent: (in category 'events') -----
- handleListenEvent: anEvent
- "We listen for possible drop events here to add back those handles after a dup/grab operation"
-
- (anEvent isMouse and:[anEvent isMove not]) ifFalse:[^ self]. "not interested"
- anEvent hand removeMouseListener: self. "done listening"
- (self world ifNil: [target world]) ifNil: [^ self].
- self addHandles "and get those handles back"!
Item was removed:
- ----- Method: HaloMorph>>handleMouseUp: (in category 'events') -----
- handleMouseUp: evt
-
- super handleMouseUp: evt.
-
- self restoreTargetDropShadows.
- target changedViaHalo: self.!
Item was removed:
- ----- Method: HaloMorph>>handleSize (in category 'private') -----
- handleSize
- ^ ((Preferences biggerHandles
- ifTrue: [30]
- ifFalse: [16]) * RealEstateAgent scaleFactor) rounded!
Item was removed:
- ----- Method: HaloMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
- growingOrRotating := false.
- simpleMode := Preferences simpleHalosInForce !
Item was removed:
- ----- Method: HaloMorph>>innerTarget (in category 'accessing') -----
- innerTarget
-
- ^ innerTarget
- !
Item was removed:
- ----- Method: HaloMorph>>isMagicHalo (in category 'accessing') -----
- isMagicHalo
- ^self valueOfProperty: #isMagicHalo ifAbsent:[false].!
Item was removed:
- ----- Method: HaloMorph>>isMagicHalo: (in category 'accessing') -----
- isMagicHalo: aBool
- self setProperty: #isMagicHalo toValue: aBool.
- aBool
- ifTrue: [
- self on: #mouseEnter send: #handleEntered to: self.
- self on: #mouseLeave send: #handleLeft to: self]
- ifFalse:[
- "Reset everything"
- self eventHandler ifNotNil: [:eh |
- eh forgetDispatchesTo: #handleEntered;
- forgetDispatchesTo: #handleLeft].
- self stopStepping. "get rid of all"
- self startStepping. "only those of interest"].!
Item was removed:
- ----- Method: HaloMorph>>localHaloBoundsFor: (in category 'stepping') -----
- localHaloBoundsFor: aMorph
-
- "aMorph may be in the hand and perhaps not in our world"
-
- | r |
-
- r := (self haloBoundsFor: aMorph) truncated.
- aMorph world = self world ifFalse: [^r].
- ^((self transformFromOutermostWorld) globalBoundsToLocal: r) truncated!
Item was removed:
- ----- Method: HaloMorph>>magicAlpha (in category 'accessing') -----
- magicAlpha
- ^self valueOfProperty: #magicAlpha ifAbsent:[1.0]!
Item was removed:
- ----- Method: HaloMorph>>magicAlpha: (in category 'accessing') -----
- magicAlpha: alpha
- self setProperty: #magicAlpha toValue: alpha.
- self changed.!
Item was removed:
- ----- Method: HaloMorph>>maybeCollapse:with: (in category 'private') -----
- maybeCollapse: evt with: collapseHandle
- "Ask hand to collapse my target if mouse comes up in it."
-
- evt hand obtainHalo: self.
- self delete.
- (collapseHandle containsPoint: evt cursorPoint)
- ifFalse:
- [
- target addHalo: evt]
- ifTrue:
- [
- target collapse]!
Item was removed:
- ----- Method: HaloMorph>>maybeDismiss:with: (in category 'private') -----
- maybeDismiss: evt with: dismissHandle
- "Ask hand to dismiss my target if mouse comes up in it."
-
- evt hand obtainHalo: self.
- (dismissHandle containsPoint: evt cursorPoint)
- ifFalse:
- [self delete.
- target addHalo: evt]
- ifTrue:
- [target resistsRemoval ifTrue:
- [(Project uiManager
- chooseOptionFrom:
- {'Yes' translated.
- 'Um, no, let me reconsider' translated.}
- title: 'Really throw this away?' translated) = 1 ifFalse: [^ self]].
- evt hand removeHalo.
- self delete.
- target dismissViaHalo.
- self currentWorld presenter flushPlayerListCache].!
Item was removed:
- ----- Method: HaloMorph>>maybeDoDup:with: (in category 'private') -----
- maybeDoDup: evt with: dupHandle
- evt hand obtainHalo: self.
- ^ target okayToDuplicate ifTrue:
- [self doDup: evt with: dupHandle]!
Item was removed:
- ----- Method: HaloMorph>>mouseDown: (in category 'events') -----
- mouseDown: event
-
- self isMagicHalo ifTrue: [
- self isMagicHalo: false.
- self magicAlpha: 1.0].
-
- super mouseDown: event.!
Item was removed:
- ----- Method: HaloMorph>>mouseDownInCollapseHandle:with: (in category 'private') -----
- mouseDownInCollapseHandle: evt with: collapseHandle
- "The mouse went down in the collapse handle; collapse the morph"
-
- self obtainHaloForEvent: evt andRemoveAllHandlesBut: collapseHandle.
- self setDismissColor: evt with: collapseHandle!
Item was removed:
- ----- Method: HaloMorph>>mouseDownInDimissHandle:with: (in category 'private') -----
- mouseDownInDimissHandle: evt with: dismissHandle
- evt hand obtainHalo: self.
- SoundService soundEnabled ifTrue: [TrashCanMorph playMouseEnterSound].
- self removeAllHandlesBut: dismissHandle.
- self setColor: Color darkGray toHandle: dismissHandle.
- !
Item was removed:
- ----- Method: HaloMorph>>mouseMove: (in category 'events') -----
- mouseMove: evt
-
- growingOrRotating
- ifTrue: [self doResizeTarget: evt]
- ifFalse: [self doDragTarget: evt].!
Item was removed:
- ----- Method: HaloMorph>>mouseUp: (in category 'events') -----
- mouseUp: evt
-
- self endInteraction: evt.!
Item was removed:
- ----- Method: HaloMorph>>obtainHaloForEvent:andRemoveAllHandlesBut: (in category 'private') -----
- obtainHaloForEvent: evt andRemoveAllHandlesBut: aHandle
- "Make sure the event's hand correlates with the receiver, and remove all handles except the given one. If nil is provided as the handles argument, the result is that all handles are removed. Note that any pending edits to the name-string in the halo are accepted at this time."
-
- evt hand obtainHalo: self.
- self acceptNameEdit.
- self removeAllHandlesBut: aHandle!
Item was removed:
- ----- Method: HaloMorph>>openViewerForTarget:with: (in category 'handles') -----
- openViewerForTarget: evt with: aHandle
- "Open a viewer for my inner target or if shift pressed make a snapshot of morph."
- self obtainHaloForEvent: evt andRemoveAllHandlesBut: nil.
- evt shiftPressed
- ifTrue: [target duplicateMorphImage: evt]
- ifFalse: [innerTarget openViewerForArgument]!
Item was removed:
- ----- Method: HaloMorph>>popUpFor:at:hand: (in category 'pop up') -----
- popUpFor: morph at: position hand: hand
-
- super popUpFor: morph at: position hand: hand.
-
- self startStepping.
- (Preferences haloTransitions or: [self isMagicHalo])
- ifTrue: [
- self magicAlpha: 0.0.
- self startSteppingSelector: #fadeInInitially].!
Item was removed:
- ----- Method: HaloMorph>>popUpMagicallyFor:hand: (in category 'pop up') -----
- popUpMagicallyFor: aMorph hand: aHand
- "Programatically pop up a halo for a given hand."
-
- super
- popUpMagicallyFor: aMorph
- hand: aHand.
-
- Preferences magicHalos
- ifTrue: [self isMagicHalo: true].
- (Preferences haloTransitions not and: [self isMagicHalo])
- ifTrue: [self magicAlpha: 0.2].
- !
Item was removed:
- ----- Method: HaloMorph>>position: (in category 'geometry') -----
- position: pos
- "Halos display imprefectly if their coordinates are non-integral
- -- especially the direction handles."
-
- ^ super position: pos asIntegerPoint!
Item was removed:
- ----- Method: HaloMorph>>positionDirectionShaft: (in category 'private') -----
- positionDirectionShaft: shaft
- "Position the shaft."
- | alphaRadians unitVector |
- "Pretty crude and slow approach at present, but a stake in the ground"
- alphaRadians := target heading degreesToRadians.
- unitVector := alphaRadians sin @ alphaRadians cos negated.
- shaft setVertices: {unitVector * 6 + directionArrowAnchor. "6 = radius of deadeye circle"
- unitVector * self directionArrowLength + directionArrowAnchor}
- !
Item was removed:
- ----- Method: HaloMorph>>positionIn:horizontalPlacement:verticalPlacement: (in category 'handles') -----
- positionIn: aBox horizontalPlacement: horiz verticalPlacement: vert
- | xCoord yCoord |
-
- horiz == #left
- ifTrue: [xCoord := aBox left].
- horiz == #leftCenter
- ifTrue: [xCoord := aBox left + (aBox width // 4)].
- horiz == #center
- ifTrue: [xCoord := (aBox left + aBox right) // 2].
- horiz == #rightCenter
- ifTrue: [xCoord := aBox left + ((3 * aBox width) // 4)].
- horiz == #right
- ifTrue: [xCoord := aBox right].
-
- vert == #top
- ifTrue: [yCoord := aBox top].
- vert == #topCenter
- ifTrue: [yCoord := aBox top + (aBox height // 4)].
- vert == #center
- ifTrue: [yCoord := (aBox top + aBox bottom) // 2].
- vert == #bottomCenter
- ifTrue: [yCoord := aBox top + ((3 * aBox height) // 4)].
- vert == #bottom
- ifTrue: [yCoord := aBox bottom].
-
- ^ xCoord asInteger @ yCoord asInteger!
Item was removed:
- ----- Method: HaloMorph>>prepareToTrackCenterOfRotation:with: (in category 'private') -----
- prepareToTrackCenterOfRotation: evt with: rotationHandle
- "The mouse went down on the center of rotation."
-
- evt hand obtainHalo: self.
- evt shiftPressed
- ifTrue:
- [self removeAllHandlesBut: rotationHandle.
- rotationHandle setProperty: #trackCenterOfRotation toValue: true.
- evt hand showTemporaryCursor: Cursor blank]
- ifFalse:
- [self currentHand spawnBalloonFor: rotationHandle]!
Item was removed:
- ----- Method: HaloMorph>>removeAllHandlesBut: (in category 'private') -----
- removeAllHandlesBut: h
- "Remove all handles except h."
- (Preferences maintainHalos and:[h isNil])
- ifTrue:[self removeHalo]
- ifFalse:[
- submorphs copy do:
- [:m | m == h ifFalse: [m delete]]
- ].
- !
Item was removed:
- ----- Method: HaloMorph>>restoreTargetDropShadows (in category 'private') -----
- restoreTargetDropShadows
-
- ((self removeProperty: #targetHadDropShadow) ifNil: [false])
- ifTrue: [self target hasDropShadow: true].!
Item was removed:
- ----- Method: HaloMorph>>setCenterOfRotation:with: (in category 'private') -----
- setCenterOfRotation: evt with: rotationHandle
- | localPt |
- evt hand obtainHalo: self.
- evt hand showTemporaryCursor: nil.
- (rotationHandle hasProperty: #trackCenterOfRotation) ifTrue:
- [localPt := innerTarget transformFromWorld globalPointToLocal: rotationHandle center.
- innerTarget setRotationCenterFrom: localPt].
-
- rotationHandle removeProperty: #trackCenterOfRotation.
- self endInteraction: evt.!
Item was removed:
- ----- Method: HaloMorph>>setColor:toHandle: (in category 'private') -----
- setColor: aColor toHandle: aHandle
- "private - change the color to the given handle, applying the
- alternate look if corresponds"
- aHandle color: aColor.
- Preferences alternateHandlesLook
- ifTrue: [| fill |
- fill := GradientFillStyle ramp: {0.0 -> aColor muchLighter. 1.0 -> aColor darker}.
- fill origin: aHandle topLeft.
- fill direction: aHandle extent.
- aHandle fillStyle: fill] !
Item was removed:
- ----- Method: HaloMorph>>setDirection:with: (in category 'private') -----
- setDirection: anEvent with: directionHandle
- "The user has let up after having dragged the direction arrow; now set the forward direction of the actual SketchMorph accordingly"
- (directionHandle hasProperty: #trackDirectionArrow) ifTrue:
- [anEvent hand obtainHalo: self.
- target setDirectionFrom: directionHandle center.
- directionHandle removeProperty: #trackDirectionArrow.
- self endInteraction: anEvent]!
Item was removed:
- ----- Method: HaloMorph>>setDismissColor:with: (in category 'private') -----
- setDismissColor: evt with: dismissHandle
- "Called on mouseStillDown in the dismiss handle; set the color appropriately."
-
- | colorToUse |
- evt hand obtainHalo: self.
- colorToUse := (dismissHandle containsPoint: evt cursorPoint)
- ifFalse:
- [Color red muchLighter]
- ifTrue:
- [Color lightGray].
- self setColor: colorToUse toHandle: dismissHandle.
- !
Item was removed:
- ----- Method: HaloMorph>>setTarget: (in category 'accessing') -----
- setTarget: aMorph
- "Private!! Set the target without adding handles."
-
- target := aMorph topRendererOrSelf.
- innerTarget := target renderedMorph.
- innerTarget wantsDirectionHandles
- ifTrue: [self showDirectionHandles: true addHandles: false].
- target hasHalo: true.
-
- !
Item was removed:
- ----- Method: HaloMorph>>showDirectionHandles: (in category 'private') -----
- showDirectionHandles: wantToShow
-
- self showDirectionHandles: wantToShow addHandles: true "called from menu"
- !
Item was removed:
- ----- Method: HaloMorph>>showDirectionHandles:addHandles: (in category 'private') -----
- showDirectionHandles: wantToShow addHandles: needHandles
- directionArrowAnchor := wantToShow
- ifTrue: [target referencePositionInWorld "not nil means show"]
- ifFalse: [nil].
- needHandles ifTrue: [self addHandles] !
Item was removed:
- ----- Method: HaloMorph>>showingDirectionHandles (in category 'private') -----
- showingDirectionHandles
- ^directionArrowAnchor notNil!
Item was removed:
- ----- Method: HaloMorph>>simpleFudgeOffset (in category 'private') -----
- simpleFudgeOffset
- "account for the difference in basicBoxes between regular and simple handles"
-
- ^ 0 at 0
- !
Item was removed:
- ----- Method: HaloMorph>>startDrag:with: (in category 'private') -----
- startDrag: evt with: dragHandle
- "Drag my target without removing it from its owner."
-
- | itsOwner |
- self obtainHaloForEvent: evt andRemoveAllHandlesBut: dragHandle.
- target aboutToBeDraggedViaHalo.
-
- positionOffset := dragHandle center - (target point: target position in: owner).
-
- ((itsOwner := target topRendererOrSelf owner) notNil and:
- [itsOwner automaticViewing]) ifTrue:
- [target openViewerForArgument]!
Item was removed:
- ----- Method: HaloMorph>>startDragTarget: (in category 'dragging or resizing') -----
- startDragTarget: event
-
- event controlKeyPressed
- ifTrue: [self startResizeTarget: event]
- ifFalse: [
- growingOrRotating := false.
- super startDragTarget: event].!
Item was removed:
- ----- Method: HaloMorph>>startGrow:with: (in category 'private') -----
- startGrow: evt with: growHandle
- "Initialize resizing of my target. Launch a command representing it, to support Undo"
-
- | botRt |
- self obtainHaloForEvent: evt andRemoveAllHandlesBut: growHandle.
- self backupAndHideTargetDropShadows.
- target aboutToBeGrownViaHalo.
-
- botRt := target point: target bottomRight in: owner.
- positionOffset := (self world viewBox containsPoint: botRt)
- ifTrue: [evt cursorPoint - botRt]
- ifFalse: [0 at 0].
-
- self setProperty: #commandInProgress toValue:
- (Command new
- cmdWording: ('resize ' translated, target nameForUndoWording);
- undoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: target extent).
-
- originalExtent := target extent!
Item was removed:
- ----- Method: HaloMorph>>startResizeTarget: (in category 'dragging or resizing') -----
- startResizeTarget: event
- "Begin resizing the target"
- growingOrRotating := true.
- positionOffset := event position.
- self backupAndHideTargetDropShadows.
- target aboutToBeScaledViaHalo.
-
- originalExtent := target extent.
- self removeAllHandlesBut: nil.
- event hand newMouseFocus: self.
- event hand addMouseListener: self. "add handles back on mouse-up"!
Item was removed:
- ----- Method: HaloMorph>>startRot:with: (in category 'private') -----
- startRot: evt with: rotHandle
- "Initialize rotation of my target if it is rotatable. Launch a command object to represent the action"
-
- self obtainHaloForEvent: evt andRemoveAllHandlesBut: rotHandle.
- self backupAndHideTargetDropShadows.
- target aboutToBeRotatedViaHalo.
- target isFlexMorph ifFalse:
- [target isInWorld ifFalse: [self setTarget: target player costume].
- target addFlexShellIfNecessary].
- growingOrRotating := true.
-
- self removeAllHandlesBut: rotHandle. "remove all other handles"
- angleOffset := evt cursorPoint - (target pointInWorld: target referencePosition).
- angleOffset := Point
- r: angleOffset r
- degrees: angleOffset degrees - target rotationDegrees.
- self setProperty: #commandInProgress toValue:
- (Command new
- cmdWording: ('rotate ' translated, target nameForUndoWording);
- undoTarget: target renderedMorph selector: #heading: argument: target rotationDegrees)
-
- !
Item was removed:
- ----- Method: HaloMorph>>startScale:with: (in category 'private') -----
- startScale: evt with: scaleHandle
- "Initialize scaling of my target."
-
- self obtainHaloForEvent: evt andRemoveAllHandlesBut: scaleHandle.
- self backupAndHideTargetDropShadows.
- target aboutToBeScaledViaHalo.
- target isFlexMorph ifFalse: [target addFlexShellIfNecessary].
- growingOrRotating := true.
- positionOffset := 0 at 0.
-
- self setProperty: #commandInProgress toValue:
- (Command new
- cmdWording: ('resize ' translated, target nameForUndoWording);
- undoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: target extent).
- originalExtent := target extent
- !
Item was removed:
- ----- Method: HaloMorph>>step (in category 'stepping') -----
- step
- | newBounds |
- target
- ifNil: [^ self].
- newBounds := target isWorldMorph
- ifTrue: [target bounds]
- ifFalse: [self localHaloBoundsFor: target renderedMorph].
- newBounds = self bounds
- ifTrue: [^ self].
- newBounds extent = self bounds extent
- ifTrue: [^ self position: newBounds origin].
- growingOrRotating
- ifFalse: [submorphs size > 1
- ifTrue: [self addHandles]].
- "adjust halo bounds if appropriate"
- self bounds: newBounds!
Item was removed:
- ----- Method: HaloMorph>>stepTime (in category 'stepping') -----
- stepTime
-
- ^ 0 "every cycle"
- !
Item was removed:
- ----- Method: HaloMorph>>target: (in category 'accessing') -----
- target: aMorph
-
- self setTarget: aMorph.
- target ifNotNil: [self addHandles].
- !
Item was removed:
- ----- Method: HaloMorph>>tearOffTileForTarget:with: (in category 'handles') -----
- tearOffTileForTarget: evt with: aHandle
- "Tear off a tile representing my inner target. If shift key is down, open up an instance browser on the morph itself, not the player, with tiles showing, instead"
-
- self obtainHaloForEvent: evt andRemoveAllHandlesBut: nil.
- innerTarget tearOffTile!
Item was removed:
- ----- Method: HaloMorph>>trackCenterOfRotation:with: (in category 'private') -----
- trackCenterOfRotation: anEvent with: rotationHandle
- (rotationHandle hasProperty: #dragByCenterOfRotation)
- ifTrue:[^self doDrag: anEvent with: rotationHandle].
- (rotationHandle hasProperty: #trackCenterOfRotation)
- ifTrue:
- [anEvent hand obtainHalo: self.
- rotationHandle center: anEvent cursorPoint]!
Item was removed:
- ----- Method: HaloMorph>>trackDirectionArrow:with: (in category 'private') -----
- trackDirectionArrow: anEvent with: shaft
- (shaft hasProperty: #trackDirectionArrow) ifTrue:
- [anEvent hand obtainHalo: self.
- shaft setVertices: {directionArrowAnchor. anEvent cursorPoint}.
- self layoutChanged]!
Item was removed:
- ----- Method: HaloMorph>>veryDeepFixupWith: (in category 'copying') -----
- veryDeepFixupWith: deepCopier
- "If target and arguments fields were weakly copied, fix them here. If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"
-
- super veryDeepFixupWith: deepCopier.
- target := deepCopier references at: target ifAbsent: [target].
- innerTarget := deepCopier references at: innerTarget ifAbsent: [innerTarget].
- !
Item was removed:
- ----- Method: HaloMorph>>veryDeepInner: (in category 'copying') -----
- veryDeepInner: deepCopier
- "Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment."
-
- super veryDeepInner: deepCopier.
- "target := target. Weakly copied"
- "innerTarget := innerTarget. Weakly copied"
- positionOffset := positionOffset veryDeepCopyWith: deepCopier.
- angleOffset := angleOffset veryDeepCopyWith: deepCopier.
- growingOrRotating := growingOrRotating veryDeepCopyWith: deepCopier.
- directionArrowAnchor := directionArrowAnchor.
- simpleMode := simpleMode.
- haloBox := haloBox.
- originalExtent := originalExtent
- !
Item was removed:
- ----- Method: HaloMorph>>wantsKeyboardFocusFor: (in category 'events') -----
- wantsKeyboardFocusFor: aSubmorph
- "to allow the name to be edited in the halo in the old tty way; when we morphic-text-ize the name editing, presumably this method should be removed"
- ^ true!
Item was removed:
- ----- Method: HaloMorph>>wantsToBeTopmost (in category 'accessing') -----
- wantsToBeTopmost
- "Answer if the receiver want to be one of the topmost objects in
- its owner"
- ^ true!
Item was removed:
- ----- Method: HaloMorph>>wantsYellowButtonMenu (in category 'menu') -----
- wantsYellowButtonMenu
- "Answer true if the receiver wants a yellow button menu"
- ^ false!
Item was removed:
- Object subclass: #HaloSpec
- instanceVariableNames: 'addHandleSelector horizontalPlacement verticalPlacement color iconSymbol'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !HaloSpec commentStamp: 'kfr 10/27/2003 16:23' prior: 0!
- Sets spec's for how handles are layed out in a halo.!
Item was removed:
- ----- Method: HaloSpec>>addHandleSelector (in category 'accessing') -----
- addHandleSelector
- ^ addHandleSelector!
Item was removed:
- ----- Method: HaloSpec>>color (in category 'accessing') -----
- color
- ^ color!
Item was removed:
- ----- Method: HaloSpec>>horizontalPlacement (in category 'accessing') -----
- horizontalPlacement
- ^ horizontalPlacement!
Item was removed:
- ----- Method: HaloSpec>>horizontalPlacement:verticalPlacement:color:iconSymbol:addHandleSelector: (in category 'initialization') -----
- horizontalPlacement: hp verticalPlacement: vp color: col iconSymbol: is addHandleSelector: sel
- horizontalPlacement := hp.
- verticalPlacement := vp.
- color:= col.
- iconSymbol := is asSymbol.
- addHandleSelector := sel!
Item was removed:
- ----- Method: HaloSpec>>iconSymbol (in category 'accessing') -----
- iconSymbol
- ^ iconSymbol!
Item was removed:
- ----- Method: HaloSpec>>printOn: (in category 'printing') -----
- printOn: aStream
- "Add a textual printout representing the receiver to a stream"
-
- super printOn: aStream.
- aStream nextPutAll: ' (', addHandleSelector asString, ' ', iconSymbol asString, ')'!
Item was removed:
- ----- Method: HaloSpec>>verticalPlacement (in category 'accessing') -----
- verticalPlacement
- ^ verticalPlacement!
Item was removed:
- Morph subclass: #HandMorph
- instanceVariableNames: 'mouseFocus keyboardFocus eventListeners mouseListeners keyboardListeners eventCaptureFilters mouseCaptureFilters keyboardCaptureFilters mouseClickState mouseOverHandler targetOffset lastMouseEvent lastKeyDownEvent damageRecorder cacheCanvas cachedCanvasHasHoles temporaryCursor temporaryCursorOffset hardwareCursor hasChanged savedPatch userInitials lastEventBuffer genieGestureProcessor keyboardInterpreter externalDropMorph'
- classVariableNames: 'CompositionWindowManager DoubleClickTime DragThreshold EventStats MinimalWheelDelta NewEventRules NormalCursor PasteBuffer SendMouseWheelToKeyboardFocus ShowEvents SynthesizeMouseWheelEvents'
- poolDictionaries: 'EventSensorConstants'
- category: 'Morphic-Kernel'!
-
- !HandMorph commentStamp: '<historical>' prior: 0!
- The cursor may be thought of as the HandMorph. The hand's submorphs hold anything being carried by dragging.
-
- There is some minimal support for multiple hands in the same world.!
Item was removed:
- ----- Method: HandMorph class>>applyUserInterfaceTheme (in category 'preferences') -----
- applyUserInterfaceTheme
-
- NormalCursor := CursorWithMask normal asCursorForm scaleIconToDisplay.!
Item was removed:
- ----- Method: HandMorph class>>attach: (in category 'utilities') -----
- attach: aMorph
- "Attach aMorph the current world's primary hand."
-
- self currentWorld primaryHand attachMorph: aMorph!
Item was removed:
- ----- Method: HandMorph class>>cleanUp: (in category 'initialization') -----
- cleanUp: aggressive
-
- aggressive ifTrue: [EventStats := nil].!
Item was removed:
- ----- Method: HandMorph class>>clearCompositionWindowManager (in category 'initialization') -----
- clearCompositionWindowManager
-
- CompositionWindowManager := nil.
- !
Item was removed:
- ----- Method: HandMorph class>>clearInterpreters (in category 'initialization') -----
- clearInterpreters
-
- self allInstances do: [:each | each clearKeyboardInterpreter].
- !
Item was removed:
- ----- Method: HandMorph class>>compositionWindowManager (in category 'Multilingual-ImmPlugin') -----
- compositionWindowManager
- self flag: #ImmPlugin.
- CompositionWindowManager ifNotNil: [^CompositionWindowManager].
- Smalltalk platformName = 'Win32'
- ifTrue: [^CompositionWindowManager := ImmWin32 new].
- (Smalltalk platformName = 'unix'
- and: [(Smalltalk windowSystemName) = 'X11'])
- ifTrue: [^CompositionWindowManager := ImmX11 new].
- ^CompositionWindowManager := ImmAbstractPlatform new!
Item was removed:
- ----- Method: HandMorph class>>doubleClickTime (in category 'accessing') -----
- doubleClickTime
-
- ^ DoubleClickTime
- !
Item was removed:
- ----- Method: HandMorph class>>doubleClickTime: (in category 'accessing') -----
- doubleClickTime: milliseconds
-
- DoubleClickTime := milliseconds.
- !
Item was removed:
- ----- Method: HandMorph class>>dragThreshold (in category 'accessing') -----
- dragThreshold
-
- ^ DragThreshold
- !
Item was removed:
- ----- Method: HandMorph class>>dragThreshold: (in category 'accessing') -----
- dragThreshold: pixels
-
- DragThreshold := pixels!
Item was removed:
- ----- Method: HandMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
- includeInNewMorphMenu
- "Not to be instantiated from the menu"
- ^ false!
Item was removed:
- ----- Method: HandMorph class>>initialize (in category 'class initialization') -----
- initialize
- "HandMorph initialize"
- PasteBuffer := nil.
- DoubleClickTime := 350 "milliseconds".
- DragThreshold := 10 "pixels".
- NormalCursor := CursorWithMask normal asCursorForm!
Item was removed:
- ----- Method: HandMorph class>>localeChanged (in category 'class initialization') -----
- localeChanged
- self startUp: true.!
Item was removed:
- ----- Method: HandMorph class>>minimumWheelDelta (in category 'preferences') -----
- minimumWheelDelta
- <preference: 'Minimal Mouse Wheel Detection Threshold'
- categoryList: #(Morphic mouse)
- description: 'Answer the minimal scrolling units taken into account
- Defaults to 120 (See #scrollUnitsPerMouseWheelNotch), corresponding to a single mouse wheel notch.
- Use a lower value (20 - See #minimalScrollUnitsPerEvent) if wanting smoother scrolling with trackpads.'
- type: #Number>
- ^MinimalWheelDelta ifNil: [MouseWheelEvent scrollUnitsPerMouseWheelNotch].!
Item was removed:
- ----- Method: HandMorph class>>minimumWheelDelta: (in category 'preferences') -----
- minimumWheelDelta: anInteger
- MinimalWheelDelta := anInteger ifNotNil: [anInteger
- clampLow: MouseWheelEvent minimalScrollUnitsPerEvent
- high: MouseWheelEvent scrollUnitsPerMouseWheelNotch]!
Item was removed:
- ----- Method: HandMorph class>>newEventRules: (in category 'utilities') -----
- newEventRules: aBool
- NewEventRules := aBool.!
Item was removed:
- ----- Method: HandMorph class>>sendMouseWheelToKeyboardFocus (in category 'preferences') -----
- sendMouseWheelToKeyboardFocus
- <preference: 'Send Mouse Wheel Events to Keyboard Focus'
- categoryList: #(Morphic keyboard mouse)
- description: 'If enabled, follow the behavior known from older versions of Microsoft Windows, where the mouse wheel works for the widget that has the keyboard focus. If disabled, follow the Mac OS style, where the mouse wheel is send to the widget under the mouse position.'
- type: #Boolean>
- ^ SendMouseWheelToKeyboardFocus ifNil: [true]!
Item was removed:
- ----- Method: HandMorph class>>sendMouseWheelToKeyboardFocus: (in category 'preferences') -----
- sendMouseWheelToKeyboardFocus: aBoolean
- SendMouseWheelToKeyboardFocus := aBoolean.!
Item was removed:
- ----- Method: HandMorph class>>showEvents: (in category 'utilities') -----
- showEvents: aBool
- "HandMorph showEvents: true"
- "HandMorph showEvents: false"
-
- ShowEvents := aBool.
- aBool ifFalse: [
- Project current world invalidRect: (0 at 0 extent: 250 at 120)].!
Item was removed:
- ----- Method: HandMorph class>>startUp: (in category 'initialization') -----
- startUp: resuming
-
- resuming ifFalse: [^ self].
- self clearCompositionWindowManager.
- self clearInterpreters.
- !
Item was removed:
- ----- Method: HandMorph class>>synthesizeMouseWheelEvents (in category 'preferences') -----
- synthesizeMouseWheelEvents
- <preference: 'Synthesize Mouse Wheel Events from Keyboard Events'
- categoryList: #(Morphic keyboard mouse)
- description: 'If enabled, convert CTRL+Up/Down (keystroke with modifier key) to mouse wheel up/down. Disable this according to the current VM behavior.'
- type: #Boolean>
- ^ SynthesizeMouseWheelEvents ifNil: [true]!
Item was removed:
- ----- Method: HandMorph class>>synthesizeMouseWheelEvents: (in category 'preferences') -----
- synthesizeMouseWheelEvents: aBoolean
- SynthesizeMouseWheelEvents := aBoolean.!
Item was removed:
- ----- Method: HandMorph class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ super themeProperties, {
- { #cursor. 'Cursor'. 'Temporary cursor for drag-drop interaction using submorphs.' }
- }!
Item was removed:
- ----- Method: HandMorph>>addBalloonHelp: (in category 'balloon help') -----
- addBalloonHelp: aBalloonMorph
- "Associate a new balloon morph with this hand."
-
- self removeAlarm: #spawnBalloonFor:.
- aBalloonMorph ifNotNil: [:m | self balloonHelpList add: m].!
Item was removed:
- ----- Method: HandMorph>>addEventListener: (in category 'events-listening') -----
- addEventListener: anObject
- "Make anObject a listener for all events. All events will be reported to the object."
- self eventListeners: (self addListener: anObject to: self eventListeners)!
Item was removed:
- ----- Method: HandMorph>>addKeyboardListener: (in category 'events-listening') -----
- addKeyboardListener: anObject
- "Make anObject a listener for keyboard events. All keyboard events will be reported to the object."
- self keyboardListeners: (self addListener: anObject to: self keyboardListeners)!
Item was removed:
- ----- Method: HandMorph>>addListener:to: (in category 'events-listening') -----
- addListener: anObject to: aListenerGroup
- "Add anObject to the given listener group. Return the new group."
- | listeners |
- listeners := aListenerGroup.
- (listeners notNil and:[listeners includes: anObject]) ifFalse:[
- listeners
- ifNil:[listeners := WeakArray with: anObject]
- ifNotNil:[listeners := listeners copyWith: anObject]].
- listeners := listeners copyWithout: nil. "obsolete entries"
- ^listeners!
Item was removed:
- ----- Method: HandMorph>>addMouseListener: (in category 'events-listening') -----
- addMouseListener: anObject
- "Make anObject a listener for mouse events. All mouse events will be reported to the object."
- self mouseListeners: (self addListener: anObject to: self mouseListeners)!
Item was removed:
- ----- Method: HandMorph>>anyButtonPressed (in category 'accessing') -----
- anyButtonPressed
- ^lastMouseEvent anyButtonPressed!
Item was removed:
- ----- Method: HandMorph>>applyUserInterfaceTheme (in category 'updating') -----
- applyUserInterfaceTheme
-
- self showTemporaryCursor: nil.!
Item was removed:
- ----- Method: HandMorph>>attachMorph: (in category 'grabbing/dropping') -----
- attachMorph: m
- "Position the center of the given morph under this hand, then grab it.
- This method is used to grab far away or newly created morphs."
- | delta |
- self releaseMouseFocus. "Break focus"
- self showTemporaryCursor: nil.
- delta := m bounds extent // 2.
- m position: (self position - delta).
- m formerPosition: m position.
- targetOffset := m position - self position.
- self addMorphBack: m.!
Item was removed:
- ----- Method: HandMorph>>autoFocusRectangleBoundsFor: (in category 'genie-stubs') -----
- autoFocusRectangleBoundsFor: aMorph
- ^aMorph bounds!
Item was removed:
- ----- Method: HandMorph>>balloonHelpList (in category 'balloon help') -----
- balloonHelpList
- "Return all balloon morphs associated with this hand"
-
- self flag: #performance. "mt: Make it an instance variable because we need to access this on every keystroke in a text field. See senders of #deleteBalloon."
-
- ^ self
- valueOfProperty: #balloonHelpMorphs
- ifAbsentPut: [OrderedCollection new]!
Item was removed:
- ----- Method: HandMorph>>becomeActiveDuring: (in category 'initialization') -----
- becomeActiveDuring: aBlock
- "Make the receiver the active hand during the evaluation of aBlock."
-
- ^ ActiveHandVariable value: self during: aBlock!
Item was removed:
- ----- Method: HandMorph>>changed (in category 'updating') -----
- changed
-
- hasChanged := true.
- !
Item was removed:
- ----- Method: HandMorph>>cleanUp: (in category 'initialize-release') -----
- cleanUp: aggressive
-
- aggressive ifTrue: [
- externalDropMorph := nil].!
Item was removed:
- ----- Method: HandMorph>>clearKeyboardInterpreter (in category 'multilingual') -----
- clearKeyboardInterpreter
-
- keyboardInterpreter := nil.
- !
Item was removed:
- ----- Method: HandMorph>>colorForInsets (in category 'accessing') -----
- colorForInsets
- "Morphs being dragged by the hand use the world's color"
- ^ owner colorForInsets!
Item was removed:
- ----- Method: HandMorph>>compositionWindowManager (in category 'Multilingual-ImmPlugin') -----
- compositionWindowManager
-
- self flag: #ImmPlugin.
- ^ self class compositionWindowManager.!
Item was removed:
- ----- Method: HandMorph>>copyToPasteBuffer: (in category 'meta-actions') -----
- copyToPasteBuffer: aMorph
- "Save this morph in the paste buffer. This is mostly useful for copying morphs between projects."
- aMorph ifNil:[^PasteBuffer := nil].
- Cursor wait showWhile:[
- PasteBuffer := aMorph topRendererOrSelf veryDeepCopy.
- PasteBuffer privateOwner: nil].
-
- !
Item was removed:
- ----- Method: HandMorph>>cursorBounds (in category 'cursor') -----
- cursorBounds
-
- ^temporaryCursor
- ifNil: [self position extent: NormalCursor extent]
- ifNotNil: [self position + temporaryCursorOffset extent: temporaryCursor extent]!
Item was removed:
- ----- Method: HandMorph>>cursorPoint (in category 'event handling') -----
- cursorPoint
- "Implemented for allowing embedded worlds in an event cycle to query a hand's position and get it in its coordinates. The same can be achieved by #point:from: but this is simply much more convenient since it will look as if the hand is in the lower world."
-
- ^ self currentWorld point: self position from: owner!
Item was removed:
- ----- Method: HandMorph>>deleteBalloonTarget: (in category 'balloon help') -----
- deleteBalloonTarget: aMorph
- "Delete any existing balloon help."
-
- self balloonHelpList
- do: [:ea | ea delete];
- removeAll.!
Item was removed:
- ----- Method: HandMorph>>disableGenieFocus (in category 'genie-stubs') -----
- disableGenieFocus
- !
Item was removed:
- ----- Method: HandMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- "Draw the hand itself (i.e., the cursor)."
-
- | userPic |
- temporaryCursor isNil
- ifTrue: [aCanvas paintImage: NormalCursor at: bounds topLeft]
- ifFalse: [aCanvas paintImage: temporaryCursor at: bounds topLeft].
- self hasUserInformation
- ifTrue:
- [aCanvas
- drawString: userInitials
- at: self cursorBounds topRight + (0 @ 4)
- font: nil
- color: color.
- (userPic := self userPicture) ifNotNil:
- [aCanvas paintImage: userPic at: self cursorBounds topRight + (0 @ 24)]]!
Item was removed:
- ----- Method: HandMorph>>dropMorph:event: (in category 'grabbing/dropping') -----
- dropMorph: aMorph event: anEvent
- "Drop the given morph which was carried by the hand"
- | event dropped |
- (anEvent isMouseUp and: [aMorph shouldDropOnMouseUp not]) ifTrue: [^ self].
-
- "Note: For robustness in drag and drop handling, we remove the morph BEFORE we drop it, but we keep its owner set to the hand. This prevents system lockups when there is a problem in drop handling (for example if there's an error in #wantsToBeDroppedInto:). THIS TECHNIQUE IS NOT RECOMMENDED FOR CASUAL USE."
- self privateRemove: aMorph.
- aMorph privateOwner: self.
-
- dropped := aMorph.
- (dropped hasProperty: #addedFlexAtGrab)
- ifTrue: [dropped := aMorph removeFlexShell].
- event := DropEvent new setPosition: self position contents: dropped hand: self.
-
- [ "In case of an error, ensure that the morph-to-be-dropped will be disposed. Otherwise it may confuse garbage handler. See the sends of #privateRemove: and #privateOwner: above."
- event := self sendEvent: event focus: nil. "event filters can apply and filtered events will be returned"
- event wasHandled ifFalse: [aMorph rejectDropMorphEvent: event] ]
- ensure: [ aMorph owner == self ifTrue: [aMorph delete] ].
-
- self mouseOverHandler processMouseOver: anEvent.!
Item was removed:
- ----- Method: HandMorph>>dropMorphs (in category 'grabbing/dropping') -----
- dropMorphs
- "Drop the morphs at the hands position"
- self dropMorphs: lastMouseEvent.!
Item was removed:
- ----- Method: HandMorph>>dropMorphs: (in category 'grabbing/dropping') -----
- dropMorphs: anEvent
- "Drop the morphs at the hands position"
- self submorphsReverseDo:[:m|
- "Drop back to front to maintain z-order"
- self dropMorph: m event: anEvent.
- ].!
Item was removed:
- ----- Method: HandMorph>>enableGenie (in category 'genie-stubs') -----
- enableGenie
- self error: 'Genie is not available for this hand'.!
Item was removed:
- ----- Method: HandMorph>>eventBubbleFilters (in category 'events-filtering-bubbling') -----
- eventBubbleFilters
- Error signal: 'Hand morphs do only have capture filters. Install top-most bubble filters in the world.'!
Item was removed:
- ----- Method: HandMorph>>eventCaptureFilters (in category 'events-filtering-capturing') -----
- eventCaptureFilters
- ^ eventCaptureFilters!
Item was removed:
- ----- Method: HandMorph>>eventCaptureFilters: (in category 'events-filtering-capturing') -----
- eventCaptureFilters: anArrayOrNil
- eventCaptureFilters := anArrayOrNil!
Item was removed:
- ----- Method: HandMorph>>eventListeners (in category 'events-listening') -----
- eventListeners
- ^eventListeners!
Item was removed:
- ----- Method: HandMorph>>eventListeners: (in category 'events-listening') -----
- eventListeners: anArrayOrNil
- eventListeners := anArrayOrNil!
Item was removed:
- ----- Method: HandMorph>>filterEvent:for: (in category 'events-filtering') -----
- filterEvent: aKeyboardEvent for: aMorphOrNil
- "Fixes VM behavior. Usually, there are no mouse wheel events generated by the VM but CTRL+UP/DOWN. Convert these into mouse wheel events.
-
- We installed ourself as keyboard filter only!! No need to check whether this is a keyboard event or not!! See HandMorph >> #initForEvents.
-
- Might be removed in the future if this mapping gets obsolete."
-
- HandMorph synthesizeMouseWheelEvents ifFalse: [^ aKeyboardEvent].
-
- (aKeyboardEvent isKeystroke and: [aKeyboardEvent controlKeyPressed]) ifTrue: [
- aKeyboardEvent keyCharacter caseOf: {
- [Character arrowUp] -> [^ self generateMouseWheelEvent: aKeyboardEvent direction: 2r1000].
- [Character arrowDown] -> [^ self generateMouseWheelEvent: aKeyboardEvent direction: 2r0100].
- } otherwise: [^ aKeyboardEvent]].
-
- ^ aKeyboardEvent!
Item was removed:
- ----- Method: HandMorph>>flushEvents (in category 'event handling') -----
- flushEvents
- "Flush any events that may be pending"
- self flag: #arNote. "Remove it and fix senders"
- Sensor flushEvents.!
Item was removed:
- ----- Method: HandMorph>>focusStartEvent (in category 'genie-stubs') -----
- focusStartEvent
- ^nil!
Item was removed:
- ----- Method: HandMorph>>fullBounds (in category 'layout') -----
- fullBounds
- "Extend my bounds by the shadow offset when carrying morphs."
-
- | bnds |
- bnds := super fullBounds.
- submorphs isEmpty
- ifTrue: [^ bnds ]
- ifFalse: [^ bnds topLeft corner: bnds bottomRight + self shadowOffset].
- !
Item was removed:
- ----- Method: HandMorph>>fullDrawOn: (in category 'drawing') -----
- fullDrawOn: aCanvas
- "A HandMorph has unusual drawing requirements:
- 1. the hand itself (i.e., the cursor) appears in front of its submorphs
- 2. morphs being held by the hand cast a shadow on the world/morphs below
- The illusion is that the hand plucks up morphs and carries them above the world."
-
- "Note: This version caches an image of the morphs being held by the hand for
- better performance. This cache is invalidated if one of those morphs changes."
-
- | disableCaching subBnds |
- self visible ifFalse: [^self].
- (aCanvas isVisible: self fullBounds) ifFalse: [^self].
- (self hasProperty: #errorOnDraw) ifTrue:[^self drawErrorOn: aCanvas].
- disableCaching := false.
- disableCaching
- ifTrue:
- [self nonCachingFullDrawOn: aCanvas.
- ^self].
- submorphs isEmpty
- ifTrue:
- [cacheCanvas := nil.
- ^self drawOn: aCanvas]. "just draw the hand itself"
-
- "special handling of a single submorph that wants to do its own thing
- when being dragged"
- (submorphs size = 1
- and: [submorphs first handledOwnDraggingBy: self on: aCanvas])
- ifTrue: [^ self drawOn: aCanvas].
-
- subBnds := Rectangle merging: (submorphs collect: [:m | m fullBounds]).
- self updateCacheCanvas: aCanvas.
- (cacheCanvas isNil
- or: [cachedCanvasHasHoles and: [cacheCanvas depth = 1]])
- ifTrue:
- ["could not use caching due to translucency; do full draw"
-
- self nonCachingFullDrawOn: aCanvas.
- ^self].
-
- "draw the shadow"
- aCanvas asShadowDrawingCanvas translateBy: self shadowOffset
- during:
- [:shadowCanvas |
- cachedCanvasHasHoles
- ifTrue:
- ["Have to draw the real shadow of the form"
-
- shadowCanvas paintImage: cacheCanvas form at: subBnds origin]
- ifFalse:
- ["Much faster if only have to shade the edge of a solid rectangle"
-
- (subBnds areasOutside: (subBnds translateBy: self shadowOffset negated))
- do: [:r | shadowCanvas fillRectangle: r color: Color black]]].
-
- "draw morphs in front of the shadow using the cached Form"
- cachedCanvasHasHoles
- ifTrue: [aCanvas paintImage: cacheCanvas form at: subBnds origin]
- ifFalse:
- [aCanvas
- drawImage: cacheCanvas form
- at: subBnds origin
- sourceRect: cacheCanvas form boundingBox].
- self drawOn: aCanvas "draw the hand itself in front of morphs"!
Item was removed:
- ----- Method: HandMorph>>generateDropFilesEvent: (in category 'private events') -----
- generateDropFilesEvent: evtBuf
- "Generate the appropriate mouse event for the given raw event buffer."
-
- | position buttons modifiers stamp numFiles dragType |
- stamp := evtBuf second.
- stamp = 0 ifTrue: [stamp := Time eventMillisecondClock].
- dragType := evtBuf third.
- position := evtBuf fourth @ evtBuf fifth.
- buttons := MouseEvent redButton. "hacked because necessary for correct mouseMoveDragging handling"
- modifiers := evtBuf sixth.
- buttons := buttons bitOr: (modifiers bitShift: MouseEvent numButtons).
- numFiles := evtBuf seventh.
-
- dragType caseOf: {
- [1] -> [ "dragEnter"
- externalDropMorph := TransferMorph new
- dragTransferType: #filesAndDirectories;
- source: self;
- passenger: (numFiles = 0 "Usually, numFiles and drop paths are delivered on dragDrop only. Still reserving this possibility for able host implementations."
- ifTrue: [self flag: #vmCapabilityMissing. 'Unknown host content' translated]
- ifFalse: [FileDirectory dropFilesAndDirectories: numFiles]);
- yourself.
-
- "During the drag operation, the host system is responsible for displaying the cursor."
- self grabMorph: externalDropMorph.
- self showTemporaryCursor: Cursor blank.
- externalDropMorph bottomRight: self topLeft. "Southeast area of the cursor is blocked by drawings from the source application. Display our drop morph at the opposite corner of the cursor." ].
- [2] -> [ "dragMove"
- ^ MouseMoveEvent new
- setType: #mouseMove
- startPoint: self position
- endPoint: position
- trail: "{self position. position}"(self mouseDragTrailFrom: evtBuf)
- buttons: buttons
- hand: self
- stamp: stamp ].
- [3] -> [ "dragLeave"
- externalDropMorph ifNotNil: #abandon.
- externalDropMorph := nil.
- self showTemporaryCursor: nil ].
- [4] -> [ "dragDrop"
- | oldButtons event |
- oldButtons := lastEventBuffer fifth
- bitOr: (lastEventBuffer sixth bitShift: MouseEvent numButtons).
- event := MouseButtonEvent new
- setType: #mouseUp
- position: position
- which: (oldButtons bitXor: buttons)
- buttons: buttons
- nClicks: 0
- hand: self
- stamp: stamp.
-
- externalDropMorph ifNil: [
- "dragDrop has been sent without prior dragging. This happens when the VM is configured as singleton application and has been invoked again with a new image file (aka #launchDrop, runAsSingleInstance on Unix, or RunSingleApp on Windows)."
- self flag: #forLater. "ct: When we decouple event generation from Morphic, we will probably need to introduce a separate SystemLaunchEvent class for this event. See http://forum.world.st/Changeset-Enhanced-integration-of-drag-n-drop-from-host-tp5123857p5124332.html."
- Project current
- launchSystemFiles: (FileDirectory dropFilesAndDirectories: numFiles)
- event: event.
- ^ nil].
-
- self showTemporaryCursor: nil.
- externalDropMorph passenger isString ifTrue: [
- self flag: #vmCapabilityMissing. "See above."
- externalDropMorph passenger: (FileDirectory dropFilesAndDirectories: numFiles)].
- externalDropMorph := nil.
-
- (Smalltalk classNamed: #DropFilesEvent) ifNotNil: [:eventClass |
- | classicEvent |
- "Generate classic DropFilesEvent, providing backward compatibility."
- classicEvent := eventClass new
- setPosition: position
- contents: numFiles
- hand: self.
- self processEvent: classicEvent.
- classicEvent wasHandled ifTrue: [^ nil]].
-
- ^ event ].
- [5] -> [ "drag request"
- "For dnd out. Not properly implemented at the moment."
- self shouldBeImplemented] }.
- ^ nil!
Item was removed:
- ----- Method: HandMorph>>generateKeyboardEvent: (in category 'private events') -----
- generateKeyboardEvent: evtBuf
- "Generate the appropriate mouse event for the given raw event buffer"
-
- | buttons modifiers type pressType stamp keyValue keyCode |
- stamp := evtBuf second.
- stamp = 0 ifTrue: [stamp := Sensor eventTimeNow].
- pressType := evtBuf fourth.
- pressType = EventKeyDown ifTrue: [type := #keyDown].
- pressType = EventKeyUp ifTrue: [type := #keyUp].
- pressType = EventKeyChar ifTrue: [type := #keystroke].
- modifiers := evtBuf fifth.
- buttons := (modifiers bitShift: MouseEvent numButtons) bitOr: (lastMouseEvent buttons bitAnd: MouseEvent anyButton).
- type = #keystroke
- ifTrue: [
- keyValue := (self keyboardInterpreter nextCharFrom: EventSensor default firstEvt: evtBuf) asInteger.
- keyCode := lastKeyDownEvent keyValue]
- ifFalse: [keyValue := keyCode := evtBuf third].
- ^ KeyboardEvent new
- setType: type
- buttons: buttons
- position: self position
- keyValue: keyValue
- keyCode: keyCode
- hand: self
- stamp: stamp.
- !
Item was removed:
- ----- Method: HandMorph>>generateMouseEvent: (in category 'private events') -----
- generateMouseEvent: evtBuf
- "Generate the appropriate mouse event for the given raw event buffer"
-
- | position buttons modifiers type trail stamp oldButtons evtChanged |
- evtBuf first = lastEventBuffer first ifTrue:
- ["Workaround for Mac VM bug, *always* generating 3 events on clicks"
- evtChanged := false.
- 3 to: evtBuf size do:
- [:i | (lastEventBuffer at: i) = (evtBuf at: i) ifFalse: [evtChanged := true]].
- evtChanged ifFalse: [^nil]].
- stamp := evtBuf second.
- stamp = 0 ifTrue: [stamp := Sensor eventTimeNow].
- position := evtBuf third @ evtBuf fourth.
- buttons := evtBuf fifth.
- modifiers := evtBuf sixth.
-
- type := buttons = 0
- ifTrue:
- [lastEventBuffer fifth = 0
- ifTrue: [#mouseMove] "this time no button and previously no button .. just mouse move"
- ifFalse: [#mouseUp]] "this time no button but previously some button ... therefore button was released"
- ifFalse:
- [buttons = lastEventBuffer fifth
- ifTrue: [#mouseMove] "button states are the same .. now and past .. therfore a mouse movement"
- ifFalse: "button states are different .. button was pressed or released"
- [buttons > lastEventBuffer fifth
- ifTrue: [#mouseDown]
- ifFalse:[#mouseUp]]].
- buttons := buttons bitOr: (modifiers bitShift: MouseEvent numButtons).
- oldButtons := lastEventBuffer fifth bitOr: (lastEventBuffer sixth bitShift: MouseEvent numButtons).
- lastEventBuffer := evtBuf.
- type == #mouseMove ifTrue:
- [trail := self mouseTrailFrom: evtBuf.
- ^MouseMoveEvent new
- setType: type
- startPoint: self position
- endPoint: trail last
- trail: trail
- buttons: buttons
- hand: self
- stamp: stamp].
- ^MouseButtonEvent new
- setType: type
- position: position
- which: (oldButtons bitXor: buttons)
- buttons: buttons
- nClicks: (evtBuf seventh ifNil: [0])
- hand: self
- stamp: stamp!
Item was removed:
- ----- Method: HandMorph>>generateMouseWheelEvent: (in category 'private events') -----
- generateMouseWheelEvent: evtBuf
- "Generate the appropriate mouse wheel event for the given raw event buffer"
-
- | buttons modifiers deltaX deltaY stamp nextEvent |
- stamp := evtBuf second.
- stamp = 0 ifTrue: [stamp := Sensor eventTimeNow].
- deltaX := evtBuf third.
- deltaY := evtBuf fourth.
- buttons := evtBuf fifth.
- modifiers := evtBuf sixth.
- [(deltaX abs + deltaY abs < self class minimumWheelDelta)
- and: [(nextEvent := Sensor peekEvent) notNil
- and: [nextEvent first = evtBuf first
- and: [nextEvent fifth = evtBuf fifth
- and: [nextEvent sixth = evtBuf sixth]
- and: [nextEvent third isZero = evtBuf third isZero "both horizontal or vertical"]]]]]
- whileTrue:
- ["nextEvent is similar. Remove it from the queue, and check the next."
- nextEvent := Sensor nextEvent.
- deltaX := deltaX + nextEvent third.
- deltaY := deltaY + nextEvent fourth].
- ^ MouseWheelEvent new
- setType: #mouseWheel
- position: self position
- delta: deltaX at deltaY
- buttons: buttons
- hand: self
- stamp: stamp!
Item was removed:
- ----- Method: HandMorph>>generateMouseWheelEvent:direction: (in category 'private events') -----
- generateMouseWheelEvent: keystrokeEvent direction: direction
- "Generate the appropriate mouse wheel event from the keystrokeEvent. Before calling this, ensure that the control key is pressed.
-
- This method can be discarded once the VM produces real mouse wheel events."
-
- ^ MouseWheelEvent new
- setType: #mouseWheel
- position: keystrokeEvent position
- delta: 0 @ ((direction anyMask: 2r1000 "wheel up") ifTrue: [MouseWheelEvent scrollUnitsPerMouseWheelNotch] ifFalse: [MouseWheelEvent scrollUnitsPerMouseWheelNotch negated])
- direction: direction
- buttons: (keystrokeEvent buttons bitAnd: 2r01111) "drop control key pressed for this conversion"
- hand: keystrokeEvent hand
- stamp: keystrokeEvent timeStamp!
Item was removed:
- ----- Method: HandMorph>>generateWindowEvent: (in category 'private events') -----
- generateWindowEvent: evtBuf
- "Generate the appropriate window event for the given raw event buffer"
-
- | evt |
- evt := WindowEvent new.
- evt setHand: self.
- evt setTimeStamp: evtBuf second.
- evt timeStamp = 0 ifTrue: [evt setTimeStamp: Sensor eventTimeNow].
- evt action: evtBuf third.
- evt rectangle: (Rectangle origin: evtBuf fourth @ evtBuf fifth corner: evtBuf sixth @ evtBuf seventh ).
-
- ^evt!
Item was removed:
- ----- Method: HandMorph>>genieGestureProcessor (in category 'genie-stubs') -----
- genieGestureProcessor
- ^nil!
Item was removed:
- ----- Method: HandMorph>>grabMorph: (in category 'meta-actions') -----
- grabMorph: aMorph
- "Grab the given morph (i.e., add it to this hand and remove it from its current owner) without changing its position. This is used to pick up a morph under the hand's current position, versus attachMorph: which is used to pick up a morph that may not be near this hand."
- | grabbed |
- self releaseMouseFocus. "Break focus"
- self showTemporaryCursor: nil.
- grabbed := aMorph aboutToBeGrabbedBy: self.
- grabbed ifNil:[^self].
- grabbed := grabbed topRendererOrSelf.
- ^self grabMorph: grabbed from: grabbed owner!
Item was removed:
- ----- Method: HandMorph>>grabMorph:from: (in category 'grabbing/dropping') -----
- grabMorph: aMorph from: formerOwner
- "Grab the given morph (i.e., add it to this hand and remove it from its current owner) without changing its position. This is used to pick up a morph under the hand's current position, versus attachMorph: which is used to pick up a morph that may not be near this hand."
-
- | grabbed offset targetPoint grabTransform fullTransform |
- self releaseMouseFocus. "Break focus"
- self showTemporaryCursor: nil.
- grabbed := aMorph.
- aMorph keepsTransform ifTrue:[
- grabTransform := fullTransform := IdentityTransform new.
- ] ifFalse:[
- "Compute the transform to apply to the grabbed morph"
- grabTransform := formerOwner
- ifNil: [IdentityTransform new]
- ifNotNil: [formerOwner grabTransform].
- "Compute the full transform for the grabbed morph"
- fullTransform := formerOwner
- ifNil: [IdentityTransform new]
- ifNotNil: [formerOwner transformFrom: owner].
- ].
- "targetPoint is point in aMorphs reference frame"
- targetPoint := fullTransform globalPointToLocal: self position.
- "but current position will be determined by grabTransform, so compute offset"
- offset := targetPoint - (grabTransform globalPointToLocal: self position).
- "apply the transform that should be used after grabbing"
- grabbed := grabbed transformedBy: grabTransform.
- grabbed == aMorph
- ifFalse: [grabbed setProperty: #addedFlexAtGrab toValue: true].
- "offset target to compensate for differences in transforms"
- grabbed position: grabbed position - offset asIntegerPoint.
- "And compute distance from hand's position"
- targetOffset := grabbed position - self position.
- self addMorphBack: grabbed.
- grabbed justGrabbedFrom: formerOwner.!
Item was removed:
- ----- Method: HandMorph>>gridPointRaw (in category 'gridded cursor') -----
- gridPointRaw
- "return my latest position gridded"
- ^self griddedPoint: self currentEvent position!
Item was removed:
- ----- Method: HandMorph>>gridTo:origin: (in category 'gridded cursor') -----
- gridTo: grid origin: offset
- "set a couple of properties to specify gridding for the temporaryCursor; instvars would be nicer"
- self setProperty: #gridStep toValue: grid;
- setProperty: #gridOffset toValue: offset!
Item was removed:
- ----- Method: HandMorph>>griddedPoint: (in category 'gridded cursor') -----
- griddedPoint: aPoint
- "return the equivalent point snapped to the grid, if indeed any gridding is set"
- self valueOfProperty: #gridStep ifPresentDo: [:step | | offset |
- offset := self valueOfProperty: #gridOffset ifAbsent: [0 at 0].
- ^ ((aPoint + targetOffset - offset) grid: step) - targetOffset + offset].
- ^aPoint!
Item was removed:
- ----- Method: HandMorph>>griddingOn (in category 'gridded cursor') -----
- griddingOn
-
- ^ self hasSubmorphs
- and: [(self hasProperty: #gridStep)
- and: [self firstSubmorph disableLayout not]]!
Item was removed:
- ----- Method: HandMorph>>halo (in category 'halos and balloon help') -----
- halo
- "Return the halo associated with this hand, if any"
- ^self valueOfProperty: #halo!
Item was removed:
- ----- Method: HandMorph>>halo: (in category 'halo handling') -----
- halo: newHalo
- "Set halo associated with this hand"
-
- | oldHalo |
- (oldHalo := self halo) == newHalo ifTrue: [ ^self ].
- oldHalo ifNotNil: [ oldHalo delete ].
- newHalo
- ifNil:[self removeProperty: #halo]
- ifNotNil:[self setProperty: #halo toValue: newHalo]!
Item was removed:
- ----- Method: HandMorph>>handleEvent: (in category 'events-processing') -----
- handleEvent: unfilteredEvent
-
- | filteredEvent |
- owner ifNil: [^ unfilteredEvent "not necessary but good style -- see Morph >> #handleEvent:"].
-
- self logEvent: unfilteredEvent.
-
- "Mouse-over events occur really, really, really often. They are kind of the heart beat of the Morphic UI process."
- unfilteredEvent isMouseOver ifTrue: [^ self sendMouseEvent: unfilteredEvent].
-
- self showEvent: unfilteredEvent.
- self sendListenEvents: unfilteredEvent.
-
- filteredEvent := self sendFilterEventCapture: unfilteredEvent for: nil.
- "filteredEvent := unfilteredEvent" " <-- use this to disable global capture filters"
-
- filteredEvent wasIgnored ifTrue: [
- self mouseOverHandler processMouseOver: lastMouseEvent.
- ^ filteredEvent].
-
- filteredEvent isWindowEvent ifTrue: [
- self sendEvent: filteredEvent focus: nil.
- self mouseOverHandler processMouseOver: lastMouseEvent.
- ^ filteredEvent].
-
- filteredEvent isKeyboard ifTrue: [
- filteredEvent isKeyDown ifTrue: [lastKeyDownEvent := filteredEvent].
- self sendKeyboardEvent: filteredEvent.
- self mouseOverHandler processMouseOver: lastMouseEvent.
- ^ filteredEvent].
-
- filteredEvent isDropEvent ifTrue:[
- self sendEvent: filteredEvent focus: nil.
- self mouseOverHandler processMouseOver: lastMouseEvent.
- ^ filteredEvent].
-
- filteredEvent isMouse ifFalse: [
- self mouseOverHandler processMouseOver: lastMouseEvent.
- ^ filteredEvent].
-
- " ********** MOUSE EVENT *********** "
-
- lastMouseEvent := filteredEvent.
-
- "Check for pending drag or double click operations."
- mouseClickState ifNotNil:[
- (mouseClickState handleEvent: filteredEvent from: self) ifFalse:[
- "Possibly dispatched #click: or something and will not re-establish otherwise"
- self mouseOverHandler processMouseOver: lastMouseEvent.
- ^ filteredEvent]].
-
- filteredEvent isMouseWheel ifTrue: [
- self class sendMouseWheelToKeyboardFocus
- ifFalse: [self sendMouseEvent: filteredEvent]
- ifTrue: [self sendEvent: filteredEvent focus: self keyboardFocus clear: [self keyboardFocus: nil]].
- self mouseOverHandler processMouseOver: lastMouseEvent.
- ^ filteredEvent].
-
- filteredEvent isMove ifTrue:[
- self position: filteredEvent position.
- self sendMouseEvent: filteredEvent.
- self mouseOverHandler processMouseOver: lastMouseEvent.
- ^ filteredEvent].
-
- "Issue a synthetic move event if we're not at the position of the event"
- self flag: #bug. "mt: Incompatible with how #mouseMove: is handled when #wantsEveryMouseMove: answers false. Handler might think that #mouseDown: was already received. For example, TextEditor and HaloMorph will issue drags in their #mouseMove: based on old data. That is, the first #mouseMove: appears to come before #mouseDown: while actually sent due to #moveToEvent:."
- filteredEvent position = self position
- ifFalse: [self moveToEvent: filteredEvent].
-
- "Drop submorphs on button events"
- self hasSubmorphs
- ifTrue:[self dropMorphs: filteredEvent]
- ifFalse:[self sendMouseEvent: filteredEvent].
-
- self mouseOverHandler processMouseOver: lastMouseEvent.
- ^ filteredEvent "not necessary but good style -- see Morph >> #handleEvent:" !
Item was removed:
- ----- Method: HandMorph>>hasChanged (in category 'drawing') -----
- hasChanged
- "Return true if this hand has changed, either because it has moved or because some morph it is holding has changed."
-
- ^ hasChanged ifNil: [ true ]
- !
Item was removed:
- ----- Method: HandMorph>>hasUserInformation (in category 'drawing') -----
- hasUserInformation
- ^self userInitials notEmpty or: [self userPicture notNil]!
Item was removed:
- ----- Method: HandMorph>>ignoreEvent: (in category 'events-filtering') -----
- ignoreEvent: anEvent
- "Double dispatch from MorphicEvent >> #ignore: to let custom hands tweak this behavior such as logging it."
-
- anEvent wasIgnored: true.!
Item was removed:
- ----- Method: HandMorph>>initForEvents (in category 'initialization') -----
- initForEvents
- mouseOverHandler := nil.
- lastMouseEvent := MouseEvent new setType: #mouseMove position: 0 at 0 buttons: 0 hand: self.
- lastKeyDownEvent := KeyboardEvent new setType: #keyDown buttons: 0 position: 0 at 0 keyValue: 0 hand: self stamp: 0.
- lastEventBuffer := {1. 0. 0. 0. 0. 0. nil. nil}.
- self resetClickState.
- self addKeyboardCaptureFilter: self. "to convert unusual VM events"!
Item was removed:
- ----- Method: HandMorph>>initialize (in category 'initialization') -----
- initialize
- super initialize.
- self initForEvents.
- keyboardFocus := nil.
- mouseFocus := nil.
- bounds := 0 at 0 extent: Cursor normal extent.
- userInitials := ''.
- damageRecorder := DamageRecorder new.
- cachedCanvasHasHoles := false.
- temporaryCursor := temporaryCursorOffset := nil.
- self initForEvents.!
Item was removed:
- ----- Method: HandMorph>>interrupted (in category 'initialization') -----
- interrupted
- "Something went wrong - we're about to bring up a debugger.
- Release some stuff that could be problematic."
- self releaseAllFoci. "or else debugger might not handle clicks"
- !
Item was removed:
- ----- Method: HandMorph>>invalidRect:from: (in category 'change reporting') -----
- invalidRect: damageRect from: aMorph
- "Note that a change has occurred and record the given damage rectangle relative to the origin this hand's cache."
- hasChanged := true.
- aMorph == self ifTrue:[^self].
- damageRecorder recordInvalidRect: damageRect.
- !
Item was removed:
- ----- Method: HandMorph>>isCapturingGesturePoints (in category 'events-processing') -----
- isCapturingGesturePoints
- ^false!
Item was removed:
- ----- Method: HandMorph>>isGenieAvailable (in category 'genie-stubs') -----
- isGenieAvailable
- "Answer whether the Genie gesture recognizer is available for this hand"
- ^false!
Item was removed:
- ----- Method: HandMorph>>isGenieEnabled (in category 'genie-stubs') -----
- isGenieEnabled
- "Answer whether the Genie gesture recognizer is enabled for this hand"
- ^false!
Item was removed:
- ----- Method: HandMorph>>isGenieFocused (in category 'genie-stubs') -----
- isGenieFocused
- "Answer whether the Genie gesture recognizer is auto-focused for this hand"
- ^false!
Item was removed:
- ----- Method: HandMorph>>isHandMorph (in category 'classification') -----
- isHandMorph
-
- ^ true!
Item was removed:
- ----- Method: HandMorph>>keyboardBubbleFilters (in category 'events-filtering-bubbling') -----
- keyboardBubbleFilters
- Error signal: 'Hand morphs do only have capture filters. Install top-most bubble filters in the world.'!
Item was removed:
- ----- Method: HandMorph>>keyboardCaptureFilters (in category 'events-filtering-capturing') -----
- keyboardCaptureFilters
- ^ keyboardCaptureFilters!
Item was removed:
- ----- Method: HandMorph>>keyboardCaptureFilters: (in category 'events-filtering-capturing') -----
- keyboardCaptureFilters: anArrayOrNil
- keyboardCaptureFilters := anArrayOrNil!
Item was removed:
- ----- Method: HandMorph>>keyboardFocus (in category 'focus handling') -----
- keyboardFocus
- ^ keyboardFocus!
Item was removed:
- ----- Method: HandMorph>>keyboardFocus: (in category 'focus handling') -----
- keyboardFocus: aMorphOrNil
- keyboardFocus := aMorphOrNil!
Item was removed:
- ----- Method: HandMorph>>keyboardInterpreter (in category 'multilingual') -----
- keyboardInterpreter
-
- ^keyboardInterpreter ifNil: [keyboardInterpreter := Locale currentPlatform inputInterpreter]!
Item was removed:
- ----- Method: HandMorph>>keyboardListeners (in category 'events-listening') -----
- keyboardListeners
- ^keyboardListeners!
Item was removed:
- ----- Method: HandMorph>>keyboardListeners: (in category 'events-listening') -----
- keyboardListeners: anArrayOrNil
- keyboardListeners := anArrayOrNil!
Item was removed:
- ----- Method: HandMorph>>lastEvent (in category 'accessing') -----
- lastEvent
- ^ lastMouseEvent!
Item was removed:
- ----- Method: HandMorph>>logEvent: (in category 'events-debugging') -----
- logEvent: anEvent
- "Update statistics for processed events."
-
- EventStats ifNil: [EventStats := IdentityDictionary new].
- EventStats at: #count put: (EventStats at: #count ifAbsent: [0]) + 1.
- EventStats at: anEvent type put: (EventStats at: anEvent type ifAbsent: [0]) + 1.!
Item was removed:
- ----- Method: HandMorph>>mouseBubbleFilters (in category 'events-filtering-bubbling') -----
- mouseBubbleFilters
- Error signal: 'Hand morphs do only have capture filters. Install top-most bubble filters in the world.'!
Item was removed:
- ----- Method: HandMorph>>mouseCaptureFilters (in category 'events-filtering-capturing') -----
- mouseCaptureFilters
- ^ mouseCaptureFilters!
Item was removed:
- ----- Method: HandMorph>>mouseCaptureFilters: (in category 'events-filtering-capturing') -----
- mouseCaptureFilters: anArrayOrNil
- mouseCaptureFilters := anArrayOrNil!
Item was removed:
- ----- Method: HandMorph>>mouseDragTrailFrom: (in category 'private events') -----
- mouseDragTrailFrom: currentBuf
- "Current event, a dragMove event buffer, is about to be processed. If there are other similar dragMove events queued up, then drop them from the queue, and report the positions inbetween. Adapted version of #mouseTrailFrom:."
-
- | nextEvent trail |
- trail := WriteStream on: (Array new: 1).
- trail nextPut: currentBuf fourth @ currentBuf fifth.
- [(nextEvent := Sensor peekEvent) isNil] whileFalse: [
- nextEvent first = currentBuf first
- ifFalse: [^ trail contents "different event type"].
- nextEvent third = currentBuf third
- ifFalse: [^ trail contents "dragType changed"].
- nextEvent sixth = currentBuf sixth
- ifFalse: [^ trail contents "modifiers changed"].
- nextEvent seventh = currentBuf seventh
- ifFalse: [^ trail contents "numFiles changed"].
- "nextEvent is similar. Remove it from the queue, and check the next."
- nextEvent := Sensor nextEvent.
- trail nextPut: nextEvent fourth @ nextEvent fifth].
- ^ trail contents!
Item was removed:
- ----- Method: HandMorph>>mouseFocus (in category 'focus handling') -----
- mouseFocus
- ^mouseFocus!
Item was removed:
- ----- Method: HandMorph>>mouseFocus: (in category 'focus handling') -----
- mouseFocus: aMorphOrNil
- mouseFocus := aMorphOrNil!
Item was removed:
- ----- Method: HandMorph>>mouseListeners (in category 'events-listening') -----
- mouseListeners
- ^mouseListeners!
Item was removed:
- ----- Method: HandMorph>>mouseListeners: (in category 'events-listening') -----
- mouseListeners: anArrayOrNil
- mouseListeners := anArrayOrNil!
Item was removed:
- ----- Method: HandMorph>>mouseOverHandler (in category 'accessing') -----
- mouseOverHandler
- ^mouseOverHandler ifNil:[mouseOverHandler := MouseOverHandler new].!
Item was removed:
- ----- Method: HandMorph>>mouseTrailFrom: (in category 'private events') -----
- mouseTrailFrom: currentBuf
- "Current event, a mouse event buffer, is about to be processed. If there are other similar mouse events queued up, then drop them from the queue, and report the positions inbetween."
-
- | nextEvent trail |
- trail := WriteStream on: (Array new: 1).
- trail nextPut: currentBuf third @ currentBuf fourth.
- [(nextEvent := Sensor peekEvent) isNil] whileFalse:
- [nextEvent first = currentBuf first
- ifFalse: [^trail contents "different event type"].
- nextEvent fifth = currentBuf fifth
- ifFalse: [^trail contents "buttons changed"].
- nextEvent sixth = currentBuf sixth
- ifFalse: [^trail contents "modifiers changed"].
- "nextEvent is similar. Remove it from the queue, and check the next."
- nextEvent := Sensor nextEvent.
- trail nextPut: nextEvent third @ nextEvent fourth].
- ^trail contents!
Item was removed:
- ----- Method: HandMorph>>moveToEvent: (in category 'private events') -----
- moveToEvent: anEvent
- "Issue a mouse move event to make the receiver appear at the given position"
- self handleEvent: (MouseMoveEvent new
- setType: #mouseMove
- startPoint: self position
- endPoint: anEvent position
- trail: (Array with: self position with: anEvent position)
- buttons: anEvent buttons
- hand: self
- stamp: anEvent timeStamp)!
Item was removed:
- ----- Method: HandMorph>>needsToBeDrawn (in category 'drawing') -----
- needsToBeDrawn
- "Return true if this hand must be drawn explicitely instead of being drawn via the hardware cursor. This is the case if it (a) it is a remote hand, (b) it is showing a temporary cursor, or (c) it is not empty and there are any visible submorphs. If using the software cursor, ensure that the hardware cursor is hidden."
- "Details: Return true if this hand has a saved patch to ensure that is is processed by the world. This saved patch will be deleted after one final display pass when it becomes possible to start using the hardware cursor again. This trick gives us one last display cycle to allow us to remove the software cursor and shadow from the display."
- (savedPatch notNil
- or: [ (submorphs anySatisfy: [ :ea | ea visible ])
- or: [ (temporaryCursor notNil and: [hardwareCursor isNil])
- or: [ self hasUserInformation ]]])
- ifTrue: [
- "using the software cursor; hide the hardware one"
- self showHardwareCursor: false.
- ^ true].
- ^ false
- !
Item was removed:
- ----- Method: HandMorph>>newKeyboardFocus: (in category 'focus handling') -----
- newKeyboardFocus: aMorphOrNil
- "Make the given morph the new keyboard focus, canceling the previous keyboard focus if any. If the argument is nil, the current keyboard focus is cancelled."
-
- | oldFocus newFocus |
- oldFocus := self keyboardFocus.
- newFocus := aMorphOrNil ifNotNil: [:m | m keyboardFocusDelegate].
-
- self keyboardFocus: newFocus.
-
- oldFocus == newFocus ifFalse: [
- oldFocus ifNotNil: [:m | m keyboardFocusChange: false].
- newFocus ifNotNil: [:m | m keyboardFocusChange: true]].
-
- self flag: #ImmPlugin.
- "newFocus ifNotNil: [:m |
- self compositionWindowManager keyboardFocusForAMorph: m]."
-
- ^ newFocus
- !
Item was removed:
- ----- Method: HandMorph>>newMouseFocus: (in category 'focus handling') -----
- newMouseFocus: aMorphOrNil
- "Make the given morph the new mouse focus, canceling the previous mouse focus if any. If the argument is nil, the current mouse focus is cancelled."
- self mouseFocus: aMorphOrNil.
- !
Item was removed:
- ----- Method: HandMorph>>newMouseFocus:event: (in category 'focus handling') -----
- newMouseFocus: aMorph event: event
- aMorph isNil
- ifFalse: [targetOffset := event cursorPoint - aMorph position].
- ^self newMouseFocus: aMorph!
Item was removed:
- ----- Method: HandMorph>>noButtonPressed (in category 'accessing') -----
- noButtonPressed
- "Answer whether any mouse button is not being pressed."
-
- ^self anyButtonPressed not!
Item was removed:
- ----- Method: HandMorph>>nonCachingFullDrawOn: (in category 'drawing') -----
- nonCachingFullDrawOn: aCanvas
-
- "A HandMorph has unusual drawing requirements:
- 1. the hand itself (i.e., the cursor) appears in front of its submorphs
- 2. morphs being held by the hand cast a shadow on the world/morphs below
- The illusion is that the hand plucks up morphs and carries them above the world."
- "Note: This version does not cache an image of the morphs being held by the hand.
- Thus, it is slower for complex morphs, but consumes less space."
-
- submorphs isEmpty ifTrue: [^ self drawOn: aCanvas]. "just draw the hand itself"
- aCanvas asShadowDrawingCanvas
- translateBy: self shadowOffset during:[:shadowCanvas| | shadowForm |
- "Note: We use a shadow form here to prevent drawing
- overlapping morphs multiple times using the transparent
- shadow color."
- shadowForm := self shadowForm.
- "
- shadowForm displayAt: shadowForm offset negated. Display forceToScreen: (0 at 0 extent: shadowForm extent).
- "
- shadowCanvas paintImage: shadowForm at: shadowForm offset. "draw shadows"
- ].
- "draw morphs in front of shadows"
- self drawSubmorphsOn: aCanvas.
- self drawOn: aCanvas. "draw the hand itself in front of morphs"
- !
Item was removed:
- ----- Method: HandMorph>>noticeMouseOver:event: (in category 'event handling') -----
- noticeMouseOver: aMorph event: anEvent
- mouseOverHandler ifNil:[^self].
- mouseOverHandler noticeMouseOver: aMorph event: anEvent.!
Item was removed:
- ----- Method: HandMorph>>objectForDataStream: (in category 'objects from disk') -----
- objectForDataStream: refStrm
- | dp |
- "I am about to be written on an object file. Write a path to me in the other system instead."
-
- (refStrm project world hands includes: self) ifTrue: [
- ^ self]. "owned by the project"
- dp := DiskProxy global: #World selector: #primaryHand args: #().
- refStrm replace: self with: dp.
- ^ dp
- "Note, when this file is loaded in an MVC project, this will return nil. The MenuItemMorph that has this in a field will have that item not work. Maybe warn the user at load time?"!
Item was removed:
- ----- Method: HandMorph>>objectToPaste (in category 'paste buffer') -----
- objectToPaste
- "It may need to be sent #startRunning by the client"
- ^ Cursor wait showWhile: [PasteBuffer veryDeepCopy]
-
- "PasteBuffer usableDuplicateIn: self world"
- !
Item was removed:
- ----- Method: HandMorph>>obtainHalo: (in category 'halo handling') -----
- obtainHalo: aHalo
- "Used for transfering halos between hands"
- | formerOwner |
- self halo == aHalo ifTrue:[^self].
- "Find former owner"
- formerOwner := self world hands detect:[:h| h halo == aHalo] ifNone:[nil].
- formerOwner ifNotNil:[formerOwner releaseHalo: aHalo].
- self halo: aHalo!
Item was removed:
- ----- Method: HandMorph>>pasteBuffer (in category 'paste buffer') -----
- pasteBuffer
- "Return the paste buffer associated with this hand"
- ^ PasteBuffer!
Item was removed:
- ----- Method: HandMorph>>pasteBuffer: (in category 'paste buffer') -----
- pasteBuffer: aMorphOrNil
- "Set the contents of the paste buffer."
- PasteBuffer := aMorphOrNil.
-
- !
Item was removed:
- ----- Method: HandMorph>>pasteMorph (in category 'paste buffer') -----
- pasteMorph
-
- | aPastee |
- PasteBuffer ifNil: [^ self inform: 'Nothing to paste.' translated].
- self attachMorph: (aPastee := self objectToPaste).
- aPastee align: aPastee center with: self position.
- aPastee player ifNotNil: [aPastee player startRunning]
- !
Item was removed:
- ----- Method: HandMorph>>position (in category 'geometry') -----
- position
-
- ^temporaryCursor
- ifNil: [bounds topLeft]
- ifNotNil: [bounds topLeft - temporaryCursorOffset]!
Item was removed:
- ----- Method: HandMorph>>position: (in category 'geometry') -----
- position: ungriddedPosition
- "Overridden to align submorph origins to the grid if gridding is on."
- | adjustedPosition delta box |
- adjustedPosition := ungriddedPosition.
- self griddingOn
- ifTrue: [adjustedPosition := self griddedPoint: ungriddedPosition].
- 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 isZero 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>>processEvents (in category 'event handling') -----
- processEvents
- "Process user input events from the local input devices."
-
- | evtBuf hadAny |
- self currentEvent ~= lastMouseEvent ifTrue: [
- "Meaning that we were invoked from within an event response.
- Make sure z-order is up to date."
- self mouseOverHandler processMouseOver: lastMouseEvent].
-
- hadAny := false.
- [(evtBuf := Sensor nextEvent) isNil] whileFalse: [
- | evt |
- evt := evtBuf first "type"
- caseOf: {
- [EventTypeMouse] -> [self generateMouseEvent: evtBuf].
- [EventTypeMouseWheel] -> [self generateMouseWheelEvent: evtBuf].
- [EventTypeKeyboard] -> [self generateKeyboardEvent: evtBuf].
- [EventTypeDragDropFiles] -> [self generateDropFilesEvent: evtBuf].
- [EventTypeWindow] -> [self generateWindowEvent: evtBuf] }
- otherwise: [nil "All other events are ignored"].
-
- evt ifNotNil: [
- "Finally, handle it"
- self handleEvent: evt.
- hadAny := true.
-
- "For better user feedback, return immediately after a mouse event has been processed."
- evt isMouse ifTrue: [^ self] ] ].
-
- "note: if we come here we didn't have any mouse events"
- mouseClickState ifNotNil: [
- "No mouse events during this cycle. Make sure click states time out accordingly"
- mouseClickState handleEvent: lastMouseEvent asMouseMove from: self].
- hadAny ifFalse: [
- "No pending events. Make sure z-order is up to date"
- self mouseOverHandler processMouseOver: lastMouseEvent].!
Item was removed:
- ----- Method: HandMorph>>releaseAllFoci (in category 'focus handling') -----
- releaseAllFoci
- mouseFocus := nil.
- keyboardFocus := nil.
- !
Item was removed:
- ----- Method: HandMorph>>releaseCachedState (in category 'caching') -----
- releaseCachedState
- | oo ui |
- ui := userInitials.
- super releaseCachedState.
- cacheCanvas := nil.
- oo := owner.
- self removeAllMorphs.
- self initialize. "nuke everything"
- self privateOwner: oo.
- self releaseAllFoci.
- self userInitials: ui andPicture: (self userPicture).!
Item was removed:
- ----- Method: HandMorph>>releaseHalo: (in category 'halo handling') -----
- releaseHalo: aHalo
- "Used for transfering halos between hands"
- self removeProperty: #halo!
Item was removed:
- ----- Method: HandMorph>>releaseKeyboardFocus (in category 'focus handling') -----
- releaseKeyboardFocus
- "Release the current keyboard focus unconditionally"
- self newKeyboardFocus: nil.
- !
Item was removed:
- ----- Method: HandMorph>>releaseKeyboardFocus: (in category 'focus handling') -----
- releaseKeyboardFocus: aMorph
- "If the given morph had the keyboard focus before, release it"
- self keyboardFocus == aMorph keyboardFocusDelegate
- ifTrue:[self releaseKeyboardFocus].!
Item was removed:
- ----- Method: HandMorph>>releaseMouseFocus (in category 'focus handling') -----
- releaseMouseFocus
- "Release the current mouse focus unconditionally."
- self newMouseFocus: nil.!
Item was removed:
- ----- Method: HandMorph>>releaseMouseFocus: (in category 'focus handling') -----
- releaseMouseFocus: aMorph
- "If the given morph had the mouse focus before, release it"
- self mouseFocus == aMorph ifTrue:[self releaseMouseFocus].!
Item was removed:
- ----- Method: HandMorph>>removeEventListener: (in category 'events-listening') -----
- removeEventListener: anObject
- "Remove anObject from the current event listeners."
- self eventListeners: (self removeListener: anObject from: self eventListeners).!
Item was removed:
- ----- Method: HandMorph>>removeHalo (in category 'halo handling') -----
- removeHalo
- "remove the receiver's halo (if any)"
-
- self halo ifNotNil: [ :halo |
- halo delete.
- self removeProperty: #halo ]!
Item was removed:
- ----- Method: HandMorph>>removeHaloFromClick:on: (in category 'halo handling') -----
- removeHaloFromClick: anEvent on: aMorph
- | halo |
- halo := self halo
- ifNil: [^ self].
- (halo target hasOwner: self)
- ifTrue: [^ self].
- (halo staysUpWhenMouseIsDownIn: aMorph)
- ifFalse: [self removeHalo]!
Item was removed:
- ----- Method: HandMorph>>removeKeyboardListener: (in category 'events-listening') -----
- removeKeyboardListener: anObject
- "Remove anObject from the current keyboard listeners."
- self keyboardListeners: (self removeListener: anObject from: self keyboardListeners).!
Item was removed:
- ----- Method: HandMorph>>removeListener:from: (in category 'events-listening') -----
- removeListener: anObject from: aListenerGroup
- "Remove anObject from the given listener group. Return the new group."
-
- | listeners |
- aListenerGroup ifNil: [^nil].
- listeners := aListenerGroup.
- listeners := listeners copyWithout: anObject.
- listeners := listeners copyWithout: nil. "obsolete entries"
- listeners isEmpty ifTrue: [listeners := nil].
- ^listeners!
Item was removed:
- ----- Method: HandMorph>>removeMouseListener: (in category 'events-listening') -----
- removeMouseListener: anObject
- "Remove anObject from the current mouse listeners."
- self mouseListeners: (self removeListener: anObject from: self mouseListeners).!
Item was removed:
- ----- Method: HandMorph>>removePendingBalloonFor: (in category 'balloon help') -----
- removePendingBalloonFor: aMorph
- "Get rid of pending balloon help or remove the balloon help if already shown."
-
- self flag: #workaround. "mt: We do not track for which morph there is a pending balloon. To avoid cancelling the wrong requests, check whether the given morph wants a balloon or not. Seems to work fine."
- aMorph wantsBalloon ifFalse: [^ self].
-
- self removeAlarm: #spawnBalloonFor:.
- self deleteBalloonTarget: aMorph.!
Item was removed:
- ----- Method: HandMorph>>removePendingHaloFor: (in category 'halo handling') -----
- removePendingHaloFor: aMorph
- "Get rid of pending balloon help or halo actions."
- self removeAlarm: #spawnMagicHaloFor:.!
Item was removed:
- ----- Method: HandMorph>>resetBalloonHelp: (in category 'balloon help') -----
- resetBalloonHelp: aBalloonMorph
- "Associate a new balloon morph with this hand. Remove all other ones."
-
- self
- deleteBalloonTarget: nil;
- addBalloonHelp: aBalloonMorph.!
Item was removed:
- ----- Method: HandMorph>>resetClickState (in category 'double click support') -----
- resetClickState
- "Reset the double-click detection state to normal (i.e., not waiting for a double-click)."
- mouseClickState := nil.!
Item was removed:
- ----- Method: HandMorph>>resourceJustLoaded (in category 'initialization') -----
- resourceJustLoaded
- "In case resource relates to me"
- cacheCanvas := nil.!
Item was removed:
- ----- Method: HandMorph>>restoreSavedPatchOn: (in category 'drawing') -----
- restoreSavedPatchOn: aCanvas
- "Clear the changed flag and restore the part of the given canvas under this hand from the previously saved patch. If necessary, handle the transition to using the hardware cursor."
-
- hasChanged := false.
- savedPatch ifNotNil:
- [aCanvas drawImage: savedPatch at: savedPatch offset.
- self hasUserInformation ifTrue: [^self]. "cannot use hw cursor if so"
- submorphs notEmpty ifTrue: [^self].
- (temporaryCursor notNil and: [hardwareCursor isNil]) ifTrue: [^self].
-
- "Make the transition to using hardware cursor. Clear savedPatch and
- report one final damage rectangle to erase the image of the software cursor."
- super invalidRect: (savedPatch offset
- extent: savedPatch extent + self shadowOffset)
- from: self.
- self showHardwareCursor: true.
- savedPatch := nil]!
Item was removed:
- ----- Method: HandMorph>>savePatchFrom: (in category 'drawing') -----
- savePatchFrom: aCanvas
- "Save the part of the given canvas under this hand as a Form and return its bounding rectangle."
-
- "Details: The previously used patch Form is recycled when possible to reduce the burden on storage management."
-
- | damageRect myBnds |
- damageRect := myBnds := self fullBounds.
- savedPatch ifNotNil:
- [damageRect := myBnds merge: (savedPatch offset extent: savedPatch extent)].
- (savedPatch isNil or: [savedPatch extent ~= myBnds extent])
- ifTrue:
- ["allocate new patch form if needed"
-
- savedPatch := aCanvas form allocateForm: myBnds extent].
- aCanvas contentsOfArea: (myBnds translateBy: aCanvas origin)
- into: savedPatch.
- savedPatch offset: myBnds topLeft.
- ^damageRect!
Item was removed:
- ----- Method: HandMorph>>selectedObject (in category 'selected object') -----
- selectedObject
- "answer the selected object for the hand or nil is none"
-
- ^self halo ifNotNil: [ :halo | halo target renderedMorph ]!
Item was removed:
- ----- Method: HandMorph>>sendEvent:focus: (in category 'private events') -----
- sendEvent: anEvent focus: focusHolder
- "Send the event to the morph currently holding the focus, or if none to the owner of the hand."
- ^self sendEvent: anEvent focus: focusHolder clear:[nil]!
Item was removed:
- ----- Method: HandMorph>>sendEvent:focus:clear: (in category 'private events') -----
- sendEvent: anEvent focus: focusHolder clear: aBlock
- "Send the event to the morph currently holding the focus, or if none to the owner of the hand."
-
- | result w |
- focusHolder ifNotNil:[^self sendFocusEvent: anEvent to: focusHolder clear: aBlock].
- w := self world.
- w becomeActiveDuring: [
- self becomeActiveDuring: [
- anEvent becomeActiveDuring: [
- result := w processEvent: anEvent]]].
- ^ result == #rejected ifTrue: [anEvent] ifFalse: [result "filtered event"]!
Item was removed:
- ----- Method: HandMorph>>sendFilterEventCaptureAgain:for: (in category 'events-processing') -----
- sendFilterEventCaptureAgain: anEvent for: anObjectOrNil
- "Apply keyboard-specific and mouse-specific capturing filters. If a filter changes the event type, filter again. WARNING: This is a powerful mechanism. Filters can create endless loops, which are difficult to debug.
-
- Overwritten to provide keyboard and mouse focus holders to event filters. Note that hence the event target in such global filters can be nil."
-
- | filteredEvent |
- filteredEvent := anEvent.
-
- filteredEvent isKeyboard ifTrue: [
- filteredEvent := self sendFilterEvent: filteredEvent for: self keyboardFocus to: self keyboardCaptureFilters.
- filteredEvent isKeyboard not ifTrue: [^ self sendFilterEventCaptureAgain: filteredEvent for: anObjectOrNil]].
-
- filteredEvent isMouse ifTrue: [
- filteredEvent := self sendFilterEvent: filteredEvent for: self mouseFocus to: self mouseCaptureFilters.
- filteredEvent isMouse not ifTrue: [^ self sendFilterEventCaptureAgain: filteredEvent for: anObjectOrNil]].
-
- ^ filteredEvent!
Item was removed:
- ----- Method: HandMorph>>sendFocusEvent:to:clear: (in category 'private events') -----
- sendFocusEvent: anEvent to: focusHolder clear: aBlock
- "Send the event to the morph currently holding the focus"
-
- | result w |
- w := focusHolder world ifNil: [aBlock value. ^ anEvent].
- w becomeActiveDuring: [
- self becomeActiveDuring: [
- anEvent becomeActiveDuring: [
- result := focusHolder processFocusEvent: anEvent]]].
- ^ result == #rejected ifTrue: [anEvent] ifFalse: [result "filtered event"]!
Item was removed:
- ----- Method: HandMorph>>sendKeyboardEvent: (in category 'private events') -----
- sendKeyboardEvent: anEvent
- "Send the event to the morph currently holding the focus, or if none to
- the owner of the hand."
- ^ self
- sendEvent: anEvent
- focus: self keyboardFocus
- clear: [self keyboardFocus: nil]!
Item was removed:
- ----- Method: HandMorph>>sendListenEvent:to: (in category 'private events') -----
- sendListenEvent: anEvent to: listenerGroup
- "Send the event to the given group of listeners"
- listenerGroup ifNil:[^self].
- listenerGroup do:[:listener|
- listener ifNotNil:[listener handleListenEvent: anEvent copy]].!
Item was removed:
- ----- Method: HandMorph>>sendListenEvents: (in category 'private events') -----
- sendListenEvents: anEvent
- "Send the given event to all registered event listeners."
-
- self sendListenEvent: anEvent to: self eventListeners.
-
- anEvent isKeyboard
- ifTrue: [self sendListenEvent: anEvent to: self keyboardListeners].
-
- anEvent isMouse
- ifTrue: [self sendListenEvent: anEvent to: self mouseListeners].!
Item was removed:
- ----- Method: HandMorph>>sendMouseEvent: (in category 'private events') -----
- sendMouseEvent: anEvent
- "Send the event to the morph currently holding the focus, or if none to the owner of the hand."
- ^self sendEvent: anEvent focus: self mouseFocus clear:[self mouseFocus: nil]!
Item was removed:
- ----- Method: HandMorph>>shadowForm (in category 'drawing') -----
- shadowForm
- "Return a 1-bit shadow of my submorphs. Assumes submorphs is not empty"
- | bnds canvas |
- bnds := Rectangle merging: (submorphs collect: [:m | m fullBounds]).
- canvas := (Display defaultCanvasClass extent: bnds extent depth: 1)
- asShadowDrawingCanvas: Color black.
- canvas translateBy: bnds topLeft negated
- during:[:tempCanvas| self drawSubmorphsOn: tempCanvas].
- ^ canvas form offset: bnds topLeft!
Item was removed:
- ----- Method: HandMorph>>shadowOffset (in category 'drop shadows') -----
- shadowOffset
-
- ^ 6 at 8!
Item was removed:
- ----- Method: HandMorph>>showEvent: (in category 'events-debugging') -----
- showEvent: anEvent
- "Show details about the event on the display form. Useful for debugging."
- "ShowEvents := true"
- "ShowEvents := false"
- | message borderWidth heightOffset |
- ShowEvents == true ifFalse: [^ self].
-
- borderWidth := 5.
- message := String streamContents: [:strm |
- strm
- nextPutAll: '[HandMorph >> #showEvent:]'; cr;
- nextPutAll: 'event'; tab; tab; tab; tab; nextPutAll: anEvent printString; cr;
- nextPutAll: 'keyboard focus'; tab; tab; nextPutAll: self keyboardFocus printString; cr;
- nextPutAll: 'mouse focus'; tab; tab; nextPutAll: self mouseFocus printString].
-
- message := message asDisplayText
- foregroundColor: Color black
- backgroundColor: Color white.
- heightOffset := (owner submorphs detect: [:m| m isDockingBar] ifNone: [])
- ifNil: [0]
- ifNotNil: [:m| m height].
- "Offset to support multiple hands debugging."
- Display fill: (0 @ heightOffset extent: message form extent + (borderWidth asPoint * 2)) rule: Form over fillColor: Color white.
- message displayOn: Display at: (borderWidth @ heightOffset) + (0 @ ((owner hands indexOf: self) - 1 * message form height)).!
Item was removed:
- ----- Method: HandMorph>>showHardwareCursor: (in category 'drawing') -----
- showHardwareCursor: aBool
- "Show/hide the current hardware cursor as indicated."
- | cursor |
- cursor := hardwareCursor ifNil:[aBool ifTrue:[Cursor normal] ifFalse:[Cursor blank]].
- Cursor currentCursor == cursor ifFalse: [cursor show].
- !
Item was removed:
- ----- Method: HandMorph>>showTemporaryCursor: (in category 'cursor') -----
- showTemporaryCursor: cursorOrNil
- "Set the temporary cursor to the given Form. If the argument is nil, revert to the normal cursor."
-
- self showTemporaryCursor: cursorOrNil hotSpotOffset: 0 at 0
- !
Item was removed:
- ----- Method: HandMorph>>showTemporaryCursor:hotSpotOffset: (in category 'cursor') -----
- showTemporaryCursor: cursorOrNil hotSpotOffset: hotSpotOffset
- "Set the temporary cursor to the given Form.
- If the argument is nil, revert to the normal hardware cursor."
-
- self changed.
- temporaryCursorOffset
- ifNotNil: [bounds := bounds translateBy: temporaryCursorOffset negated].
- cursorOrNil isNil
- ifTrue: [temporaryCursor := temporaryCursorOffset := hardwareCursor := nil]
- ifFalse:
- [temporaryCursor := cursorOrNil asCursorForm scaleIconToDisplay.
- temporaryCursorOffset := temporaryCursor offset - hotSpotOffset.
- (cursorOrNil isKindOf: Cursor) ifTrue: [hardwareCursor := cursorOrNil]].
- bounds := self cursorBounds.
- self
- userInitials: userInitials andPicture: self userPicture;
- layoutChanged;
- changed;
- showHardwareCursor: (temporaryCursor isNil).!
Item was removed:
- ----- Method: HandMorph>>spawnBalloonFor: (in category 'balloon help') -----
- spawnBalloonFor: aMorph
-
- aMorph wantsBalloon ifFalse: [^ self].
- aMorph showBalloon: aMorph balloonText hand: self.!
Item was removed:
- ----- Method: HandMorph>>spawnMagicHaloFor: (in category 'halo handling') -----
- spawnMagicHaloFor: aMorph
-
- self halo ifNotNil: [ :halo |
- halo target == aMorph ifTrue:[ ^self ] ].
- aMorph addMagicHaloFor: self.!
Item was removed:
- ----- Method: HandMorph>>targetOffset (in category 'accessing') -----
- targetOffset
- "Return the offset of the last mouseDown location relative to the origin of the recipient morph. During menu interactions, this is the absolute location of the mouse down event that invoked the menu."
-
- ^ targetOffset
- !
Item was removed:
- ----- Method: HandMorph>>targetOffset: (in category 'grabbing/dropping') -----
- targetOffset: offsetPoint
- "Set the offset at which we clicked down in the target morph"
-
- targetOffset := offsetPoint!
Item was removed:
- ----- Method: HandMorph>>targetPoint (in category 'accessing') -----
- targetPoint
- "Return the new position of the target.
- I.E. return the position of the hand less
- the original distance between hand and target position"
-
- ^ self position - targetOffset
- !
Item was removed:
- ----- Method: HandMorph>>temporaryCursor (in category 'cursor') -----
- temporaryCursor
- ^ temporaryCursor!
Item was removed:
- ----- Method: HandMorph>>triggerBalloonFor:after: (in category 'balloon help') -----
- triggerBalloonFor: aMorph after: timeOut
- "Trigger balloon help after the given time out for some morph"
- self addAlarm: #spawnBalloonFor: with: aMorph after: timeOut.!
Item was removed:
- ----- Method: HandMorph>>triggerHaloFor:after: (in category 'halo handling') -----
- triggerHaloFor: aMorph after: timeOut
- "Trigger automatic halo after the given time out for some morph"
- self addAlarm: #spawnMagicHaloFor: with: aMorph after: timeOut!
Item was removed:
- ----- Method: HandMorph>>turnOffGridding (in category 'gridded cursor') -----
- turnOffGridding
- "remove the gridding properties to stop gridding"
- self removeProperty: #gridStep; removeProperty: #gridOffset!
Item was removed:
- ----- Method: HandMorph>>turnOnGridding (in category 'gridded cursor') -----
- turnOnGridding
-
- self
- gridTo: self world gridModulus
- origin: self world gridOrigin.!
Item was removed:
- ----- Method: HandMorph>>updateCacheCanvas: (in category 'drawing') -----
- updateCacheCanvas: aCanvas
- "Update the cached image of the morphs being held by this hand."
-
- "Note: The following is an attempt to quickly get out if there's no change"
-
- | subBnds rectList nPix |
- subBnds := Rectangle merging: (submorphs collect: [:m | m fullBounds]).
- rectList := damageRecorder invalidRectsFullBounds: subBnds.
- damageRecorder reset.
- (rectList isEmpty
- and: [cacheCanvas notNil and: [cacheCanvas extent = subBnds extent]])
- ifTrue: [^self].
-
- "Always check for real translucency -- can't be cached in a form"
- self submorphsDo:
- [:m |
- m wantsToBeCachedByHand
- ifFalse:
- [cacheCanvas := nil.
- cachedCanvasHasHoles := true.
- ^self]].
- (cacheCanvas isNil or: [cacheCanvas extent ~= subBnds extent])
- ifTrue:
- [cacheCanvas := (aCanvas allocateForm: subBnds extent) getCanvas.
- cacheCanvas translateBy: subBnds origin negated
- during: [:tempCanvas | self drawSubmorphsOn: tempCanvas].
- self submorphsDo:
- [:m |
- (m areasRemainingToFill: subBnds) isEmpty
- ifTrue: [^cachedCanvasHasHoles := false]].
- nPix := cacheCanvas form tallyPixelValues first.
- "--> begin rounded corners hack <---"
- cachedCanvasHasHoles := (nPix = 48
- and: [submorphs size = 1 and: [submorphs first wantsRoundedCorners]])
- ifTrue: [false]
- ifFalse: [nPix > 0].
- "--> end rounded corners hack <---"
- ^self].
-
- "incrementally update the cache canvas"
- cacheCanvas translateBy: subBnds origin negated
- during:
- [:cc |
- rectList do:
- [:r |
- cc clipBy: r
- during:
- [:c |
- c fillColor: Color transparent.
- self drawSubmorphsOn: c]]]!
Item was removed:
- ----- Method: HandMorph>>userInitials (in category 'accessing') -----
- userInitials
-
- ^ userInitials!
Item was removed:
- ----- Method: HandMorph>>userInitials:andPicture: (in category 'geometry') -----
- userInitials: aString andPicture: aForm
-
- | cb pictRect initRect f |
-
- userInitials := aString.
- pictRect := initRect := cb := self cursorBounds.
- userInitials isEmpty ifFalse: [
- f := TextStyle defaultFont.
- initRect := cb topRight + (0 at 4) extent: (f widthOfString: userInitials)@(f height).
- ].
- self userPicture: aForm.
- aForm ifNotNil: [
- pictRect := (self cursorBounds topRight + (0 at 24)) extent: aForm extent.
- ].
- self bounds: ((cb merge: initRect) merge: pictRect).
-
-
- !
Item was removed:
- ----- Method: HandMorph>>userPicture (in category 'accessing') -----
- userPicture
- ^self valueOfProperty: #remoteUserPicture
-
- !
Item was removed:
- ----- Method: HandMorph>>userPicture: (in category 'accessing') -----
- userPicture: aFormOrNil
- ^self setProperty: #remoteUserPicture toValue: aFormOrNil
- !
Item was removed:
- ----- Method: HandMorph>>veryDeepCopyWith: (in category 'copying') -----
- veryDeepCopyWith: deepCopier
- "Return self. Do not copy hands this way."
- ^ self!
Item was removed:
- ----- Method: HandMorph>>visible: (in category 'drawing') -----
- visible: aBoolean
- self needsToBeDrawn ifFalse: [ ^self ].
- super visible: aBoolean!
Item was removed:
- ----- Method: HandMorph>>waitForClicksOrDrag:event: (in category 'double click support') -----
- waitForClicksOrDrag: aMorph event: evt
- "Wait for mouse button and movement events, informing aMorph about events interesting to it via callbacks.
- This message is typically sent to the Hand by aMorph when it first receives a mouse-down event.
- The callback methods invoked on aMorph (which are passed a copy of evt) are:
- #click: sent when the mouse button goes up within doubleClickTime.
- #doubleClick: sent when the mouse goes up, down, and up again all within DoubleClickTime.
- #doubleClickTimeout: sent when the mouse does not have a doubleClick within DoubleClickTime.
- #startDrag: sent when the mouse moves more than 10 pixels from evt's position within DoubleClickTime.
- Note that mouseMove: and mouseUp: events are not sent to aMorph until it becomes the mouse focus,
- which is typically done by aMorph in its click:, doubleClick:, or drag: methods."
-
- ^self waitForClicksOrDrag: aMorph event: evt selectors: #( #click: #doubleClick: #doubleClickTimeout: #startDrag:) threshold: HandMorph dragThreshold!
Item was removed:
- ----- Method: HandMorph>>waitForClicksOrDrag:event:selectors:threshold: (in category 'double click support') -----
- waitForClicksOrDrag: aMorph event: evt selectors: clickAndDragSelectors threshold: threshold
-
- "Wait for mouse button and movement events, informing aMorph about events interesting to it via callbacks.
- This message is typically sent to the Hand by aMorph when it first receives a mouse-down event.
- The callback methods, named in clickAndDragSelectors and passed a copy of evt, are:
- 1 (click) sent when the mouse button goes up within doubleClickTime.
- 2 (doubleClick) sent when the mouse goes up, down, and up again all within DoubleClickTime.
- 3 (doubleClickTimeout) sent when the mouse does not have a doubleClick within DoubleClickTime.
- 4 (startDrag) sent when the mouse moves more than threshold pixels from evt's position within DoubleClickTime.
- Note that mouseMove: and mouseUp: events are not sent to aMorph until it becomes the mouse focus,
- which is typically done by aMorph in its click:, doubleClick:, or drag: methods."
-
- mouseClickState :=
- MouseClickState new
- client: aMorph
- click: clickAndDragSelectors first
- dblClick: clickAndDragSelectors second
- dblClickTime: DoubleClickTime
- dblClickTimeout: clickAndDragSelectors third
- drag: clickAndDragSelectors fourth
- threshold: threshold
- event: evt.
- !
Item was removed:
- EllipseMorph subclass: #HandleMorph
- instanceVariableNames: 'pointBlock lastPointBlock'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !HandleMorph commentStamp: '<historical>' prior: 0!
- A HandleMorph provides mouse-up control behavior.!
Item was removed:
- ----- Method: HandleMorph>>forEachPointDo: (in category 'initialize') -----
- forEachPointDo: aBlock
- pointBlock := aBlock!
Item was removed:
- ----- Method: HandleMorph>>forEachPointDo:lastPointDo: (in category 'initialize') -----
- forEachPointDo: aBlock lastPointDo: otherBlock
- pointBlock := aBlock.
- lastPointBlock := otherBlock!
Item was removed:
- ----- Method: HandleMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
- self extent: 16 @ 16.
- self disableLayout: true.
- self morphicLayerNumber: self class frontmostLayer.!
Item was removed:
- ----- Method: HandleMorph>>justDroppedInto:event: (in category 'dropping/grabbing') -----
- justDroppedInto: aMorph event: anEvent
- "So that when the hand drops me (into the world) I go away"
- self removeHalo.
- lastPointBlock ifNotNil: [lastPointBlock value: self center].
- self flag: #arNote. "Probably unnecessary"
- anEvent hand releaseKeyboardFocus: self.
- self changed.
- self delete.
- !
Item was removed:
- ----- Method: HandleMorph>>keyStroke: (in category 'event handling') -----
- keyStroke: evt
- "Check for cursor keys"
- | keyValue |
- owner isHandMorph ifFalse:[^self].
- keyValue := evt keyValue.
- keyValue = 28 ifTrue:[^self position: self position - (1 at 0)].
- keyValue = 29 ifTrue:[^self position: self position + (1 at 0)].
- keyValue = 30 ifTrue:[^self position: self position - (0 at 1)].
- keyValue = 31 ifTrue:[^self position: self position + (0 at 1)].
- "Special case for return"
- keyValue = 13 ifTrue:[
- "Drop the receiver and be done"
- self flag: #arNote. "Probably unnecessary"
- owner releaseKeyboardFocus: self.
- self delete].
- !
Item was removed:
- ----- Method: HandleMorph>>startStepping (in category 'stepping and presenter') -----
- startStepping
- "Make the receiver the keyboard focus for editing"
- super startStepping.
- "owner isHandMorph ifTrue:[owner newKeyboardFocus: self]."
- self flag: #arNote. "make me #handleKeyboard:"!
Item was removed:
- ----- Method: HandleMorph>>step (in category 'stepping and presenter') -----
- step
- pointBlock value: self center!
Item was removed:
- ----- Method: HandleMorph>>stepTime (in category 'stepping and presenter') -----
- stepTime
- "Update every hundredth of a second."
- ^ 10
- !
Item was removed:
- SimpleButtonMorph subclass: #IconicButton
- instanceVariableNames: 'darkenedForm'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !IconicButton commentStamp: '<historical>' prior: 0!
- A "Simple Button" in which the appearance is provided by a Form.!
Item was removed:
- ----- Method: IconicButton>>addLabelItemsTo:hand: (in category 'menu') -----
- addLabelItemsTo: aCustomMenu hand: aHandMorph
- "don't do the inherited behavior, since there is no textual label in this case"!
Item was removed:
- ----- Method: IconicButton>>borderNormal (in category 'initialization') -----
- borderNormal
- self borderStyle: (BorderStyle width: 2 color: Color transparent).!
Item was removed:
- ----- Method: IconicButton>>borderThick (in category 'initialization') -----
- borderThick
- self borderStyle: (BorderStyle width: 2 color: self raisedColor twiceDarker).!
Item was removed:
- ----- Method: IconicButton>>buttonSetup (in category 'initialization') -----
- buttonSetup
- self actWhen: #buttonUp.
- self cornerStyle: #rounded.
- self borderNormal.
- self on: #mouseEnter send: #borderRaised to: self.
- self on: #mouseLeave send: #borderNormal to: self.
- self on: #mouseLeaveDragging send: #borderNormal to: self.
- self on: #mouseDown send: #borderInset to: self.
- self on: #mouseUp send: #borderRaised to: self.!
Item was removed:
- ----- Method: IconicButton>>darken (in category 'ui') -----
- darken
-
- self firstSubmorph form: self darkenedForm!
Item was removed:
- ----- Method: IconicButton>>darkenedForm (in category 'ui') -----
- darkenedForm
- ^ darkenedForm ifNil: [ darkenedForm := self firstSubmorph baseGraphic darker ]!
Item was removed:
- ----- Method: IconicButton>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- ^ 2!
Item was removed:
- ----- Method: IconicButton>>dim (in category 'compatibility') -----
- dim
- "backwards compability for old system windows"
- !
Item was removed:
- ----- Method: IconicButton>>doButtonAction (in category 'button') -----
- doButtonAction
-
- super doButtonAction.
- self restoreImage.!
Item was removed:
- ----- Method: IconicButton>>initialize (in category 'initialization') -----
- initialize
- super initialize.
- self useSquareCorners!
Item was removed:
- ----- Method: IconicButton>>initializeWithThumbnail:withLabel:andColor:andSend:to: (in category 'initialization') -----
- initializeWithThumbnail: aThumbnail withLabel: aLabel andColor: aColor andSend: aSelector to: aReceiver
- "Initialize the receiver to show aThumbnail on its face, giving it the label supplied and arranging for it, when the button goes down on it, to obtain a new morph by sending the supplied selector to the supplied receiver"
-
- | labeledItem nonTranslucent |
- nonTranslucent := aColor asNontranslucentColor.
- labeledItem := AlignmentMorph newColumn.
- labeledItem color: nonTranslucent.
- labeledItem borderWidth: 0.
- labeledItem
- layoutInset: 4 at 0;
- cellPositioning: #center.
- labeledItem addMorph: aThumbnail.
- labeledItem addMorphBack: (Morph new extent: (4 at 4)) beTransparent.
- labeledItem addMorphBack: (TextMorph new
- backgroundColor: nonTranslucent;
- contentsAsIs: aLabel;
- beAllFont: Preferences standardEToysFont;
- centered).
-
- self
- beTransparent;
- labelGraphic: ((labeledItem imageForm: 32 backgroundColor: nonTranslucent forRectangle: labeledItem fullBounds) replaceColor: nonTranslucent withColor: Color transparent);
- borderWidth: 0;
- target: aReceiver;
- actionSelector: #launchPartVia:label:;
- arguments: {aSelector. aLabel};
- actWhen: #buttonDown.
-
- self stationarySetup.!
Item was removed:
- ----- Method: IconicButton>>initializeWithThumbnail:withLabel:andSend:to: (in category 'initialization') -----
- initializeWithThumbnail: aThumbnail withLabel: aLabel andSend: aSelector to: aReceiver
- "Initialize the receiver to show aThumbnail on its face, giving it the label supplied and arranging for it, when the button goes down on it, to obtain a new morph by sending the supplied selector to the supplied receiver"
-
- ^self initializeWithThumbnail: aThumbnail withLabel: aLabel andColor: Color transparent andSend: aSelector to: aReceiver !
Item was removed:
- ----- Method: IconicButton>>labelFromString: (in category 'label') -----
- labelFromString: aString
- "Make an iconic label from aString"
-
- self labelGraphic: (StringMorph contents: aString) imageForm
- !
Item was removed:
- ----- Method: IconicButton>>labelGraphic: (in category 'label') -----
- labelGraphic: aForm
- | oldLabel graphicalMorph |
- (oldLabel := self findA: SketchMorph)
- ifNotNil: [oldLabel delete].
- graphicalMorph := SketchMorph withForm: aForm.
- self extent: graphicalMorph extent + (self borderWidth + 6).
- graphicalMorph position: self center - (graphicalMorph extent // 2).
- self addMorph: graphicalMorph.
- graphicalMorph
- baseGraphic;
- lock.
- !
Item was removed:
- ----- Method: IconicButton>>mouseEnter: (in category 'events') -----
- mouseEnter: evt
-
- self borderStyle: BorderStyle thinGray!
Item was removed:
- ----- Method: IconicButton>>mouseLeave: (in category 'events') -----
- mouseLeave: evt
-
- self borderNormal!
Item was removed:
- ----- Method: IconicButton>>restoreImage (in category 'ui') -----
- restoreImage
-
- self firstSubmorph restoreBaseGraphic.!
Item was removed:
- ----- Method: IconicButton>>setDefaultLabel (in category 'initialization') -----
- setDefaultLabel
- self labelGraphic: (ScriptingSystem formAtKey: 'squeakyMouse')!
Item was removed:
- ----- Method: IconicButton>>shedSelvedge (in category 'ui') -----
- shedSelvedge
- self extent: (self extent - (6 at 6))!
Item was removed:
- ----- Method: IconicButton>>stationarySetup (in category 'initialization') -----
- stationarySetup
- "Set up event handlers for mouse actions. Should be spelled stationery..."
-
- self actWhen: #startDrag.
- self cornerStyle: #rounded.
- self borderNormal.
- self on: #mouseEnter send: #borderThick to: self.
- self on: #mouseDown send: nil to: nil.
- self on: #mouseLeave send: #borderNormal to: self.
- self on: #mouseLeaveDragging send: #borderNormal to: self.
- self on: #mouseUp send: #borderThick to: self.
-
- self on: #click send: #launchPartFromClick to: self!
Item was removed:
- ----- Method: IconicButton>>undim (in category 'compatibility') -----
- undim
- "backwards compability for old system windows"
- !
Item was removed:
- Morph subclass: #ImageMorph
- instanceVariableNames: 'image'
- classVariableNames: 'DefaultForm'
- poolDictionaries: ''
- category: 'Morphic-Basic'!
-
- !ImageMorph commentStamp: 'efc 3/7/2003 17:48' prior: 0!
- ImageMorph is a morph that displays a picture (Form). My extent is determined by the extent of my form.
-
- Use #image: to set my picture.
-
- Structure:
- instance var Type Description
- image Form The Form to use when drawing
-
- Code examples:
- ImageMorph new openInWorld; grabFromScreen
-
- (Form fromFileNamed: 'myGraphicsFileName') asMorph openInWorld
-
- Relationship to SketchMorph: ImageMorph should be favored over SketchMorph, a parallel, legacy class -- see the Swiki FAQ for details ( http://minnow.cc.gatech.edu/squeak/1372 ).
- !
Item was removed:
- ----- Method: ImageMorph class>>authoringPrototype (in category 'scripting') -----
- authoringPrototype
- | aMorph aForm |
- aMorph := super authoringPrototype.
- aForm := ScriptingSystem formAtKey: 'Image'.
- aForm ifNil: [aForm := aMorph image rotateBy: 90].
- aMorph image: aForm.
- ^ aMorph!
Item was removed:
- ----- Method: ImageMorph class>>defaultForm (in category 'accessing') -----
- defaultForm
- ^DefaultForm!
Item was removed:
- ----- Method: ImageMorph class>>descriptionForPartsBin (in category 'parts bin') -----
- descriptionForPartsBin
- ^ self partName: 'Image' translatedNoop
- categories: #('Graphics' 'Basic')
- documentation: 'A non-editable picture. If you use the Paint palette to make a picture, you can edit it afterwards.' translatedNoop!
Item was removed:
- ----- Method: ImageMorph class>>fromString: (in category 'instance creation') -----
- fromString: aString
- "Create a new ImageMorph which displays the input string in the standard button font"
-
- ^ self fromString: aString font: Preferences standardButtonFont!
Item was removed:
- ----- Method: ImageMorph class>>fromString:font: (in category 'instance creation') -----
- fromString: aString font: aFont
- "Create a new ImageMorph showing the given string in the given font"
-
- ^ self new image: (StringMorph contents: aString font: aFont) imageForm!
Item was removed:
- ----- Method: ImageMorph class>>initialize (in category 'class initialization') -----
- initialize
- "ImageMorph initialize"
-
- | h p d |
- DefaultForm := (Form extent: 80 at 40 depth: 16).
- h := DefaultForm height // 2.
- 0 to: h - 1 do: [:i |
- p := (i * 2)@i.
- d := i asFloat / h asFloat.
- DefaultForm fill:
- (p corner: DefaultForm extent - p)
- fillColor: (Color r: d g: 0.5 b: 1.0 - d)].
-
- self registerInFlapsRegistry.!
Item was removed:
- ----- Method: ImageMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
- registerInFlapsRegistry
- "Register the receiver in the system's flaps registry"
- self environment
- at: #Flaps
- ifPresent: [:cl | cl registerQuad: {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}
- forFlapNamed: 'Supplies']!
Item was removed:
- ----- Method: ImageMorph class>>unload (in category 'class initialization') -----
- unload
- "Unload the receiver from global registries"
-
- self environment at: #Flaps ifPresent: [:cl |
- cl unregisterQuadsWithReceiver: self] !
Item was removed:
- ----- Method: ImageMorph>>addCustomMenuItems:hand: (in category 'menus') -----
- addCustomMenuItems: aMenu hand: aHand
- super addCustomMenuItems: aMenu hand: aHand.
- aMenu addUpdating: #opacityString action: #changeOpacity!
Item was removed:
- ----- Method: ImageMorph>>borderStyle: (in category 'accessing') -----
- borderStyle: newStyle
- | newExtent |
- newExtent := 2 * newStyle width + image extent.
- bounds extent = newExtent ifFalse:[super extent: newExtent].
- super borderStyle: newStyle.!
Item was removed:
- ----- Method: ImageMorph>>borderWidth: (in category 'accessing') -----
- borderWidth: bw
- | newExtent |
- newExtent := 2 * bw + image extent.
- bounds extent = newExtent ifFalse:[super extent: newExtent].
- super borderWidth: bw!
Item was removed:
- ----- Method: ImageMorph>>changeOpacity (in category 'menu') -----
- changeOpacity
- self isOpaque: self isOpaque not!
Item was removed:
- ----- Method: ImageMorph>>color: (in category 'accessing') -----
- color: aColor
- super color: aColor.
- (image depth = 1 and: [aColor isColor]) ifTrue: [
- image colors: {Color transparent. aColor}.
- self changed]!
Item was removed:
- ----- Method: ImageMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- self borderStyle ifNotNil:[:style |
- style frameRectangle: bounds on: aCanvas.
- ].
- self isOpaque
- ifTrue:[aCanvas drawImage: image at: self innerBounds origin]
- ifFalse:[aCanvas translucentImage: image at: self innerBounds origin]!
Item was removed:
- ----- Method: ImageMorph>>extent: (in category 'geometry') -----
- extent: aPoint
-
- super extent: self preferredExtent.!
Item was removed:
- ----- Method: ImageMorph>>form (in category 'accessing') -----
- form
- "For compatability with SketchMorph."
-
- ^ image
- !
Item was removed:
- ----- Method: ImageMorph>>grabFromScreen (in category 'menu commands') -----
- grabFromScreen
-
- self image: Form fromUser.
- !
Item was removed:
- ----- Method: ImageMorph>>image (in category 'accessing') -----
- image
-
- ^ image
- !
Item was removed:
- ----- Method: ImageMorph>>image: (in category 'accessing') -----
- image: anImage
- self changed.
- image := anImage depth = 1
- ifTrue: [ColorForm mappingWhiteToTransparentFrom: anImage]
- ifFalse: [anImage].
- super extent: self preferredExtent!
Item was removed:
- ----- Method: ImageMorph>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
- self image: DefaultForm.
- !
Item was removed:
- ----- Method: ImageMorph>>initializeToStandAlone (in category 'parts bin') -----
- initializeToStandAlone
-
- super initializeToStandAlone.
- self image: DefaultForm.
- !
Item was removed:
- ----- Method: ImageMorph>>isImageMorph (in category 'testing') -----
- isImageMorph
- ^true!
Item was removed:
- ----- Method: ImageMorph>>isOpaque (in category 'accessing') -----
- isOpaque
- "Return true if the receiver is marked as being completely opaque"
- ^ self
- valueOfProperty: #isOpaque
- ifAbsent: [false]!
Item was removed:
- ----- Method: ImageMorph>>isOpaque: (in category 'accessing') -----
- isOpaque: aBool
- "Mark the receiver as being completely opaque or not"
- aBool == false
- ifTrue:[self removeProperty: #isOpaque]
- ifFalse:[self setProperty: #isOpaque toValue: aBool].
- self changed!
Item was removed:
- ----- Method: ImageMorph>>newForm: (in category 'other') -----
- newForm: aForm
- self image: aForm!
Item was removed:
- ----- Method: ImageMorph>>opacityString (in category 'menu') -----
- opacityString
- ^ (self isOpaque
- ifTrue: ['<on>']
- ifFalse: ['<off>']), 'opaque' translated!
Item was removed:
- ----- Method: ImageMorph>>preferredExtent (in category 'accessing') -----
- preferredExtent
- ^ image ifNil: [0 at 0] ifNotNil: [image extent]!
Item was removed:
- ----- Method: ImageMorph>>readFromFile (in category 'menu commands') -----
- readFromFile
- "This would benefit from a way to get a list of the plausible file extensions for image files"
- | fileName |
- fileName := UIManager default
- chooseFileMatchingSuffixes: Form allTypicalFileExtensions
- label: 'Please enter the image file name'.
- fileName isEmpty ifTrue: [^ self].
- self image: (Form fromFileNamed: fileName).
- !
Item was removed:
- ----- Method: ImageMorph>>releaseCachedState (in category 'caching') -----
- releaseCachedState
-
- super releaseCachedState.
- image hibernate.
- !
Item was removed:
- ----- Method: ImageMorph>>setNewImageFrom: (in category 'accessing') -----
- setNewImageFrom: formOrNil
- "Change the receiver's image to be one derived from the supplied form. If nil is supplied, clobber any existing image in the receiver, and in its place put a default graphic, either the one known to the receiver as its default value, else a squeaky mouse"
-
- | defaultImage |
- formOrNil ifNotNil: [^ self image: formOrNil].
- defaultImage := self defaultValueOrNil ifNil: [ScriptingSystem squeakyMouseForm].
- self image: defaultImage
- !
Item was removed:
- ----- Method: ImageMorph>>wantsRecolorHandle (in category 'accessing') -----
- wantsRecolorHandle
- ^ image notNil and: [image depth = 1]!
Item was removed:
- ----- Method: ImageMorph>>withSnapshotBorder (in category 'accessing') -----
- withSnapshotBorder
- self borderStyle: ((ComplexBorder style: #complexFramed)
- color: (Color
- r: 0.613
- g: 1.0
- b: 0.516);
- width: 1;
-
- yourself)!
Item was removed:
- StringMorph subclass: #IndentingListItemMorph
- instanceVariableNames: 'indentLevel isExpanded complexContents firstChild container nextSibling icon backgroundColor'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Explorer'!
-
- !IndentingListItemMorph commentStamp: '<historical>' prior: 0!
- An IndentingListItemMorph is a StringMorph that draws itself with an optional toggle at its left, as part of the display of the SimpleHierarchicalListMorph.
-
- It will also display lines around the toggle if the #showLinesInHierarchyViews Preference is set.
-
- Instance variables:
-
- indentLevel <SmallInteger> the indent level, from 0 at the root and increasing by 1 at each level of the hierarchy.
-
- isExpanded <Boolean> true if this item is expanded (showing its children)
-
- complexContents <ListItemWrapper> an adapter wrapping my represented item that can answer its children, etc.
-
- firstChild <IndentingListItemMorph|nil> my first child, or nil if none
-
- container <SimpleHierarchicalListMorph> my container
-
- nextSibling <IndentingListItemMorph|nil> the next item in the linked list of siblings, or nil if none.
-
- Contributed by Bob Arning as part of the ObjectExplorer package.
- Don't blame him if it's not perfect. We wanted to get it out for people to play with.!
Item was removed:
- ----- Method: IndentingListItemMorph class>>iconColumnIndex (in category 'defaults') -----
- iconColumnIndex
- "Hack. For now, say who gets the icon here. We need a generic solution for icons in multi-column trees. PluggableTreeMorph does something in that direction."
- ^ 2!
Item was removed:
- ----- Method: IndentingListItemMorph>>acceptDroppingMorph:event: (in category 'drag and drop') -----
- acceptDroppingMorph: toDrop event: evt
- complexContents acceptDroppingObject: toDrop complexContents.
- toDrop delete.
- self highlightForDrop: false.!
Item was removed:
- ----- Method: IndentingListItemMorph>>addChildrenForList:addingTo:withExpandedItems: (in category 'container protocol - private') -----
- addChildrenForList: hostList addingTo: morphList withExpandedItems: expandedItems
-
- firstChild ifNotNil: [
- firstChild withSiblingsDo: [ :aNode | aNode delete].
- ].
- firstChild := nil.
- complexContents hasContents ifFalse: [^self].
- firstChild := hostList
- addMorphsTo: morphList
- from: complexContents contents
- allowSorting: true
- withExpandedItems: expandedItems
- atLevel: indentLevel + 1.
- !
Item was removed:
- ----- Method: IndentingListItemMorph>>applyFilter: (in category 'filtering') -----
- applyFilter: filter
-
- self
- applyFilter: filter
- depthOffset: self indentLevel.!
Item was removed:
- ----- Method: IndentingListItemMorph>>applyFilter:depthOffset: (in category 'filtering') -----
- applyFilter: filter depthOffset: offset
-
- | selfMatch childMatch |
- self isExpanded ifTrue: [self toggleExpandedState].
-
- selfMatch := self matches: filter.
- childMatch := self matchesAnyChild: filter depthOffset: offset.
-
- selfMatch | childMatch ifFalse: [^ self hide].
-
- selfMatch ifTrue: [
- self backgroundColor: ((Color gray: 0.85) alpha: 0.5)].
- childMatch ifTrue: [
- self toggleExpandedState.
- self childrenDo: [:child | child applyFilter: filter depthOffset: offset]].!
Item was removed:
- ----- Method: IndentingListItemMorph>>backgroundColor (in category 'accessing') -----
- backgroundColor
- ^ backgroundColor!
Item was removed:
- ----- Method: IndentingListItemMorph>>backgroundColor: (in category 'accessing') -----
- backgroundColor: aColor
- backgroundColor := aColor.
- self changed.!
Item was removed:
- ----- Method: IndentingListItemMorph>>balloonText (in category 'accessing') -----
- balloonText
-
- ^complexContents balloonText ifNil: [super balloonText]!
Item was removed:
- ----- Method: IndentingListItemMorph>>boundsForBalloon (in category 'halos and balloon help') -----
- boundsForBalloon
-
- "some morphs have bounds that are way too big"
- container ifNil: [^super boundsForBalloon].
- ^self boundsInWorld intersect: container boundsInWorld!
Item was removed:
- ----- Method: IndentingListItemMorph>>canExpand (in category 'testing') -----
- canExpand
-
- ^complexContents hasContents!
Item was removed:
- ----- Method: IndentingListItemMorph>>charactersOccluded (in category 'private') -----
- charactersOccluded
- "Answer the number of characters occluded in my #visibleList by my right edge."
- | listIndex leftEdgeOfRightmostColumn eachString indexOfLastVisible iconWidth totalWidth |
- listIndex := 0.
- leftEdgeOfRightmostColumn := container columns
- ifNil: [ 0 ]
- ifNotNil:
- [ : cols | (1 to: cols size - 1)
- inject: 0
- into:
- [ : sum : each | sum + (self widthOfColumn: each) ] ].
- eachString := container columns
- ifNil: [ self complexContents asString ]
- ifNotNil:
- [ : cols | self contentsAtColumn: container columns size ].
- iconWidth := self icon
- ifNil: [ 0 ]
- ifNotNil:
- [ : icon | icon width + 2 ].
- totalWidth := self toggleBounds right.
- indexOfLastVisible := ((1 to: eachString size)
- detect:
- [ : stringIndex | (totalWidth:=totalWidth+(self fontToUse widthOf: (eachString at: stringIndex))) >
- (container width -
- (container vIsScrollbarShowing
- ifTrue: [ container vScrollBar width ]
- ifFalse: [ 0 ]) - iconWidth - leftEdgeOfRightmostColumn) ]
- ifNone: [ eachString size + 1 ]) - 1.
- ^ eachString size - indexOfLastVisible!
Item was removed:
- ----- Method: IndentingListItemMorph>>children (in category 'accessing') -----
- children
- | children |
- children := OrderedCollection new.
- self childrenDo: [:each | children add: each].
- ^children!
Item was removed:
- ----- Method: IndentingListItemMorph>>childrenDo: (in category 'enumeration') -----
- childrenDo: aBlock
-
- firstChild ifNotNil: [
- firstChild withSiblingsDo: aBlock ]!
Item was removed:
- ----- Method: IndentingListItemMorph>>collapse (in category 'container protocol') -----
- collapse
-
- self isExpanded ifFalse: [^ self].
-
- self isExpanded: false.
-
- firstChild ifNotNil: [:collapsingNode |
- | toDelete |
- toDelete := OrderedCollection new.
- collapsingNode withSiblingsDo: [:aNode | aNode recursiveAddTo: toDelete].
- container noteRemovalOfAll: toDelete].
-
- self changed.!
Item was removed:
- ----- Method: IndentingListItemMorph>>colorToUse (in category 'drawing') -----
- colorToUse
-
- ^ (self valueOfProperty: #wasRefreshed ifAbsent: [false])
- ifTrue: [complexContents highlightColor ifNil: [self highlightTextColor]]
- ifFalse: [
- self isSelected ifTrue: [^ self selectionTextColor].
- complexContents preferredColor ifNil: [self color]]!
Item was removed:
- ----- Method: IndentingListItemMorph>>complexContents (in category 'accessing') -----
- complexContents
-
- ^complexContents!
Item was removed:
- ----- Method: IndentingListItemMorph>>contentsAtColumn: (in category 'accessing - columns') -----
- contentsAtColumn: index
- "Split string contents at <tab> character."
-
- | column scanner cell |
- column := 0.
- scanner := ReadStream on: contents asString.
- [(cell := scanner upTo: Character tab) notEmpty]
- whileTrue: [column := column + 1. column = index ifTrue: [^ cell]].
- ^ ''!
Item was removed:
- ----- Method: IndentingListItemMorph>>contentsSplitByColumns (in category 'accessing - columns') -----
- contentsSplitByColumns
- "Split string contents at <tab> character."
-
- | result scanner cell |
- result := OrderedCollection new.
- scanner := ReadStream on: contents asString.
- [(cell := scanner upTo: Character tab) notEmpty]
- whileTrue: [result add: cell].
- ^ result!
Item was removed:
- ----- Method: IndentingListItemMorph>>defaultColor (in category 'initialization') -----
- defaultColor
-
- ^complexContents
- ifNil: [ super defaultColor ]
- ifNotNil: [ complexContents preferredColor ]!
Item was removed:
- ----- Method: IndentingListItemMorph>>drawHoverOn: (in category 'drawing') -----
- drawHoverOn: aCanvas
-
- aCanvas
- fillRectangle: self bounds
- color: self hoverColor.!
Item was removed:
- ----- Method: IndentingListItemMorph>>drawLineToggleToTextOn:lineColor:hasToggle: (in category 'drawing') -----
- drawLineToggleToTextOn: aCanvas lineColor: lineColor hasToggle: hasToggle
- "If I am not the only item in my container, draw the line between:
- - my toggle (if any) or my left edge (if no toggle)
- - and my text left edge"
-
- | myBounds myCenter hLineY hLineLeft |
- self isSoleItem ifTrue: [ ^self ].
- myBounds := self toggleBounds.
- myCenter := myBounds center.
- hLineY := myCenter y.
- hLineLeft := myCenter x - 1.
- "Draw line from toggle to text"
- aCanvas
- line: hLineLeft @ hLineY
- to: myBounds right + 0 @ hLineY
- width: 1
- color: lineColor!
Item was removed:
- ----- Method: IndentingListItemMorph>>drawLinesOn:lineColor:indentThreshold: (in category 'drawing') -----
- drawLinesOn: aCanvas lineColor: lineColor indentThreshold: aNumber
- self indentLevel > aNumber ifTrue: [
- | hasToggle |
- hasToggle := self hasToggle.
- "Draw line from toggle to text"
- self drawLineToggleToTextOn: aCanvas lineColor: lineColor hasToggle: hasToggle.
-
- "Draw the line from my toggle to the nextSibling's toggle"
- self nextVisibleSibling ifNotNil: [ self drawLinesToNextSiblingOn: aCanvas lineColor: lineColor hasToggle: hasToggle ]].
-
- "If I have children and am expanded, draw a line to my first child"
- ((self firstVisibleChild notNil
- and: [self isExpanded])
- and: [self firstVisibleChild indentLevel > aNumber])
- ifTrue: [ self drawLinesToFirstChildOn: aCanvas lineColor: lineColor ]!
Item was removed:
- ----- Method: IndentingListItemMorph>>drawLinesToFirstChildOn:lineColor: (in category 'drawing') -----
- drawLinesToFirstChildOn: aCanvas lineColor: lineColor
- "Draw line from me to next sibling"
-
- | child vLineX vLineTop vLineBottom childBounds childCenter |
- child := self firstVisibleChild.
- childBounds := child toggleBounds.
- childCenter := childBounds center.
- vLineX := childCenter x - 1.
- vLineTop := bounds bottom.
- child hasToggle
- ifTrue: [vLineBottom := childCenter y - 7]
- ifFalse: [vLineBottom := childCenter y].
- aCanvas
- line: vLineX @ vLineTop
- to: vLineX @ vLineBottom
- width: 1
- color: lineColor!
Item was removed:
- ----- Method: IndentingListItemMorph>>drawLinesToNextSiblingOn:lineColor:hasToggle: (in category 'drawing') -----
- drawLinesToNextSiblingOn: aCanvas lineColor: lineColor hasToggle: hasToggle
- | myBounds nextSibBounds vLineX myCenter vLineTop vLineBottom |
- myBounds := self toggleBounds.
- nextSibBounds := self nextVisibleSibling toggleBounds.
- myCenter := myBounds center.
- vLineX := myCenter x - 1.
- vLineTop := myCenter y.
- vLineBottom := nextSibBounds center y.
- "Draw line from me to next sibling"
- aCanvas
- line: vLineX @ vLineTop
- to: vLineX @ vLineBottom
- width: 1
- color: lineColor!
Item was removed:
- ----- Method: IndentingListItemMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- | tRect sRect columnScanner columnLeft |
- self backgroundColor ifNotNil: [:c |
- aCanvas fillRectangle: self innerBounds color: c].
-
- tRect := self toggleRectangle.
- self drawToggleOn: aCanvas in: tRect.
-
- sRect := bounds withLeft: tRect right + self hMargin.
- sRect := sRect top: sRect top + sRect bottom - self fontToUse height // 2.
-
- (container columns isNil or: [(contents asString indexOf: Character tab) = 0]) ifTrue: [
- icon ifNotNil: [
- aCanvas
- translucentImage: icon
- at: sRect left @ (self top + (self height - icon height // 2)).
- sRect := sRect left: sRect left + icon width + 2.
- ].
-
- aCanvas drawString: contents asString in: sRect font: self fontToUse color: self colorToUse.
-
- ] ifFalse: [
- columnLeft := sRect left.
- columnScanner := ReadStream on: contents asString.
- container columns withIndexDo: [ :widthSpec :column | | columnRect columnData columnWidth |
- "Draw icon."
- column = self class iconColumnIndex ifTrue: [
- icon ifNotNil: [
- aCanvas
- translucentImage: icon
- at: columnLeft @ (self top + (self height - icon height // 2)).
- columnLeft := columnLeft + icon width + 2]].
-
- columnWidth := self widthOfColumn: column.
- columnRect := columnLeft @ sRect top extent: columnWidth @ sRect height.
- columnData := columnScanner upTo: Character tab.
-
- "Draw string."
- columnData ifNotEmpty: [
- aCanvas drawString: columnData in: columnRect font: self fontToUse color: self colorToUse].
-
- "Compute next column offset."
- columnLeft := columnRect right + 5.
- column = 1 ifTrue: [columnLeft := columnLeft - tRect right + self left].
-
- ].
- ]!
Item was removed:
- ----- Method: IndentingListItemMorph>>drawSelectionOn: (in category 'drawing') -----
- drawSelectionOn: aCanvas
-
- | fill |
- fill := self selectionColor isColor
- ifTrue: [SolidFillStyle color: self selectionColor]
- ifFalse: [self selectionColor].
- fill isGradientFill ifTrue: [
- fill origin: self topLeft.
- fill direction: 0@ self height].
-
- aCanvas
- fillRectangle: self bounds
- fillStyle: fill.!
Item was removed:
- ----- Method: IndentingListItemMorph>>drawToggleOn:in: (in category 'drawing') -----
- drawToggleOn: aCanvas in: aRectangle
-
- | aForm centeringOffset |
- complexContents hasContents ifFalse: [^self].
- aForm := isExpanded
- ifTrue: [container expandedForm]
- ifFalse: [container notExpandedForm].
- centeringOffset := ((aRectangle height - aForm extent y) / 2.0) rounded.
- ^aCanvas
- paintImage: aForm
- at: (aRectangle topLeft translateBy: 0 @ centeringOffset).
- !
Item was removed:
- ----- Method: IndentingListItemMorph>>expand (in category 'container protocol') -----
- expand
-
- | newChildren c |
-
- (self isExpanded or: [self canExpand not])
- ifTrue: [^ self].
-
- (c := self getChildren) ifEmpty: [
- "Due to the guessing in #canExpand, it may still fail here."
- ^ self].
-
- self isExpanded: true.
-
- newChildren := container
- addSubmorphsAfter: self
- fromCollection: c
- allowSorting: true.
-
- firstChild := newChildren first.!
Item was removed:
- ----- Method: IndentingListItemMorph>>filterColor (in category 'accessing') -----
- filterColor
-
- ^ self valueOfProperty: #filterColor ifAbsent: [Color yellow]!
Item was removed:
- ----- Method: IndentingListItemMorph>>filterColor: (in category 'accessing') -----
- filterColor: aColor
-
- | cc fill |
- cc := aColor.
-
- MenuMorph gradientMenu
- ifFalse: [fill := SolidFillStyle color: cc]
- ifTrue: [
- fill := GradientFillStyle ramp: {
- 0.0 -> cc twiceLighter.
- 1 -> cc twiceDarker }].
-
- self setProperty: #filterColor toValue: fill.!
Item was removed:
- ----- Method: IndentingListItemMorph>>filterTextColor (in category 'accessing') -----
- filterTextColor
-
- ^ self valueOfProperty: #filterTextColor ifAbsent: [Color black]!
Item was removed:
- ----- Method: IndentingListItemMorph>>filterTextColor: (in category 'accessing') -----
- filterTextColor: aColor
-
- self setProperty: #filterTextColor toValue: aColor.!
Item was removed:
- ----- Method: IndentingListItemMorph>>firstChild (in category 'accessing') -----
- firstChild
-
- ^firstChild!
Item was removed:
- ----- Method: IndentingListItemMorph>>firstVisibleChild (in category 'accessing') -----
- firstVisibleChild
-
- ^ self firstChild ifNotNil: [:c |
- c visible ifTrue: [c] ifFalse: [c nextVisibleSibling]]!
Item was removed:
- ----- Method: IndentingListItemMorph>>fitContents (in category 'layout') -----
- fitContents
-
- super fitContents.
- self width: container preferredSubmorphWidth.!
Item was removed:
- ----- Method: IndentingListItemMorph>>getChildren (in category 'model access') -----
- getChildren
-
- ^ self getChildrenFor: complexContents!
Item was removed:
- ----- Method: IndentingListItemMorph>>getChildrenFor: (in category 'model access') -----
- getChildrenFor: model
-
- ^ model contents!
Item was removed:
- ----- Method: IndentingListItemMorph>>getIcon (in category 'model access') -----
- getIcon
-
- ^ complexContents icon!
Item was removed:
- ----- Method: IndentingListItemMorph>>getLabel (in category 'model access') -----
- getLabel
-
- ^ self getLabelFor: complexContents!
Item was removed:
- ----- Method: IndentingListItemMorph>>getLabelFor: (in category 'model access') -----
- getLabelFor: model
- "Note that the given model is usually aListItemWrapper."
-
- ^ model asStringOrText!
Item was removed:
- ----- Method: IndentingListItemMorph>>hMargin (in category 'accessing') -----
- hMargin
-
- ^ 3!
Item was removed:
- ----- Method: IndentingListItemMorph>>hasIcon (in category 'testing') -----
- hasIcon
- "Answer whether the receiver has an icon."
- ^ icon notNil!
Item was removed:
- ----- Method: IndentingListItemMorph>>hasToggle (in category 'private') -----
- hasToggle
- ^ complexContents hasContents!
Item was removed:
- ----- Method: IndentingListItemMorph>>highlight (in category 'drawing') -----
- highlight
-
- self changed.
-
- !
Item was removed:
- ----- Method: IndentingListItemMorph>>highlightTextColor (in category 'accessing') -----
- highlightTextColor
-
- ^ self valueOfProperty: #highlightTextColor ifAbsent: [Color red]!
Item was removed:
- ----- Method: IndentingListItemMorph>>highlightTextColor: (in category 'accessing') -----
- highlightTextColor: aColor
-
- self setProperty: #highlightTextColor toValue: aColor.!
Item was removed:
- ----- Method: IndentingListItemMorph>>hoverColor (in category 'accessing') -----
- hoverColor
-
- ^ self valueOfProperty: #hoverColor ifAbsent: [Color veryLightGray]!
Item was removed:
- ----- Method: IndentingListItemMorph>>hoverColor: (in category 'accessing') -----
- hoverColor: aColor
-
- self setProperty: #hoverColor toValue: aColor.!
Item was removed:
- ----- Method: IndentingListItemMorph>>icon (in category 'accessing') -----
- icon
- "answer the receiver's icon"
- ^ icon!
Item was removed:
- ----- Method: IndentingListItemMorph>>inToggleArea: (in category 'mouse events') -----
- inToggleArea: aPoint
-
- ^self toggleRectangle containsPoint: aPoint!
Item was removed:
- ----- Method: IndentingListItemMorph>>indentLevel (in category 'accessing') -----
- indentLevel
-
- ^indentLevel!
Item was removed:
- ----- Method: IndentingListItemMorph>>initWithColor:andFont: (in category 'initialization') -----
- initWithColor: aColor andFont: aFont
-
- (self hasProperty: #hasColorFromText)
- ifFalse: [self color: aColor].
-
- (self hasProperty: #hasEmphasisFromText)
- ifTrue: [
- (self hasProperty: #hasFontFromText)
- ifFalse: [self font: aFont "Keeps emphasis from text."]]
- ifFalse: [
- (self hasProperty: #hasFontFromText)
- ifTrue: [self emphasis: aFont emphasis "Keeps font from text."]
- ifFalse: [self font: aFont emphasis: aFont emphasis]]
- !
Item was removed:
- ----- Method: IndentingListItemMorph>>initWithContents:prior:forList:indentLevel: (in category 'initialization') -----
- initWithContents: anObject prior: priorMorph forList: hostList indentLevel: newLevel
-
- container := hostList.
-
- complexContents := anObject.
- anObject addDependent: self.
-
- self initWithContents: self getLabel font: Preferences standardListFont emphasis: nil.
- indentLevel := 0.
- isExpanded := false.
- nextSibling := firstChild := nil.
- priorMorph ifNotNil: [
- priorMorph nextSibling: self.
- ].
- indentLevel := newLevel.
- icon := self getIcon ifNotNil: [:form | form scaleIconToDisplay].
- self extent: self minWidth @ self minHeight!
Item was removed:
- ----- Method: IndentingListItemMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
- indentLevel := 0.
- isExpanded := false!
Item was removed:
- ----- Method: IndentingListItemMorph>>initializeFromText: (in category 'initialization') -----
- initializeFromText: aText
- "Overridden to keep track of text-based attributes."
-
- | priorFont priorEmphasis priorColor |
- priorFont := self font.
- priorEmphasis := self emphasis.
- priorColor := self color.
-
- super initializeFromText: aText.
-
- priorFont == self font
- ifFalse: [self setProperty: #hasFontFromText toValue: true].
- priorFont == self emphasis
- ifFalse: [self setProperty: #hasEmphasisFromText toValue: true].
- priorColor == self color
- ifFalse: [self setProperty: #hasColorFromText toValue: true].!
Item was removed:
- ----- Method: IndentingListItemMorph>>isExpanded (in category 'accessing') -----
- isExpanded
-
- ^isExpanded!
Item was removed:
- ----- Method: IndentingListItemMorph>>isExpanded: (in category 'accessing') -----
- isExpanded: aBoolean
-
- isExpanded := aBoolean!
Item was removed:
- ----- Method: IndentingListItemMorph>>isFirstItem (in category 'testing') -----
- isFirstItem
- ^owner submorphs first == self!
Item was removed:
- ----- Method: IndentingListItemMorph>>isSelected (in category 'testing') -----
- isSelected
-
- ^ container ifNil: [false] ifNotNil: [container selectedMorph == self]!
Item was removed:
- ----- Method: IndentingListItemMorph>>isSoleItem (in category 'testing') -----
- isSoleItem
- ^self isFirstItem and: [ owner submorphs size = 1 ]!
Item was removed:
- ----- Method: IndentingListItemMorph>>matches: (in category 'filtering') -----
- matches: pattern
-
- ^ self matches: pattern in: complexContents!
Item was removed:
- ----- Method: IndentingListItemMorph>>matches:in: (in category 'filtering') -----
- matches: pattern in: model
- ^ ((PluggableTreeMorph filterByLabelsOnly
- ifTrue: [ model itemName ]
- ifFalse: [ self getLabelFor: model ])
- findString: pattern
- startingAt: 1
- caseSensitive: false) > 0!
Item was removed:
- ----- Method: IndentingListItemMorph>>matchesAnyChild:depthOffset: (in category 'filtering') -----
- matchesAnyChild: pattern depthOffset: offset
-
- | maxDepth next current |
- maxDepth := PluggableTreeMorph maximumSearchDepth - self indentLevel + offset.
- maxDepth <= 0 ifTrue: [^ false].
-
- next := (self getChildren collect: [:obj | 1 -> obj]) asOrderedCollection.
- [next notEmpty] whileTrue: [
- current := next removeFirst.
-
- (self matches: pattern in: current value)
- ifTrue: [^ true].
-
- current key < maxDepth ifTrue: [
- next addAll: ((self getChildrenFor: current value) collect: [:obj | (current key + 1) -> obj])].
- ].
-
- ^ false!
Item was removed:
- ----- Method: IndentingListItemMorph>>minHeight (in category 'layout') -----
- minHeight
- | iconHeight |
- iconHeight := self hasIcon
- ifTrue: [self icon height + 2]
- ifFalse: [0].
- ^ self fontToUse lineGridForMorphs max: iconHeight !
Item was removed:
- ----- Method: IndentingListItemMorph>>minWidth (in category 'layout') -----
- minWidth
- | iconWidth |
- iconWidth := self hasIcon
- ifTrue: [self icon width + 2]
- ifFalse: [0].
- ^ (self fontToUse widthOfString: contents)
- + iconWidth !
Item was removed:
- ----- Method: IndentingListItemMorph>>nextSibling (in category 'accessing') -----
- nextSibling
-
- ^nextSibling!
Item was removed:
- ----- Method: IndentingListItemMorph>>nextSibling: (in category 'accessing') -----
- nextSibling: anotherMorph
-
- nextSibling := anotherMorph!
Item was removed:
- ----- Method: IndentingListItemMorph>>nextVisibleSibling (in category 'accessing') -----
- nextVisibleSibling
-
- | m |
- m := self nextSibling.
- [m isNil or: [m visible]] whileFalse: [
- m := m nextSibling].
- ^ m!
Item was removed:
- ----- Method: IndentingListItemMorph>>openPath: (in category 'container protocol - private') -----
- openPath: anArray
- | found |
- anArray isEmpty
- ifTrue: [^ container setSelectedMorph: nil].
- found := nil.
- self
- withSiblingsDo: [:each | found
- ifNil: [(each complexContents asString = anArray first
- or: [anArray first isNil])
- ifTrue: [found := each]]].
- found
- ifNil: ["try again with no case sensitivity"
- self
- withSiblingsDo: [:each | found
- ifNil: [(each complexContents asString sameAs: anArray first)
- ifTrue: [found := each]]]].
- found
- ifNotNil: [found isExpanded
- ifFalse: [found toggleExpandedState.
- container adjustSubmorphPositions].
- found changed.
- anArray size = 1
- ifTrue: [^ container setSelectedMorph: found].
- ^ found firstChild
- ifNil: [container setSelectedMorph: nil]
- ifNotNil: [found firstChild openPath: anArray allButFirst]].
- ^ container setSelectedMorph: nil!
Item was removed:
- ----- Method: IndentingListItemMorph>>preferredColumnCount (in category 'accessing - columns') -----
- preferredColumnCount
-
- ^ self contentsSplitByColumns size!
Item was removed:
- ----- Method: IndentingListItemMorph>>preferredWidthOfColumn: (in category 'accessing - columns') -----
- preferredWidthOfColumn: index
-
- ^ (self fontToUse widthOfString: (self contentsAtColumn: index)) +
- (index = 1 ifTrue: [self toggleRectangle right - self left] ifFalse: [0])!
Item was removed:
- ----- Method: IndentingListItemMorph>>recursiveAddTo: (in category 'container protocol - private') -----
- recursiveAddTo: aCollection
-
- firstChild ifNotNil: [
- firstChild withSiblingsDo: [ :aNode | aNode recursiveAddTo: aCollection].
- ].
- aCollection add: self
- !
Item was removed:
- ----- Method: IndentingListItemMorph>>recursiveDelete (in category 'container protocol - private') -----
- recursiveDelete
-
- firstChild ifNotNil: [
- firstChild withSiblingsDo: [ :aNode | aNode recursiveDelete].
- ].
- self delete
- !
Item was removed:
- ----- Method: IndentingListItemMorph>>refresh (in category 'initialization') -----
- refresh
-
- self contents: self getLabel.
- self refreshIcon.
-
- (self valueOfProperty: #wasRefreshed ifAbsent: [false]) ifFalse: [
- self setProperty: #wasRefreshed toValue: true].!
Item was removed:
- ----- Method: IndentingListItemMorph>>refreshIcon (in category 'initialization') -----
- refreshIcon
-
- icon := self getIcon ifNotNil: [:form | form scaleIconToDisplay].!
Item was removed:
- ----- Method: IndentingListItemMorph>>selectionColor (in category 'accessing') -----
- selectionColor
-
- ^ self valueOfProperty: #selectionColor ifAbsent: [Color blue]!
Item was removed:
- ----- Method: IndentingListItemMorph>>selectionColor: (in category 'accessing') -----
- selectionColor: aColor
-
- | cc fill |
- cc := aColor.
-
- MenuMorph gradientMenu
- ifFalse: [fill := SolidFillStyle color: cc]
- ifTrue: [
- fill := GradientFillStyle ramp: {
- 0.0 -> cc twiceLighter.
- 1 -> cc twiceDarker }].
-
- self setProperty: #selectionColor toValue: fill.!
Item was removed:
- ----- Method: IndentingListItemMorph>>selectionTextColor (in category 'accessing') -----
- selectionTextColor
-
- ^ self valueOfProperty: #selectionTextColor ifAbsent: [Color white]!
Item was removed:
- ----- Method: IndentingListItemMorph>>selectionTextColor: (in category 'accessing') -----
- selectionTextColor: aColor
-
- self setProperty: #selectionTextColor toValue: aColor.!
Item was removed:
- ----- Method: IndentingListItemMorph>>toggleBounds (in category 'private') -----
- toggleBounds
- ^self toggleRectangle!
Item was removed:
- ----- Method: IndentingListItemMorph>>toggleExpandedState (in category 'container protocol') -----
- toggleExpandedState
-
- self isExpanded
- ifTrue: [self collapse]
- ifFalse: [self expand].!
Item was removed:
- ----- Method: IndentingListItemMorph>>toggleRectangle (in category 'private') -----
- toggleRectangle
-
- | h indent |
- h := bounds height.
- indent := (12 * RealEstateAgent scaleFactor) rounded.
- ^(bounds left + self hMargin + (indent * indentLevel)) @ bounds top extent: indent at h!
Item was removed:
- ----- Method: IndentingListItemMorph>>unhighlight (in category 'drawing') -----
- unhighlight
-
- self changed.
-
-
- !
Item was removed:
- ----- Method: IndentingListItemMorph>>update: (in category 'updating') -----
- update: aspect
- "See ListItemWrapper and subclasses for possible change aspects."
-
- aspect = #contents ifTrue: [
- self isExpanded ifTrue: [self toggleExpandedState].
- self canExpand ifTrue: [self toggleExpandedState].
- container adjustSubmorphPositions].
-
- super update: aspect.!
Item was removed:
- ----- Method: IndentingListItemMorph>>userString (in category 'accessing') -----
- userString
- "Add leading tabs to my userString"
- ^ (String new: indentLevel withAll: Character tab), super userString
- !
Item was removed:
- ----- Method: IndentingListItemMorph>>widthOfColumn: (in category 'accessing - columns') -----
- widthOfColumn: columnIndex
-
- ^ (container widthOfColumn: columnIndex) ifNil: [self width]!
Item was removed:
- ----- Method: IndentingListItemMorph>>withSiblingsDo: (in category 'private') -----
- withSiblingsDo: aBlock
-
- | node |
- node := self.
- [node isNil] whileFalse: [
- aBlock value: node.
- node := node nextSibling
- ].!
Item was removed:
- ----- Method: IndentingListItemMorph>>withoutListWrapper (in category 'converting') -----
- withoutListWrapper
-
- ^complexContents withoutListWrapper!
Item was removed:
- SimpleBorder subclass: #InsetBorder
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Borders'!
-
- !InsetBorder commentStamp: 'kfr 10/27/2003 09:32' prior: 0!
- see BorderedMorph!
Item was removed:
- ----- Method: InsetBorder>>bottomRightColor (in category 'accessing') -----
- bottomRightColor
- ^ color mixed: 0.65 with: Color white!
Item was removed:
- ----- Method: InsetBorder>>style (in category 'accessing') -----
- style
- ^#inset!
Item was removed:
- ----- Method: InsetBorder>>topLeftColor (in category 'accessing') -----
- topLeftColor
- ^ color mixed: 0.70 with: Color black!
Item was removed:
- ----- Method: InsetBorder>>trackColorFrom: (in category 'color tracking') -----
- trackColorFrom: aMorph
- baseColor isTransparent ifTrue:[self color: aMorph insetColor].!
Item was removed:
- ----- Method: Integer>>explorerContents (in category '*Morphic-Explorer') -----
- explorerContents
-
- ^ Array streamContents: [:stream |
- #(
- 'hex' 16 2 0 'hexadecimal, base 16'
- 'oct' 8 3 0 'octal, base 8'
- 'bin' 2 4 0 'binary, base 2'
- 'bit' nil 4 8 'Logical bit field\- Two complement\- Infinite sign bits\- Try #bitAt:') groupsDo: [ :key :base :group :padding :balloon | | label |
- label := self abs printStringBase: (base ifNil: [2]).
- base ifNil: [
- label := String streamContents: [:s |
- (label size roundUpTo: padding) to: 1 by: -1 do: [:index |
- s nextPutAll: (self bitAt: index) asString]]].
- label := label
- padded: #left
- to: (label size roundUpTo: group) + padding
- with: ((base isNil and: [self negative]) ifTrue: [$1] ifFalse: [$0]).
- label := String streamContents: [:s |
- (self negative and: [base notNil]) ifTrue: [s nextPutAll: '-'].
- base ifNil: [s nextPutAll: '... '].
- (1 to: label size by: group)
- do: [:index |
- 1 to: group do: [:gIndex |
- s nextPut: (label at: index + gIndex - 1)]]
- separatedBy: [s space]].
- stream nextPut: ((
- ObjectExplorerWrapper
- with: label
- name: key
- model: self)
- balloonText: balloon withCRs;
- yourself) ]]!
Item was removed:
- ----- Method: Integer>>hasContentsInExplorer (in category '*Morphic-Explorer') -----
- hasContentsInExplorer
- ^true!
Item was removed:
- SketchMorph subclass: #JoystickMorph
- instanceVariableNames: 'handleMorph xScale yScale radiusScale lastAngle autoCenter realJoystickIndex lastRealJoystickValue button1 button2'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !JoystickMorph commentStamp: 'kfr 10/27/2003 16:25' prior: 0!
- A widget that simulates a joystick. Mosly used in etoy scripting.!
Item was removed:
- ----- Method: JoystickMorph class>>authoringPrototype (in category 'scripting') -----
- authoringPrototype
- ^ self new markAsPartsDonor!
Item was removed:
- ----- Method: JoystickMorph class>>descriptionForPartsBin (in category 'parts bin') -----
- descriptionForPartsBin
- ^ self partName: 'Joystick' translatedNoop
- categories: {'Basic' translatedNoop}
- documentation: 'A joystick-like control' translatedNoop!
Item was removed:
- ----- Method: JoystickMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
- includeInNewMorphMenu
- ^ true!
Item was removed:
- ----- Method: JoystickMorph class>>initialize (in category 'class initialization') -----
- initialize
-
- self registerInFlapsRegistry.!
Item was removed:
- ----- Method: JoystickMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
- registerInFlapsRegistry
- "Register the receiver in the system's flaps registry"
- self environment
- at: #Flaps
- ifPresent: [:cl | cl registerQuad: {#JoystickMorph. #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}
- forFlapNamed: 'PlugIn Supplies'.
- cl registerQuad: {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}
- forFlapNamed: 'Scripting'.
- cl registerQuad: {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}
- forFlapNamed: 'Supplies']!
Item was removed:
- ----- Method: JoystickMorph class>>unload (in category 'class initialization') -----
- unload
- "Unload the receiver from global registries"
-
- self environment at: #Flaps ifPresent: [:cl |
- cl unregisterQuadsWithReceiver: self] !
Item was removed:
- ----- Method: JoystickMorph>>addCustomMenuItems:hand: (in category 'menu') -----
- addCustomMenuItems: aCustomMenu hand: aHandMorph
- "Add custom items to the menu"
-
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- aCustomMenu addLine.
- aCustomMenu add: 'set X range' translated action: #setXRange.
- aCustomMenu add: 'set Y range' translated action: #setYRange.
- aCustomMenu addLine.
- aCustomMenu addUpdating: #autoCenterString target: self action: #toggleAutoCenter.
- aCustomMenu balloonTextForLastItem: 'When auto-center is on, every time you let go of the Joystick knob, it springs back to the neutral position at the center of the device' translated.
- aCustomMenu addUpdating: #realJoystickString target: self action: #toggleRealJoystick.
- aCustomMenu balloonTextForLastItem: 'Governs whether this joystick should track the motions of a real, physical joystick attached to the computer.' translated.
- aCustomMenu addUpdating: #joystickNumberString enablementSelector: #realJoystickInUse target: self selector: #chooseJoystickNumber argumentList: #().
- aCustomMenu balloonTextForLastItem: 'Choose which physical device is associated with the joystick.' translated!
Item was removed:
- ----- Method: JoystickMorph>>amount (in category 'accessing') -----
- amount
-
- ^ (handleMorph center - self center) r * radiusScale!
Item was removed:
- ----- Method: JoystickMorph>>angle (in category 'accessing') -----
- angle
-
- self center = handleMorph center ifTrue: [^ lastAngle].
- ^ 360.0 - (handleMorph center - self center) theta radiansToDegrees!
Item was removed:
- ----- Method: JoystickMorph>>autoCenterString (in category 'menu') -----
- autoCenterString
- "Answer a string characterizing whether or not I have auto-center on"
-
- ^ (autoCenter == true ifTrue: ['<yes>'] ifFalse: ['<no>']), ('auto-center' translated)!
Item was removed:
- ----- Method: JoystickMorph>>button1 (in category 'accessing') -----
- button1
- ^button1 == true!
Item was removed:
- ----- Method: JoystickMorph>>button2 (in category 'accessing') -----
- button2
- ^button2 == true!
Item was removed:
- ----- Method: JoystickMorph>>chooseJoystickNumber (in category 'menu') -----
- chooseJoystickNumber
- "Allow the user to select a joystick number"
-
- | result aNumber str |
- str := self lastRealJoystickIndex asString.
- result := UIManager default
- request: ('Joystick device number (currently {1})' translated format: {str})
- initialAnswer: str.
- aNumber := [result asNumber] on: Error do: [:err | ^Beeper beep].
- (aNumber > 0 and: [aNumber <= 32])
- ifFalse:
- ["???"
-
- ^Beeper beep].
- realJoystickIndex := aNumber.
- self setProperty: #lastRealJoystickIndex toValue: aNumber.
- self startStepping!
Item was removed:
- ----- Method: JoystickMorph>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: evt
-
- self inPartsBin ifTrue: [^ false].
-
- true ifTrue: [^ true]. "5/7/98 jhm temporary fix to allow use when rotated"
-
- (handleMorph fullContainsPoint: evt cursorPoint)
- ifTrue: [^ true]
- ifFalse: [^ super handlesMouseDown: evt].
- !
Item was removed:
- ----- Method: JoystickMorph>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
- xScale := 0.25.
- yScale := 0.25.
- radiusScale := 1.0.
- lastAngle := 0.0.
- autoCenter := true.
- self form: ((Form extent: 55 at 55 depth: 8) fillColor: (Color r: 0.3 g: 0.2 b: 0.2)).
- handleMorph := EllipseMorph new.
- handleMorph color: Color red; extent: 15 at 15.
- self addMorph: handleMorph.
- self moveHandleToCenter.
- button1 := false.
- button2 := false.
- !
Item was removed:
- ----- Method: JoystickMorph>>initializeToStandAlone (in category 'parts bin') -----
- initializeToStandAlone
- "Circumvent SketchMorph's implementation here"
-
- self initialize!
Item was removed:
- ----- Method: JoystickMorph>>isLikelyRecipientForMouseOverHalos (in category 'halos and balloon help') -----
- isLikelyRecipientForMouseOverHalos
- "The automatic mouseover halos interere with the proper functioning of the joystick's knob"
-
- ^ false!
Item was removed:
- ----- Method: JoystickMorph>>joystickNumberString (in category 'menu') -----
- joystickNumberString
- "Answer a string characterizing the joystick number"
-
- ^ 'set real joystick number (now {1})' translated format: {self lastRealJoystickIndex asString}.
- !
Item was removed:
- ----- Method: JoystickMorph>>lastRealJoystickIndex (in category 'menu') -----
- lastRealJoystickIndex
- "Answer the last remembered real joystick index. Initialize it to 1 if need be"
-
- ^ self valueOfProperty: #lastRealJoystickIndex ifAbsentPut: [1] !
Item was removed:
- ----- Method: JoystickMorph>>leftRight (in category 'accessing') -----
- leftRight
-
- ^ (handleMorph center x - self center x) * xScale
- !
Item was removed:
- ----- Method: JoystickMorph>>mouseMove: (in category 'event handling') -----
- mouseMove: evt
- "Make handle track the cursor within my bounds."
-
- | m r center |
- m := handleMorph.
- center := m center.
- r := m owner innerBounds insetBy:
- ((center - m fullBounds origin) corner: (m fullBounds corner - center)).
- m position: (evt cursorPoint adhereTo: r) - (m extent // 2).
- !
Item was removed:
- ----- Method: JoystickMorph>>mouseUp: (in category 'event handling') -----
- mouseUp: evt
-
- lastAngle := self angle.
- autoCenter ifTrue: [self moveHandleToCenter].
- !
Item was removed:
- ----- Method: JoystickMorph>>moveHandleToCenter (in category 'other') -----
- moveHandleToCenter
-
- handleMorph position: self center - (handleMorph extent // 2).
- !
Item was removed:
- ----- Method: JoystickMorph>>realJoystickInUse (in category 'menu') -----
- realJoystickInUse
- "Answer whether a real joystick is in use"
-
- ^ realJoystickIndex notNil!
Item was removed:
- ----- Method: JoystickMorph>>realJoystickString (in category 'menu') -----
- realJoystickString
- "Answer a string characterizing whether or not I am currenty tracking a real joystick"
-
- ^ (realJoystickIndex ifNil: ['<no>'] ifNotNil: ['<yes>']), ('track real joystick' translated)!
Item was removed:
- ----- Method: JoystickMorph>>setXRange (in category 'menu') -----
- setXRange
-
- | range |
- range := UIManager default
- request:
- 'Type the maximum value for the X axis' translated
- initialAnswer: ((xScale * (self width - handleMorph width) / 2.0) printShowingMaxDecimalPlaces: 2).
- range isEmpty ifFalse: [
- xScale := (2.0 * range asNumber asFloat) / (self width - handleMorph width)].
- !
Item was removed:
- ----- Method: JoystickMorph>>setYRange (in category 'menu') -----
- setYRange
-
- | range |
- range := UIManager default
- request:
- 'Type the maximum value for the Y axis' translated
- initialAnswer: ((yScale * (self width - handleMorph width) / 2.0) printShowingMaxDecimalPlaces: 2).
- range isEmpty ifFalse: [
- yScale := (2.0 * range asNumber asFloat) / (self width - handleMorph width)].
- !
Item was removed:
- ----- Method: JoystickMorph>>step (in category 'stepping and presenter') -----
- step
- "Track the real joystick whose index is realJoystickIndex."
- "Details:
- a. if realJoystickIndex is nil we're not tracking a joystick
- b. [-joyMax..joyMax] is nominal range of joystick in both X and Y
- c. [-threshold..threshold] is considered 0 to compensate for poor joystick centering"
-
- | threshold joyMax joyPt joyBtn m mCenter r scaledPt |
- super step. "Run ticking user-written scripts if any"
- realJoystickIndex ifNil: [^ self].
- threshold := 30.
- joyMax := 350.
- joyPt := Sensor joystickXY: realJoystickIndex.
- joyBtn := Sensor joystickButtons: realJoystickIndex.
-
- button1 := (joyBtn bitAnd: 1) > 0.
- button2 := (joyBtn bitAnd: 2) > 0.
-
- joyPt x abs < threshold ifTrue: [joyPt := 0 at joyPt y].
- joyPt y abs < threshold ifTrue: [joyPt := joyPt x at 0].
- lastRealJoystickValue = joyPt ifTrue: [^ self].
- lastRealJoystickValue := joyPt.
- m := handleMorph.
- mCenter := m center.
- r := m owner innerBounds insetBy:
- ((mCenter - m fullBounds origin) corner: (m fullBounds corner - mCenter)).
- scaledPt := r center + ((r extent * joyPt) / (joyMax * 2)) truncated.
- m position: (scaledPt adhereTo: r) - (m extent // 2).
- !
Item was removed:
- ----- Method: JoystickMorph>>stepTime (in category 'stepping and presenter') -----
- stepTime
- "Provide for as-fast-as-possible stepping in the case of a real joystick"
-
- ^ realJoystickIndex
- ifNotNil:
- [0] "fast as we can to track actual joystick"
- ifNil:
- [super stepTime]!
Item was removed:
- ----- Method: JoystickMorph>>stopTrackingJoystick (in category 'menu') -----
- stopTrackingJoystick
-
- realJoystickIndex := nil.
- self stopStepping.
- !
Item was removed:
- ----- Method: JoystickMorph>>toggleAutoCenter (in category 'menu') -----
- toggleAutoCenter
-
- autoCenter := autoCenter not.
- autoCenter ifTrue: [self moveHandleToCenter].
- !
Item was removed:
- ----- Method: JoystickMorph>>toggleRealJoystick (in category 'menu') -----
- toggleRealJoystick
- "Toggle whether or not one is using a real joystick"
-
- realJoystickIndex
- ifNil:
- [realJoystickIndex := self valueOfProperty: #lastRealJoystickIndex ifAbsentPut: [1].
- self startStepping]
- ifNotNil:
- [self stopTrackingJoystick]!
Item was removed:
- ----- Method: JoystickMorph>>trackRealJoystick (in category 'menu') -----
- trackRealJoystick
-
- | s |
- s := UIManager default
- request: 'Number of joystick to track?'
- initialAnswer: '1'.
- s isEmpty ifTrue: [^ self].
- realJoystickIndex := Number readFromString: s.
- self startStepping.
- !
Item was removed:
- ----- Method: JoystickMorph>>upDown (in category 'accessing') -----
- upDown
-
- ^ (self center y - handleMorph center y) * yScale
- !
Item was removed:
- Object subclass: #KeyboardBuffer
- instanceVariableNames: 'event eventUsed'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Text Support'!
Item was removed:
- ----- Method: KeyboardBuffer>>commandKeyPressed (in category 'testing') -----
- commandKeyPressed
- ^ event commandKeyPressed!
Item was removed:
- ----- Method: KeyboardBuffer>>controlKeyPressed (in category 'testing') -----
- controlKeyPressed
- ^ event controlKeyPressed!
Item was removed:
- ----- Method: KeyboardBuffer>>flushKeyboard (in category 'keyboard control') -----
- flushKeyboard
- eventUsed ifFalse: [^ eventUsed := true].!
Item was removed:
- ----- Method: KeyboardBuffer>>keyboard (in category 'keyboard control') -----
- keyboard
- eventUsed ifFalse: [eventUsed := true. ^ event keyCharacter].
- ^ nil!
Item was removed:
- ----- Method: KeyboardBuffer>>keyboardPeek (in category 'keyboard control') -----
- keyboardPeek
- eventUsed ifFalse: [^ event keyCharacter].
- ^ nil!
Item was removed:
- ----- Method: KeyboardBuffer>>keyboardPressed (in category 'testing') -----
- keyboardPressed
- ^eventUsed not!
Item was removed:
- ----- Method: KeyboardBuffer>>leftShiftDown (in category 'testing') -----
- leftShiftDown
- ^ event shiftPressed!
Item was removed:
- ----- Method: KeyboardBuffer>>startingEvent: (in category 'private') -----
- startingEvent: evt
- event := evt.
- eventUsed := false!
Item was removed:
- UserInputEvent subclass: #KeyboardEvent
- instanceVariableNames: 'keyValue keyCode'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!
Item was removed:
- ----- Method: KeyboardEvent>>= (in category 'comparing') -----
- = aMorphicEvent
- super = aMorphicEvent ifFalse:[^false].
- buttons = aMorphicEvent buttons ifFalse: [^ false].
- keyValue = aMorphicEvent keyValue ifFalse: [^ false].
- keyCode = aMorphicEvent keyCode ifFalse: [^ false].
- ^ true!
Item was removed:
- ----- Method: KeyboardEvent>>asMorph (in category 'morphic/tools - converting') -----
- asMorph
- "Answers a graphical reprsentation for this keyboard event. Does not work for keyUp and keyDown because we do not have platform-specific mapping tables for the key codes."
-
- | box color arrow |
- box := Morph new
- color: Color transparent;
- layoutPolicy: TableLayout new;
- listDirection: #leftToRight;
- hResizing: #shrinkWrap;
- vResizing: #shrinkWrap;
- cellGap: 2;
- yourself.
- color := self userInterfaceTheme get: #textColor for: #PluggableButtonMorph.
-
- self physicalModifiers
- do: [:modifier |
- box addMorphBack: (ToolIcons keyboardButtonLabeled: modifier capitalized dyed: color) asMorph.
- box addMorphBack: (('+' asText addAttribute: (TextColor color: color); asMorph) lock)].
-
- "Visualize arrow keys."
- arrow := self key.
- (arrow isCharacter and: [arrow asciiValue between: 28 and: 31]) ifTrue: [
- box addMorphBack: (ToolIcons keyboardButtonLabeled: (
- ScrollBar
- arrowOfDirection: (#(left right top bottom) at: arrow asciiValue - 27)
- size: Preferences standardButtonFont height
- color: Color black) dyed: color) asMorph.
- ^ box].
-
- box addMorphBack: (ToolIcons
- keyboardButtonLabeled: self physicalKey asString capitalized
- dyed: color) asMorph.
-
- ^ box!
Item was removed:
- ----- Method: KeyboardEvent>>checkCommandKey (in category 'debugging') -----
- checkCommandKey
-
- self flag: #debuggingOnly. "mt: This check documents a trade-off for having platform-specific modifiers and writing cross-platform compatible applications. If you want to support all three modifiers (i.e. CTRL, CMD, OPT), be aware that
- (1) you should first check for CTRL/OPT then CMD, because
- (2) physical CTRL and ALT keys on Linux/Windows are mapped to the pairs CTRL+CMD and CMD+OPT respectively and thus overshadow some key bindings if checked in the wrong order -- and that's why
- (3) you should effectively only use CTRL/CMD, OPT/CMD, or CTRL/OPT in an application on Linux/Windows. And communicate the physical keys being CTRL and ALT.
-
- Note that point (3) documents the best practice for handling keystroke (not keyUp or keyDown) events while maintaining cross-platform compatibility."
-
- ^ self commandKeyPressed
- and: [self controlKeyPressed not
- and: [self optionKeyPressed not]]!
Item was removed:
- ----- Method: KeyboardEvent>>hash (in category 'comparing') -----
- hash
- ^buttons hash + keyValue hash
- !
Item was removed:
- ----- Method: KeyboardEvent>>isKeyDown (in category 'testing') -----
- isKeyDown
- ^self type == #keyDown!
Item was removed:
- ----- Method: KeyboardEvent>>isKeyUp (in category 'testing') -----
- isKeyUp
- ^self type == #keyUp!
Item was removed:
- ----- Method: KeyboardEvent>>isKeyboard (in category 'testing') -----
- isKeyboard
- ^true!
Item was removed:
- ----- Method: KeyboardEvent>>isKeystroke (in category 'testing') -----
- isKeystroke
- ^self type == #keystroke!
Item was removed:
- ----- Method: KeyboardEvent>>isMouseMove (in category 'testing') -----
- isMouseMove
- ^false!
Item was removed:
- ----- Method: KeyboardEvent>>key (in category 'keyboard') -----
- key
- "Answers a representation for the (non-modifier) key, which should be consistent across platforms considering its cause."
-
- ^ EventSensor virtualKeyAt: keyCode!
Item was removed:
- ----- Method: KeyboardEvent>>keyCharacter (in category 'keyboard') -----
- keyCharacter
- "Answer the character corresponding this keystroke. This is defined only for keystroke events."
-
- ^ keyValue asCharacter!
Item was removed:
- ----- Method: KeyboardEvent>>keyCode (in category 'keyboard') -----
- keyCode
- "Answers the virtual-key code (or scan code) for this event."
-
- ^ keyCode!
Item was removed:
- ----- Method: KeyboardEvent>>keyString (in category 'keyboard') -----
- keyString
- "Answer the string value for this keystroke. This is defined only for keystroke events."
-
- ^ String streamContents: [ :s | self printKeyStringOn: s ]!
Item was removed:
- ----- Method: KeyboardEvent>>keyValue (in category 'keyboard') -----
- keyValue
- "Answer the ascii value for this keystroke. This is defined only for keystroke events."
-
- ^ keyValue!
Item was removed:
- ----- Method: KeyboardEvent>>physicalKey (in category 'morphic/tools - accessing') -----
- physicalKey
-
- ^ self key
- ifNil: ['VK-0x', (self keyCode printPaddedWith: $0 to: 2 base: 16)]
- ifNotNil: [:key |
- (#(control command option) includes: key)
- ifTrue: [ "Similar to #physicalModifiers"
- Smalltalk platformName = 'Mac OS'
- ifTrue: [key]
- ifFalse: [
- self controlKeyPressed
- ifTrue: [(self optionKeyPressed and: [self commandKeyPressed])
- ifTrue: [#alt "Linux/X11"]
- ifFalse: [#control]]
- ifFalse: [#alt]]]
- ifFalse: [
- (key isCharacter
- ifTrue: [(Character constantNameFor: key) ifNil: [key]]
- ifFalse: [key]) ]]!
Item was removed:
- ----- Method: KeyboardEvent>>physicalModifiers (in category 'morphic/tools - accessing') -----
- physicalModifiers
- "Help users understand the physical modifier keys that where involved in this event. Note that, due to historical reasons, the SHIFT modifier comes first on macOS but last on other platforms."
-
- | result |
- result := OrderedCollection new.
-
- Smalltalk platformName = 'Mac OS'
- ifTrue: [
- self shiftPressed ifTrue: [result add: #shift].
- self controlKeyPressed ifTrue: [result add: #ctrl].
- self optionKeyPressed ifTrue: [result add: #opt].
- self commandKeyPressed ifTrue: [result add: #cmd]]
- ifFalse: [ "Linux/Windows"
- self controlKeyPressed
- ifTrue: [result add: #ctrl]
- ifFalse: [
- Smalltalk platformName = 'Win32'
- ifTrue: [
- (self commandKeyPressed or: [self optionKeyPressed])
- ifTrue: [result add: #alt]]
- ifFalse: ["Linux/ARM"
- self commandKeyPressed
- ifTrue: [result add: #alt]
- ifFalse: [self optionKeyPressed
- ifTrue: [
- result add: #ctrl.
- result add: #alt]]]].
- self shiftPressed ifTrue: [result add: #shift]].
- ^ result!
Item was removed:
- ----- Method: KeyboardEvent>>printKeyStringOn: (in category 'printing') -----
- printKeyStringOn: aStream
- "Print a readable string representing the receiver on a given stream"
-
- | kc inBrackets firstBracket keyString |
- kc := self keyCharacter.
- inBrackets := false.
- firstBracket := [ inBrackets ifFalse: [ aStream nextPut: $<. inBrackets := true ]].
- self modifiers
- select: [:modifier |
- "Show #shift modifier only for control characters for backwards compatibility in #keyString."
- modifier ~= #shift or: [ keyValue < 32 ]]
- thenDo: [:modifier |
- firstBracket value.
- "Capitalize modifier for backwards compatibility in #keyString."
- aStream nextPutAll: modifier capitalized; nextPutAll: '-' ].
-
- keyString := (Character constantNameFor: kc)
- ifNil: [String with: kc].
-
- keyString := keyString caseOf: {
- "Rename several keys for backwards compatibility in #keyString."
- [ 'space' ] -> [ ' ' ].
- [ 'return' ] -> [ 'cr' ].
- [ 'arrowDown' ] -> [ 'down' ].
- [ 'arrowUp' ] -> [ 'up' ].
- [ 'arrowLeft' ] -> [ 'left' ].
- [ 'arrowRight' ] -> [ 'right' ]
- } otherwise: [ keyString ].
-
- keyString size > 1 ifTrue: [ firstBracket value ].
- aStream nextPutAll: keyString.
-
- inBrackets ifTrue: [aStream nextPut: $> ]!
Item was removed:
- ----- Method: KeyboardEvent>>printOn: (in category 'printing') -----
- printOn: aStream
- "Print the receiver on a stream"
-
- aStream nextPut: $[.
- aStream nextPutAll: self cursorPoint printString; space.
- aStream nextPutAll: type; space.
-
- self isKeystroke ifTrue: [
- aStream nextPutAll: ''''.
- self printKeyStringOn: aStream.
- aStream nextPut: $'; space].
-
- aStream nextPut: $(.
- aStream nextPutAll: keyValue printString.
- aStream nextPut: $); space.
-
- aStream nextPutAll: timeStamp printString.
- aStream nextPut: $]!
Item was removed:
- ----- Method: KeyboardEvent>>sentTo: (in category 'dispatching') -----
- sentTo: anObject
- "Dispatch the receiver into anObject"
- type == #keystroke ifTrue:[^anObject handleKeystroke: self].
- type == #keyDown ifTrue:[^anObject handleKeyDown: self].
- type == #keyUp ifTrue:[^anObject handleKeyUp: self].
- ^super sentTo: anObject.!
Item was removed:
- ----- Method: KeyboardEvent>>setType:buttons:position:keyValue:hand:stamp: (in category 'private') -----
- setType: aSymbol buttons: anInteger position: pos keyValue: aValue hand: aHand stamp: stamp
-
- self
- setType: aSymbol
- buttons: anInteger
- position: pos
- keyValue: aValue
- keyCode: #unknown
- hand: aHand
- stamp: stamp.!
Item was removed:
- ----- Method: KeyboardEvent>>setType:buttons:position:keyValue:keyCode:hand:stamp: (in category 'private') -----
- setType: aSymbol buttons: anInteger position: pos keyValue: aValue keyCode: aCode hand: aHand stamp: stamp
- type := aSymbol.
- buttons := anInteger.
- position := pos.
- keyValue := aValue.
- keyCode := aCode.
- source := aHand.
- wasHandled := false.
- timeStamp := stamp.!
Item was removed:
- ----- Method: KeyboardEvent>>storeOn: (in category 'printing') -----
- storeOn: aStream
-
- aStream nextPutAll: type.
- aStream space.
- self timeStamp storeOn: aStream.
- aStream space.
- buttons storeOn: aStream.
- aStream space.
- keyValue storeOn: aStream.
- aStream space.
- keyCode storeOn: aStream.
- !
Item was removed:
- ----- Method: KeyboardEvent>>type:readFrom: (in category 'initialize') -----
- type: eventType readFrom: aStream
- type := eventType.
- timeStamp := Integer readFrom: aStream.
- aStream skip: 1.
- buttons := Integer readFrom: aStream.
- aStream skip: 1.
- keyValue := Integer readFrom: aStream.
- aStream skip: 1.
- keyCode := Integer readFrom: aStream.!
Item was removed:
- ----- Method: KeyboardEvent>>virtualKey (in category 'morphic/tools - accessing') -----
- virtualKey
-
- ^ self key!
Item was removed:
- ----- Method: KeyboardEvent>>virtualModifiers (in category 'morphic/tools - accessing') -----
- virtualModifiers
-
- ^ self modifiers!
Item was removed:
- Morph subclass: #KeyboardExerciser
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Demo'!
Item was removed:
- ----- Method: KeyboardExerciser class>>descriptionForPartsBin (in category 'parts bin') -----
- descriptionForPartsBin
- "KeyboardExerciser descriptionForPartsBin"
- ^ self partName: 'Exercise Keyboard'
- categories: #('Demo')
- documentation: 'An exerciser for key stroke, key down, and key up'!
Item was removed:
- ----- Method: KeyboardExerciser>>checkButton: (in category 'initialization') -----
- checkButton: checkIndex
-
- 1 to: 3 do: [:index |
- (self submorphs at: index)
- state: #off].
-
- (self submorphs at: checkIndex) state: #on.!
Item was removed:
- ----- Method: KeyboardExerciser>>clear (in category 'initialization') -----
- clear
-
- (self submorphs allButFirst: 3) do: [:m | m delete].!
Item was removed:
- ----- Method: KeyboardExerciser>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- super drawOn: aCanvas.
-
- aCanvas
- drawString: 'Move your mouse cursor to here and start typing. Try modifiers, too.' translated
- at: self topLeft
- font: Preferences standardButtonFont
- color: Color gray.!
Item was removed:
- ----- Method: KeyboardExerciser>>handleEvent:deemphasize: (in category 'actions') -----
- handleEvent: mouseEvent deemphasize: morph
-
- morph color: Color transparent.!
Item was removed:
- ----- Method: KeyboardExerciser>>handleEvent:emphasize: (in category 'actions') -----
- handleEvent: mouseEvent emphasize: morph
-
- morph color: (self userInterfaceTheme get: #selectionColor for: #PluggableListMorph).!
Item was removed:
- ----- Method: KeyboardExerciser>>handleEvent:inspect: (in category 'actions') -----
- handleEvent: mouseEvent inspect: morph
-
- mouseEvent shiftPressed
- ifTrue: [(morph valueOfProperty: #event) explore]
- ifFalse: [(morph valueOfProperty: #event) inspect].!
Item was removed:
- ----- Method: KeyboardExerciser>>handlesKeyboard: (in category 'event handling') -----
- handlesKeyboard: evt
-
- ^ (self valueOfProperty: #eventCheck) value: evt!
Item was removed:
- ----- Method: KeyboardExerciser>>handlesMouseOver: (in category 'event handling') -----
- handlesMouseOver: evt
-
- ^ true!
Item was removed:
- ----- Method: KeyboardExerciser>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
-
- self
- color: (self userInterfaceTheme get: #color for: #ScrollPane);
- extent: 300 at 50;
- layoutPolicy: TableLayout new;
- listDirection: #leftToRight;
- wrapDirection: #topToBottom;
- hResizing: #rigid;
- vResizing: #shrinkWrap;
- cellGap: 10;
- layoutInset: 20;
- yourself.
-
- #(processKeyStroke 'Test key stroke'
- processKeyDown 'Test key down'
- processKeyUp 'Test key up')
- groupsDo: [:selector :label |
- self addMorphBack: (ThreePhaseButtonMorph checkBox
- target: self;
- actionSelector: selector;
- label: label;
- yourself)].
-
- self processKeyStroke.!
Item was removed:
- ----- Method: KeyboardExerciser>>keyDown: (in category 'event handling') -----
- keyDown: evt
-
- self logEvent: evt.!
Item was removed:
- ----- Method: KeyboardExerciser>>keyStroke: (in category 'event handling') -----
- keyStroke: evt
-
- self logEvent: evt.!
Item was removed:
- ----- Method: KeyboardExerciser>>keyUp: (in category 'event handling') -----
- keyUp: evt
-
- self logEvent: evt.!
Item was removed:
- ----- Method: KeyboardExerciser>>lastEvent (in category 'accessing') -----
- lastEvent
-
- | view event |
- view := self submorphs last.
- (view hasProperty: #event) ifFalse: [^ nil].
- event := view valueOfProperty: #event.
- event isCollection ifTrue: [event := event last].
- ^ event!
Item was removed:
- ----- Method: KeyboardExerciser>>logEvent: (in category 'event handling') -----
- logEvent: evt
-
- | eventMorph |
- evt = self lastEvent
- ifTrue: [^ self logEventRepetition: evt].
-
- eventMorph := evt asMorph.
- eventMorph
- setProperty: #event toValue: evt copy;
- balloonText: ('Click to inspect. Shift+click to explore.\\Virtual key: {8}\Virtual modifiers: {5}\\Physical key: {9}\Physical modifiers: {6}\\Key value: 0x{1} ({2}) \Key character: {3}\Key string: {4}\\{7}' translated withCRs format: {
- evt keyValue printPaddedWith: $0 to: 2 base: 16.
- evt keyValue.
- evt isKeystroke ifTrue: [evt keyCharacter printString] ifFalse: ['-'].
- evt isKeystroke ifTrue: [evt keyString printString] ifFalse: ['-'].
- (evt virtualModifiers joinSeparatedBy: ' ') asUppercase.
- (evt physicalModifiers joinSeparatedBy: ' ') asUppercase.
- evt printString.
- evt virtualKey printString.
- evt physicalKey asString printString}).
-
- eventMorph
- on: #mouseEnter send: #handleEvent:emphasize: to: self;
- on: #mouseLeave send: #handleEvent:deemphasize: to: self;
- on: #mouseDown send: #handleEvent:inspect: to: self.
-
- self addMorphBack: eventMorph.!
Item was removed:
- ----- Method: KeyboardExerciser>>logEventRepetition: (in category 'event handling') -----
- logEventRepetition: evt
-
- | label lastEvents box |
- (self submorphs last hasProperty: #repetition)
- ifTrue: [box := self submorphs last. label := box submorphs first]
- ifFalse: [
- box := Morph new
- setProperty: #repetition toValue: true;
- color: Color transparent;
- layoutPolicy: TableLayout new;
- hResizing: #shrinkWrap;
- vResizing:#shrinkWrap;
- yourself.
- label := '' asText asMorph lock.
- box addMorph: label.
- box setProperty: #event toValue: (OrderedCollection with: self lastEvent).
- self addMorphBack: box].
-
- lastEvents := box valueOfProperty: #event.
- lastEvents add: evt copy.
- box setProperty: #event toValue: lastEvents.
-
- label newContents: (('x ', (lastEvents size)) asText
- addAttribute: (TextFontReference toFont: Preferences standardButtonFont);
- yourself).
- box balloonText: ('{1}{2}' format: {
- lastEvents size > 10 ifTrue: ['... {1} older events and:\' translated withCRs format: {lastEvents size - 10}] ifFalse: [''].
- (lastEvents last: (10 min: lastEvents size)) joinSeparatedBy: String cr.
- }).
-
- box
- on: #mouseEnter send: #handleEvent:emphasize: to: self;
- on: #mouseLeave send: #handleEvent:deemphasize: to: self;
- on: #mouseDown send: #handleEvent:inspect: to: self.!
Item was removed:
- ----- Method: KeyboardExerciser>>mouseEnter: (in category 'event handling') -----
- mouseEnter: evt
-
- self comeToFront.
- evt hand newKeyboardFocus: self.!
Item was removed:
- ----- Method: KeyboardExerciser>>processKeyDown (in category 'initialization') -----
- processKeyDown
-
- self setProperty: #eventCheck toValue: [:evt | evt isKeyDown].
- self checkButton: 2.
- self clear.!
Item was removed:
- ----- Method: KeyboardExerciser>>processKeyStroke (in category 'initialization') -----
- processKeyStroke
-
- self setProperty: #eventCheck toValue: [:evt | evt isKeystroke].
- self checkButton: 1.
- self clear.!
Item was removed:
- ----- Method: KeyboardExerciser>>processKeyUp (in category 'initialization') -----
- processKeyUp
-
- self setProperty: #eventCheck toValue: [:evt | evt isKeyUp].
- self checkButton: 3.
- self clear.!
Item was removed:
- Object subclass: #LayoutCell
- instanceVariableNames: 'target cellSize extraSpace flags nextCell'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Layouts'!
-
- !LayoutCell commentStamp: '<historical>' prior: 0!
- I am used in table layouts to hold temporary values while the layout is being computed.
-
- Instance variables:
- target <Morph> The morph contained in this cell
- cellSize <Point> The size of the cell
- extraSpace <nil | Point> Additional space to add after this cell
- nextCell <nil | LayoutCell> The next cell in the arrangement.
-
- Implementation note:
- Both, cellSize and extraSpace contains points where
- x - represents the primary table direction
- y - represents the secondary table direction
- !
Item was removed:
- ----- Method: LayoutCell>>addExtraSpace: (in category 'accessing') -----
- addExtraSpace: aPoint
- extraSpace
- ifNil:[extraSpace := aPoint]
- ifNotNil:[extraSpace := extraSpace + aPoint]!
Item was removed:
- ----- Method: LayoutCell>>cellSize (in category 'accessing') -----
- cellSize
- ^cellSize!
Item was removed:
- ----- Method: LayoutCell>>cellSize: (in category 'accessing') -----
- cellSize: aPoint
- cellSize := aPoint!
Item was removed:
- ----- Method: LayoutCell>>do: (in category 'collection') -----
- do: aBlock
- aBlock value: self.
- nextCell ifNotNil:[nextCell do: aBlock].!
Item was removed:
- ----- Method: LayoutCell>>extraSpace (in category 'accessing') -----
- extraSpace
- ^extraSpace ifNil:[0 at 0]!
Item was removed:
- ----- Method: LayoutCell>>extraSpace: (in category 'accessing') -----
- extraSpace: aPoint
- extraSpace := aPoint!
Item was removed:
- ----- Method: LayoutCell>>flags (in category 'accessing') -----
- flags
- ^flags ifNil: [ 0 ]!
Item was removed:
- ----- Method: LayoutCell>>hSpaceFill (in category 'accessing') -----
- hSpaceFill
- ^self flags anyMask: 1!
Item was removed:
- ----- Method: LayoutCell>>hSpaceFill: (in category 'accessing') -----
- hSpaceFill: aBool
- flags := aBool ifTrue:[self flags bitOr: 1] ifFalse:[self flags bitClear: 1].
- !
Item was removed:
- ----- Method: LayoutCell>>inject:into: (in category 'collection') -----
- inject: thisValue into: binaryBlock
- "Accumulate a running value associated with evaluating the argument,
- binaryBlock, with the current value of the argument, thisValue, and the
- receiver as block arguments. For instance, to sum the numeric elements
- of a collection, aCollection inject: 0 into: [:subTotal :next | subTotal +
- next]."
-
- | nextValue |
- nextValue := thisValue.
- self do: [:each | nextValue := binaryBlock value: nextValue value: each].
- ^nextValue!
Item was removed:
- ----- Method: LayoutCell>>nextCell (in category 'accessing') -----
- nextCell
- ^nextCell!
Item was removed:
- ----- Method: LayoutCell>>nextCell: (in category 'accessing') -----
- nextCell: aCell
- nextCell := aCell!
Item was removed:
- ----- Method: LayoutCell>>size (in category 'accessing') -----
- size
- | n cell |
- n := 0.
- cell := self.
- [cell isNil] whileFalse:
- [n := n + 1.
- cell := cell nextCell].
- ^n!
Item was removed:
- ----- Method: LayoutCell>>target (in category 'accessing') -----
- target
- ^target!
Item was removed:
- ----- Method: LayoutCell>>target: (in category 'accessing') -----
- target: newTarget
- target := newTarget!
Item was removed:
- ----- Method: LayoutCell>>vSpaceFill (in category 'accessing') -----
- vSpaceFill
- ^self flags anyMask: 2!
Item was removed:
- ----- Method: LayoutCell>>vSpaceFill: (in category 'accessing') -----
- vSpaceFill: aBool
- flags := aBool ifTrue:[self flags bitOr: 2] ifFalse:[self flags bitClear: 2].
- !
Item was removed:
- Object subclass: #LayoutPolicy
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Layouts'!
-
- !LayoutPolicy commentStamp: '<historical>' prior: 0!
- A LayoutPolicy defines how submorphs of some morph should be arranged. Subclasses of the receiver define concrete layout policies.!
Item was removed:
- ----- Method: LayoutPolicy>>flushLayoutCache (in category 'layout') -----
- flushLayoutCache
- "Flush any cached information associated with the receiver"!
Item was removed:
- ----- Method: LayoutPolicy>>indexForInserting:at:in: (in category 'utilities') -----
- indexForInserting: aMorph at: aPoint in: someMorph
- "Return the insertion index based on the layout strategy defined for some morph. Used for drop insertion."
- ^1 "front-most"!
Item was removed:
- ----- Method: LayoutPolicy>>isGridLayout (in category 'testing') -----
- isGridLayout
-
- ^ false!
Item was removed:
- ----- Method: LayoutPolicy>>isProportionalLayout (in category 'testing') -----
- isProportionalLayout
- ^false!
Item was removed:
- ----- Method: LayoutPolicy>>isTableLayout (in category 'testing') -----
- isTableLayout
- ^false!
Item was removed:
- ----- Method: LayoutPolicy>>layout:in: (in category 'layout') -----
- layout: aMorph in: newBounds
- "Compute the layout for the given morph based on the new bounds"
- !
Item was removed:
- ----- Method: LayoutPolicy>>minExtentOf:in: (in category 'layout') -----
- minExtentOf: aMorph in: newBounds
- "Return the minimal size aMorph's children would require given the new bounds"
- ^0 at 0!
Item was removed:
- Object subclass: #LayoutProperties
- instanceVariableNames: 'hResizing vResizing disableLayout'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Layouts'!
-
- !LayoutProperties commentStamp: '<historical>' prior: 0!
- This class provides a compact bit encoding for the most commonly used layout properties.!
Item was removed:
- ----- Method: LayoutProperties>>asGridLayoutProperties (in category 'converting') -----
- asGridLayoutProperties
-
- ^ GridLayoutProperties new
- hResizing: self hResizing;
- vResizing: self vResizing;
- disableLayout: self disableLayout;
- yourself!
Item was removed:
- ----- Method: LayoutProperties>>asTableLayoutProperties (in category 'converting') -----
- asTableLayoutProperties
-
- ^ TableLayoutProperties new
- hResizing: self hResizing;
- vResizing: self vResizing;
- disableLayout: self disableLayout;
- yourself!
Item was removed:
- ----- Method: LayoutProperties>>cellGap (in category 'defaults - table layout') -----
- cellGap
- "Default"
- ^0!
Item was removed:
- ----- Method: LayoutProperties>>cellInset (in category 'defaults - table layout') -----
- cellInset
- "Default"
- ^0!
Item was removed:
- ----- Method: LayoutProperties>>cellPositioning (in category 'defaults - table layout') -----
- cellPositioning
- ^#center!
Item was removed:
- ----- Method: LayoutProperties>>cellSpacing (in category 'defaults - table layout') -----
- cellSpacing
- "Default"
- ^#none!
Item was removed:
- ----- Method: LayoutProperties>>disableLayout (in category 'accessing') -----
- disableLayout
- ^disableLayout!
Item was removed:
- ----- Method: LayoutProperties>>disableLayout: (in category 'accessing') -----
- disableLayout: aBool
- disableLayout := aBool!
Item was removed:
- ----- Method: LayoutProperties>>disableTableLayout (in category 'accessing') -----
- disableTableLayout
- ^disableLayout!
Item was removed:
- ----- Method: LayoutProperties>>disableTableLayout: (in category 'accessing') -----
- disableTableLayout: aBool
- disableLayout := aBool!
Item was removed:
- ----- Method: LayoutProperties>>hResizing (in category 'accessing') -----
- hResizing
- ^hResizing!
Item was removed:
- ----- Method: LayoutProperties>>hResizing: (in category 'accessing') -----
- hResizing: aSymbol
- hResizing := aSymbol!
Item was removed:
- ----- Method: LayoutProperties>>includesGridLayoutProperties (in category 'testing') -----
- includesGridLayoutProperties
-
- ^ false!
Item was removed:
- ----- Method: LayoutProperties>>includesTableLayoutProperties (in category 'testing') -----
- includesTableLayoutProperties
-
- ^ false!
Item was removed:
- ----- Method: LayoutProperties>>initialize (in category 'initialize') -----
- initialize
- super initialize.
- hResizing := vResizing := #rigid.
- disableLayout := false.!
Item was removed:
- ----- Method: LayoutProperties>>initializeFrom: (in category 'initialize') -----
- initializeFrom: defaultProvider
- "Initialize the receiver from a default provider"
-
- self hResizing: defaultProvider hResizing.
- self vResizing: defaultProvider vResizing.
- self disableLayout: defaultProvider disableLayout.!
Item was removed:
- ----- Method: LayoutProperties>>layoutInset (in category 'defaults - table layout') -----
- layoutInset
- ^0!
Item was removed:
- ----- Method: LayoutProperties>>listCentering (in category 'defaults - table layout') -----
- listCentering
- "Default"
- ^#topLeft!
Item was removed:
- ----- Method: LayoutProperties>>listDirection (in category 'defaults - table layout') -----
- listDirection
- "Default"
- ^#topToBottom!
Item was removed:
- ----- Method: LayoutProperties>>listSpacing (in category 'defaults - table layout') -----
- listSpacing
- "Default"
- ^#none!
Item was removed:
- ----- Method: LayoutProperties>>maxCellSize (in category 'defaults - table layout') -----
- maxCellSize
- ^SmallInteger maxVal!
Item was removed:
- ----- Method: LayoutProperties>>minCellSize (in category 'defaults - table layout') -----
- minCellSize
- ^0!
Item was removed:
- ----- Method: LayoutProperties>>modulus (in category 'defaults - grid layout') -----
- modulus
-
- ^ 8 at 8!
Item was removed:
- ----- Method: LayoutProperties>>origin (in category 'defaults - grid layout') -----
- origin
-
- ^ 0 at 0!
Item was removed:
- ----- Method: LayoutProperties>>printOn: (in category 'printing') -----
- printOn: stream
-
- self flag: #todo. "mt: Find a more readable format. Maybe with line breaks and tabs."
- self storeOn: stream.!
Item was removed:
- ----- Method: LayoutProperties>>reverseTableCells (in category 'defaults - table layout') -----
- reverseTableCells
- ^false!
Item was removed:
- ----- Method: LayoutProperties>>rubberBandCells (in category 'defaults - table layout') -----
- rubberBandCells
- ^false!
Item was removed:
- ----- Method: LayoutProperties>>storeOn: (in category 'printing') -----
- storeOn: stream
-
- | defaultProperties uniquePropertiesNames |
- defaultProperties := self class new.
- uniquePropertiesNames := self class allInstVarNames
- select: [:name | (self instVarNamed: name) ~= (defaultProperties instVarNamed: name)].
- stream
- nextPutAll: '(', self species name;
- nextPutAll: ' new'.
- uniquePropertiesNames
- do: [:name |
- stream
- nextPutAll: ' ', name, ': ';
- store: (self instVarNamed: name);
- nextPut: $;].
- stream nextPutAll: ' yourself)'.!
Item was removed:
- ----- Method: LayoutProperties>>vResizing (in category 'accessing') -----
- vResizing
- ^vResizing!
Item was removed:
- ----- Method: LayoutProperties>>vResizing: (in category 'accessing') -----
- vResizing: aSymbol
- vResizing := aSymbol!
Item was removed:
- ----- Method: LayoutProperties>>wrapCentering (in category 'defaults - table layout') -----
- wrapCentering
- ^#topLeft!
Item was removed:
- ----- Method: LayoutProperties>>wrapDirection (in category 'defaults - table layout') -----
- wrapDirection
- ^#none!
Item was removed:
- Morph subclass: #LazyListMorph
- instanceVariableNames: 'listItems listIcons listFilterOffsets font selectedRow selectedRows preSelectedRow listSource maxWidth columnIndex iconExtent backgroundColor showFilter'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !LazyListMorph commentStamp: 'mt 10/13/2019 19:44' prior: 0!
- The morph that displays the list in a PluggableListMorph. It is "lazy" because it will only request the list items that it actually needs to display.
-
- I will cache the maximum width of my items in maxWidth to avoid this potentially expensive and frequent computation.
-
- The following layout properties are supported:
- - #cellPositioning: #leftCenter [default], #center, #rightCenter
- - #cellInset: [default: 3 at 0 corner: 3 at 0]!
Item was removed:
- ----- Method: LazyListMorph>>backgroundColor (in category 'accessing') -----
- backgroundColor
- "Since #color is this morph's default text color, this extra property is used for the actual background color. Supports nil."
-
- ^ backgroundColor!
Item was removed:
- ----- Method: LazyListMorph>>backgroundColor: (in category 'accessing') -----
- backgroundColor: aColor
-
- backgroundColor = aColor ifTrue: [^ self].
- backgroundColor := aColor.
-
- self changed.
- "Invalidate owner because we want to fill the vertical axis in the viewport entirely."
- self owner ifNotNil: [:o | o changed].!
Item was removed:
- ----- Method: LazyListMorph>>bottomVisibleRowForCanvas: (in category 'drawing') -----
- bottomVisibleRowForCanvas: aCanvas
- "return the bottom visible row in aCanvas's clip rectangle"
- ^self rowAtLocation: aCanvas clipRect bottomLeft - (0 at 1).
- !
Item was removed:
- ----- Method: LazyListMorph>>cellInset: (in category 'layout') -----
- cellInset: inset
- "Always store a rectangle to speed up drawing."
-
- super cellInset: (inset isRectangle
- ifTrue: [inset]
- ifFalse: [inset asPoint corner: inset asPoint]).!
Item was removed:
- ----- Method: LazyListMorph>>colorForRow: (in category 'drawing') -----
- colorForRow: row
-
- ^(selectedRow notNil and: [ row = selectedRow])
- ifTrue: [ self selectionTextColor ]
- ifFalse: [ self color ].!
Item was removed:
- ----- Method: LazyListMorph>>columnIndex (in category 'accessing') -----
- columnIndex
- ^ columnIndex!
Item was removed:
- ----- Method: LazyListMorph>>columnIndex: (in category 'accessing') -----
- columnIndex: anInteger
- columnIndex := anInteger.!
Item was removed:
- ----- Method: LazyListMorph>>display:atRow:on: (in category 'drawing') -----
- display: item atRow: row on: canvas
- "display the given item at row row"
-
- | drawBounds leading emphasized rowColor itemAsText alignment |
- itemAsText := item asStringOrText.
- alignment := self cellPositioning.
-
- "If it is a text, we will only use the first character's emphasis."
- emphasized := itemAsText isText
- ifFalse: [ font "fast path" ]
- ifTrue: [ "Note that a font change may interfere with the receiver's uniform item height."
- (itemAsText
- fontAt: 1 withDefault: font)
- emphasized: (itemAsText emphasisAt: 1)].
-
- rowColor := itemAsText isText
- ifTrue: [itemAsText colorAt: 1 ifNone: [self colorForRow: row]]
- ifFalse: [self colorForRow: row].
-
- drawBounds := self drawBoundsForRow: row.
-
- alignment ~= #leftCenter ifTrue: [
- | itemWidth |
- itemWidth := self widthToDisplayItem: item. "includes left/right margins"
- alignment == #center ifTrue: [
- drawBounds := (self center x - (itemWidth / 2) floor) @ drawBounds top corner: (self center x + (itemWidth / 2) ceiling) @ drawBounds bottom].
- alignment == #rightCenter ifTrue: [
- drawBounds := (self right - itemWidth) @ drawBounds top corner: self right @ drawBounds bottom]].
-
- "Draw icon if existing. Adjust draw bounds in that case."
- drawBounds := drawBounds translateBy: (self cellInset left @ 0).
- (self icon: row) ifNotNil: [ :icon || top |
- top := drawBounds top + ((drawBounds height - self iconExtent y) // 2).
- canvas translucentImage: icon at: drawBounds left @ top.
- drawBounds := drawBounds left: drawBounds left + self iconExtent x + self cellInset left ].
-
- "We will only draw strings here."
- leading := emphasized lineGapSliceForMorphs. "look vertically centered"
- drawBounds := drawBounds translateBy: (0 @ self cellInset top).
- canvas
- drawString: itemAsText asString
- in: (drawBounds origin + (0 @ leading) corner: drawBounds corner)
- font: emphasized
- color: rowColor.
-
- "Draw filter matches if any."
- self
- displayFilterOn: canvas
- for: row
- in: drawBounds
- font: emphasized.!
Item was removed:
- ----- Method: LazyListMorph>>displayFilterOn:for:in:font: (in category 'drawing') -----
- displayFilterOn: canvas for: row in: drawBounds font: font
- "Draw filter matches if any."
-
- | fillStyle fillHeight leading |
- self showFilter ifFalse: [^ self].
-
- fillHeight := font lineGridForMorphs.
- fillStyle := self filterColor isColor
- ifTrue: [SolidFillStyle color: self filterColor]
- ifFalse: [self filterColor].
- fillStyle isGradientFill ifTrue: [
- fillStyle origin: drawBounds topLeft.
- fillStyle direction: 0@ fillHeight].
-
- leading := font lineGapSliceForMorphs.
-
- (self filterOffsets: row) do: [:offset |
- | highlightRectangle |
- highlightRectangle := ((drawBounds left + offset first first) @ drawBounds top
- corner: (drawBounds left + offset first last) @ (drawBounds top + fillHeight)).
- canvas
- frameAndFillRoundRect: (highlightRectangle outsetBy: 1 at 0)
- radius: (3 * RealEstateAgent scaleFactor) truncated
- fillStyle: fillStyle
- borderWidth: (1 * RealEstateAgent scaleFactor) truncated
- borderColor: fillStyle asColor twiceDarker.
- canvas
- drawString: offset second
- in: (highlightRectangle origin + (0 @ leading) corner: highlightRectangle corner)
- font: font
- color: self filterTextColor].!
Item was removed:
- ----- Method: LazyListMorph>>doLayoutIn: (in category 'layout') -----
- doLayoutIn: layoutBounds
- "Only consider #shrinkWrap. Other layout properties are implemented in #drawOn:."
-
- self adjustLayoutBounds.
- fullBounds := self outerBounds.!
Item was removed:
- ----- Method: LazyListMorph>>drawBackgroundForMulti:on: (in category 'drawing') -----
- drawBackgroundForMulti: row on: aCanvas
- "shade the background paler, if this row is selected, but not the current selected row"
- | selectionDrawBounds |
- selectionDrawBounds := self drawBoundsForRow: row.
- selectionDrawBounds := selectionDrawBounds intersect: self bounds.
- aCanvas
- fillRectangle: selectionDrawBounds
- color: self multiSelectionColor!
Item was removed:
- ----- Method: LazyListMorph>>drawBoundsForRow: (in category 'list management') -----
- drawBoundsForRow: row
- "calculate the bounds that row should be drawn at. This might be outside our bounds!!"
- | topLeft drawBounds |
- topLeft := self topLeft x @ (self topLeft y + ((row - 1) * self rowHeight)).
- drawBounds := topLeft extent: self width @ self rowHeight.
- ^drawBounds!
Item was removed:
- ----- Method: LazyListMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- | topRow bottomRow |
- self backgroundColor ifNotNil: [:color |
- aCanvas fillRectangle: (self topLeft corner: self right @ ((self owner ifNil: [self]) bottom)) color: color].
-
- self getListSize = 0 ifTrue: [ ^self ].
-
- self drawPreSelectionOn: aCanvas.
-
- topRow := self topVisibleRowForCanvas: aCanvas.
- bottomRow := self bottomVisibleRowForCanvas: aCanvas.
-
- "Draw multi-selection."
- self listSource hasMultiSelection ifTrue: [
- topRow to: bottomRow do: [ :row |
- (self listSource itemSelectedAmongMultiple: row) ifTrue: [
- self drawBackgroundForMulti: row on: aCanvas ] ] ].
- self drawSelectionOn: aCanvas.
-
- "Draw hovered row if preference enabled."
- PluggableListMorph highlightHoveredRow ifTrue: [
- self listSource hoverRow > 0 ifTrue: [
- self highlightHoverRow: listSource hoverRow on: aCanvas ] ].
-
- "Draw all visible rows."
- topRow to: bottomRow do: [ :row |
- self display: (self item: row) atRow: row on: aCanvas ].
-
- "Finally, highlight drop row for drag/drop operations.."
- self listSource potentialDropRow > 0 ifTrue: [
- self highlightPotentialDropRow: self listSource potentialDropRow on: aCanvas ].!
Item was removed:
- ----- Method: LazyListMorph>>drawPreSelectionOn: (in category 'drawing') -----
- drawPreSelectionOn: aCanvas
-
- self
- drawSelectionFor: preSelectedRow
- withColor: self preSelectionColor
- on: aCanvas!
Item was removed:
- ----- Method: LazyListMorph>>drawSelectionFor:withColor:on: (in category 'drawing') -----
- drawSelectionFor: index withColor: color on: aCanvas
-
- | selectionDrawBounds fill |
- index ifNil: [ ^self ].
- index = 0 ifTrue: [ ^self ].
- selectionDrawBounds := self drawBoundsForRow: index.
- selectionDrawBounds := selectionDrawBounds intersect: self bounds.
-
- fill := color isColor
- ifTrue: [SolidFillStyle color: color]
- ifFalse: [color].
- fill isGradientFill ifTrue: [
- fill origin: selectionDrawBounds topLeft.
- fill direction: 0@ selectionDrawBounds height].
-
- listSource hasMultiSelection
- ifFalse: [aCanvas fillRectangle: selectionDrawBounds fillStyle: fill]
- ifTrue: [aCanvas frameRectangle: selectionDrawBounds color: fill asColor] .!
Item was removed:
- ----- Method: LazyListMorph>>drawSelectionOn: (in category 'drawing') -----
- drawSelectionOn: aCanvas
-
- self
- drawSelectionFor: selectedRow
- withColor: self selectionColor
- on: aCanvas!
Item was removed:
- ----- Method: LazyListMorph>>filterColor (in category 'accessing') -----
- filterColor
- ^ self valueOfProperty: #filterColor ifAbsent: [Color yellow]!
Item was removed:
- ----- Method: LazyListMorph>>filterColor: (in category 'accessing') -----
- filterColor: aColor
-
- | cc fill |
- cc := aColor.
-
- MenuMorph gradientMenu
- ifFalse: [fill := SolidFillStyle color: cc]
- ifTrue: [
- fill := GradientFillStyle ramp: {
- 0.0 -> cc twiceLighter.
- 1 -> cc twiceDarker }].
-
- self setProperty: #filterColor toValue: fill!
Item was removed:
- ----- Method: LazyListMorph>>filterOffsets: (in category 'list access - cached') -----
- filterOffsets: row
- "Do inst-var access on listFilterOffsets here to initialize it as late as possible."
-
- listFilterOffsets ifNil: [listFilterOffsets := Array new: self getListSize].
-
- ^ (listFilterOffsets at: row) ifNil: [
- | offsets |
- offsets := self getFilterOffsets: row.
- listFilterOffsets at: row put: offsets.
- offsets]!
Item was removed:
- ----- Method: LazyListMorph>>filterTextColor (in category 'accessing') -----
- filterTextColor
- ^ self valueOfProperty: #filterTextColor ifAbsent: [Color black]!
Item was removed:
- ----- Method: LazyListMorph>>font (in category 'accessing') -----
- font
- "return the font used for drawing. The response is never nil"
- ^font!
Item was removed:
- ----- Method: LazyListMorph>>font: (in category 'accessing') -----
- font: newFont
-
- font := (newFont ifNil: [ TextStyle default defaultFont ]).
- listFilterOffsets := nil.
-
- self layoutChanged.
- self changed.!
Item was removed:
- ----- Method: LazyListMorph>>getFilterOffsets: (in category 'list access') -----
- getFilterOffsets: row
- "Calculate matching character indexes for the current filter term."
-
- | item filter offsets currentIndex sub emphasized |
- filter := self listSource filterTerm.
- filter ifEmpty: [^ Array empty].
-
- item := (self item: row) asStringOrText.
-
- emphasized := item isText
- ifTrue: [font emphasized: (item emphasisAt: 1)]
- ifFalse: [font].
-
- item := item asString.
-
- offsets := OrderedCollection new.
-
- currentIndex := 1.
- [currentIndex > 0] whileTrue: [
- currentIndex := item findString: filter startingAt: currentIndex caseSensitive: false.
- currentIndex > 0 ifTrue: [ | left width |
- left := emphasized widthOfString: item from: 1 to: currentIndex-1.
- sub := item copyFrom: currentIndex to: currentIndex + filter size - 1.
- width := emphasized widthOfString: sub.
- offsets addLast: {(left to: left + width). sub}.
- currentIndex := currentIndex + 1] ].
- ^ offsets!
Item was removed:
- ----- Method: LazyListMorph>>getListIcon: (in category 'list access') -----
- getListIcon: row
-
- ^ listSource iconAt: row column: self columnIndex
- !
Item was removed:
- ----- Method: LazyListMorph>>getListItem: (in category 'list access') -----
- getListItem: index
-
- ^ listSource itemAt: index column: self columnIndex!
Item was removed:
- ----- Method: LazyListMorph>>getListSize (in category 'list access') -----
- getListSize
- "return the number of items in the list"
- listSource ifNil: [ ^0 ].
- ^listSource listSize!
Item was removed:
- ----- Method: LazyListMorph>>highlightHoverRow:on: (in category 'drawing') -----
- highlightHoverRow: row on: aCanvas
- | drawBounds |
- drawBounds := self drawBoundsForRow: row.
- drawBounds := drawBounds intersect: self bounds.
- aCanvas fillRectangle: drawBounds color: self hoverColor.!
Item was removed:
- ----- Method: LazyListMorph>>highlightPotentialDropRow:on: (in category 'drawing') -----
- highlightPotentialDropRow: row on: aCanvas
- | drawBounds |
- drawBounds := self drawBoundsForRow: row.
- drawBounds := drawBounds intersect: self bounds.
- aCanvas frameRectangle: drawBounds color: self selectionColor asColor!
Item was removed:
- ----- Method: LazyListMorph>>hoverColor (in category 'accessing') -----
- hoverColor
- ^ self valueOfProperty: #hoverColor ifAbsent: [Color veryVeryLightGray]!
Item was removed:
- ----- Method: LazyListMorph>>icon: (in category 'list access - cached') -----
- icon: row
- "Answer a cached form from the model at a specific row. By flagging nil-icons with #none, only try to fetch an icon once from the model until next #listChanged. Also do inst-var access on listIcons here to initialize it as late as possible."
-
- self listSource canHaveIcons ifFalse: [^ nil].
-
- listIcons ifNil: [listIcons := Array new: self getListSize].
-
- ^ (listIcons at: row)
- ifNotNil: [:iconOrNone | iconOrNone == #none ifFalse: [iconOrNone]]
- ifNil: [
- | icon |
- icon := (self getListIcon: row) ifNotNil: [:form | form scaleIconToDisplay].
- "Update cache for uniform icon extent."
- iconExtent ifNil: [iconExtent := icon ifNotNil: [icon extent]].
- listIcons at: row put: (icon ifNil: [#none]).
- icon]!
Item was removed:
- ----- Method: LazyListMorph>>iconExtent (in category 'layout') -----
- iconExtent
- "Answers the uniform icon extent for this lazy list based on sample icons from the list source."
-
- | listSize |
- iconExtent ifNil: [
-
- self listSource canHaveIcons
- ifFalse: [^ iconExtent := 0 at 0].
-
- (listSize := self getListSize) = 0
- ifTrue: [^ iconExtent := ((14 at 14) * RealEstateAgent scaleFactor) truncated].
-
- (self icon: (2 min: listSize)) "mt: Use second item bc. first one might be visual separator w/o icon."
- ifNil: [^ iconExtent := 0 at 0]
- ifNotNil: [:form | ^ iconExtent := form extent]].
-
- ^ iconExtent!
Item was removed:
- ----- Method: LazyListMorph>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
-
- self color: Color black.
-
- font := Preferences standardListFont.
-
- listItems := nil.
- listIcons := nil.
- listFilterOffsets := nil.
-
- selectedRow := nil.
- selectedRows := PluggableSet integerSet.
- preSelectedRow := nil.!
Item was removed:
- ----- Method: LazyListMorph>>item: (in category 'list access - cached') -----
- item: index
- "Do inst-var access on listItems here to initialize it as late as possible."
-
- listItems ifNil: [listItems := Array new: self getListSize].
-
- ^ (listItems at: index) ifNil: [
- | newItem itemWidth |
- newItem := self getListItem: index.
-
- "Update the width cache."
- maxWidth ifNotNil: [
- itemWidth := self widthToDisplayItem: newItem.
- itemWidth > maxWidth ifTrue: [
- maxWidth := itemWidth.
- super layoutChanged]].
-
- listItems at: index put: newItem.
- newItem].!
Item was removed:
- ----- Method: LazyListMorph>>layoutChanged (in category 'layout') -----
- layoutChanged
- "See #item:. We have to invalidate listItems or maxWidth will not be updated if you switch hResizing to #shrinkWrap."
-
- listItems := nil.
- maxWidth := nil.
- iconExtent := nil.
-
- super layoutChanged.!
Item was removed:
- ----- Method: LazyListMorph>>listChanged (in category 'layout') -----
- listChanged
- "set newList to be the list of strings to display"
-
- listItems := nil.
- listIcons := nil.
- listFilterOffsets := nil.
-
- maxWidth := nil.
-
- "selectedRow := nil. --- avoid reset to keep UI stable. See PluggableListMorph >> #selectionIndex and #selectionIndex:."
- selectedRows := PluggableSet integerSet.
- preSelectedRow := nil.
-
- self layoutChanged.
- self changed.
- !
Item was removed:
- ----- Method: LazyListMorph>>listSource (in category 'accessing') -----
- listSource
- ^ listSource!
Item was removed:
- ----- Method: LazyListMorph>>listSource: (in category 'accessing') -----
- listSource: aListSource
- "set the source of list items -- typically a PluggableListMorph"
- listSource := aListSource.!
Item was removed:
- ----- Method: LazyListMorph>>maxHeight (in category 'layout') -----
- maxHeight
-
- ^ (self getListSize max: 1) * self rowHeight!
Item was removed:
- ----- Method: LazyListMorph>>maxWidth (in category 'layout') -----
- maxWidth
- "Approximate the maximum width of this lazy list. Take first n items as a sample."
-
- | threshold listSize |
- maxWidth ifNotNil:[^maxWidth].
-
- threshold := 30.
- listSize := self getListSize.
-
- maxWidth := 0.
- 1 to: (threshold min: listSize) do: [:index |
- maxWidth := maxWidth max: (self widthToDisplayItem: (self getListItem: index))].
-
- ^ maxWidth
- !
Item was removed:
- ----- Method: LazyListMorph>>multiSelectionColor (in category 'accessing') -----
- multiSelectionColor
-
- ^ self valueOfProperty: #multiSelectionColor ifAbsent: [self selectionColor asColor]!
Item was removed:
- ----- Method: LazyListMorph>>multiSelectionColor: (in category 'accessing') -----
- multiSelectionColor: aColor
-
- self setProperty: #multiSelectionColor toValue: aColor.!
Item was removed:
- ----- Method: LazyListMorph>>preSelectedRow: (in category 'list management') -----
- preSelectedRow: index
- " Show the user which row is about to become selected, thus providing feedback if there is a delay between the selection gesture and the actual selection of the row. "
-
- preSelectedRow := index.
- self changed.!
Item was removed:
- ----- Method: LazyListMorph>>preSelectionColor (in category 'accessing') -----
- preSelectionColor
- ^ self valueOfProperty: #preSelectionColor ifAbsent: [Color gray]!
Item was removed:
- ----- Method: LazyListMorph>>rowAtLocation: (in category 'list management') -----
- rowAtLocation: aPoint
- "return the number of the row at aPoint"
- | y |
- y := aPoint y.
- y < self top ifTrue: [ ^ 1 min: self getListSize ].
- ^((y - self top // self rowHeight) + 1) min: self getListSize max: 0!
Item was removed:
- ----- Method: LazyListMorph>>rowChanged: (in category 'updating') -----
- rowChanged: anInteger
-
- self invalidRect: (self drawBoundsForRow: anInteger).!
Item was removed:
- ----- Method: LazyListMorph>>rowChanged:with: (in category 'updating') -----
- rowChanged: oneRow with: anotherRow
- "Speed up drawing. Merge consecutive rows because the default damage recorder might not merge these rectangles."
-
- oneRow ifNil: [anotherRow ifNil: [^ self] ifNotNil: [^ self rowChanged: anotherRow]].
- anotherRow ifNil: [^ self rowChanged: oneRow].
-
- (oneRow - anotherRow) abs = 1
- ifTrue: [
- self invalidRect: ((self drawBoundsForRow: oneRow)
- quickMerge: (self drawBoundsForRow: anotherRow))]
- ifFalse: [
- self invalidRect: (self drawBoundsForRow: oneRow).
- self invalidRect: (self drawBoundsForRow: anotherRow)].!
Item was removed:
- ----- Method: LazyListMorph>>rowHeight (in category 'layout') -----
- rowHeight
-
- ^ font lineGridForMorphs + self cellInset top + self cellInset bottom!
Item was removed:
- ----- Method: LazyListMorph>>selectRow: (in category 'list management') -----
- selectRow: index
- " Select the index-th row. Clear the pre selection highlight. "
- selectedRows add: index.
- preSelectedRow := nil.
- self changed.!
Item was removed:
- ----- Method: LazyListMorph>>selectedRow (in category 'list management') -----
- selectedRow
- "return the currently selected row, or nil if none is selected"
- ^selectedRow!
Item was removed:
- ----- Method: LazyListMorph>>selectedRow: (in category 'list management') -----
- selectedRow: index
- " Select the index-th row. Clear the pre selection highlight. If nil, remove the current selection. "
-
- self rowChanged: selectedRow with: index.
- selectedRow := index.
- preSelectedRow := nil.!
Item was removed:
- ----- Method: LazyListMorph>>selection (in category 'list management') -----
- selection
-
- ^ self selectedRow ifNotNil: [:row |
- (row between: 1 and: self getListSize)
- ifTrue: [self item: row]
- ifFalse: [nil]]!
Item was removed:
- ----- Method: LazyListMorph>>selectionColor (in category 'accessing') -----
- selectionColor
- ^ self valueOfProperty: #selectionColor ifAbsent: [Color blue]!
Item was removed:
- ----- Method: LazyListMorph>>selectionColor: (in category 'accessing') -----
- selectionColor: aColor
-
- | cc fill |
- cc := aColor.
-
- MenuMorph gradientMenu
- ifFalse: [fill := SolidFillStyle color: cc]
- ifTrue: [
- fill := GradientFillStyle ramp: {
- 0.0 -> cc twiceLighter.
- 1 -> cc twiceDarker }].
-
- self setProperty: #selectionColor toValue: fill!
Item was removed:
- ----- Method: LazyListMorph>>selectionTextColor (in category 'accessing') -----
- selectionTextColor
- ^ self valueOfProperty: #selectionTextColor ifAbsent: [Color white]!
Item was removed:
- ----- Method: LazyListMorph>>showFilter (in category 'accessing') -----
- showFilter
-
- ^ (showFilter ~~ false and: [listSource filterableList])!
Item was removed:
- ----- Method: LazyListMorph>>showFilter: (in category 'accessing') -----
- showFilter: aBoolean
-
- showFilter = aBoolean ifTrue: [^ self].
- showFilter := aBoolean.
- self changed.!
Item was removed:
- ----- Method: LazyListMorph>>submorphBoundsForShrinkWrap (in category 'layout') -----
- submorphBoundsForShrinkWrap
- "Since we have no submorphs, we calculate those bounds here. Skip width calculation if we do not #shrinkWrap."
-
- ^ self hResizing == #shrinkWrap
- ifTrue: [(self topLeft extent: self maxWidth @ self maxHeight) insetBy: self cellInset]
- ifFalse: [self topLeft extent: 0 @ (self maxHeight - self cellInset top - self cellInset bottom)]!
Item was removed:
- ----- Method: LazyListMorph>>topVisibleRowForCanvas: (in category 'drawing') -----
- topVisibleRowForCanvas: aCanvas
- "return the top visible row in aCanvas's clip rectangle"
- ^self rowAtLocation: aCanvas clipRect topLeft.
- !
Item was removed:
- ----- Method: LazyListMorph>>unselectRow: (in category 'list management') -----
- unselectRow: index
- "unselect the index-th row"
- selectedRows remove: index ifAbsent: [].
- preSelectedRow := nil.
- self changed.!
Item was removed:
- ----- Method: LazyListMorph>>userString (in category 'accessing') -----
- userString
- "Do I have a text string to be searched on?"
-
- ^ String streamContents: [:strm |
- 1 to: self getListSize do: [:i |
- "must use asStringOrText because that's what the drawing uses, too"
- strm nextPutAll: (self getListItem: i) asStringOrText; cr]]!
Item was removed:
- ----- Method: LazyListMorph>>widthToDisplayItem: (in category 'layout') -----
- widthToDisplayItem: item
-
- | labelWidth iconWidth leftMargin rightMargin |
- leftMargin := self cellInset left.
- rightMargin := self cellInset right.
- labelWidth := self font widthOfStringOrText: item asStringOrText.
- iconWidth := self listSource canHaveIcons ifTrue: [self iconExtent x + leftMargin] ifFalse: [0].
- ^ leftMargin + iconWidth + labelWidth + rightMargin!
Item was removed:
- BorderGripMorph subclass: #LeftGripMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
Item was removed:
- ----- Method: LeftGripMorph>>apply: (in category 'target resize') -----
- apply: delta
- | oldBounds |
- oldBounds := self target bounds.
- self target
- bounds: (oldBounds origin + (delta x @ 0) corner: oldBounds corner).
- self flag: #workaround. "mt: Due to a layout-specific 'let us start in the top-left corner of a layout cell'-behavior, we have to go up the owner chain and propagate the delta. See Morph >> #layoutInBounds:positioning: and there section 1.2."
- self target allOwnersDo:
- [:anOwner |
- (anOwner layoutPolicy notNil and: [anOwner ~~ Project current world])
- ifTrue: [anOwner left: anOwner left + delta x]].!
Item was removed:
- ----- Method: LeftGripMorph>>defaultWidth (in category 'initialize') -----
- defaultWidth
-
- ^ self class gripThickness!
Item was removed:
- ----- Method: LeftGripMorph>>gripLayoutFrame (in category 'accessing') -----
- gripLayoutFrame
- ^ LayoutFrame
- fractions: (0 @ 0 corner: 0 @ 1)
- offsets: (0 @ 0 corner: 0 @ 0)!
Item was removed:
- ----- Method: LeftGripMorph>>initialize (in category 'initialize') -----
- initialize
- super initialize.
- self vResizing: #spaceFill.!
Item was removed:
- ----- Method: LeftGripMorph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
- layoutProportionallyInBounds: cellBounds positioning: cellPositioning
-
- super layoutProportionallyInBounds: cellBounds positioning: cellPositioning.
-
- self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
- self left: owner left.
-
- self top: owner top.
- self height: owner height.!
Item was removed:
- ----- Method: LeftGripMorph>>orientation (in category 'accessing') -----
- orientation
-
- ^ #vertical!
Item was removed:
- ----- Method: LeftGripMorph>>ptName (in category 'accessing') -----
- ptName
- ^#left!
Item was removed:
- ----- Method: LeftGripMorph>>resizeCursor (in category 'accessing') -----
- resizeCursor
-
- ^ Cursor resizeForEdge: #left!
Item was removed:
- Object subclass: #LegacyShortcutsFilter
- instanceVariableNames: ''
- classVariableNames: 'LegacyShortcutsEnabled'
- poolDictionaries: ''
- category: 'Morphic-Text Support'!
-
- !LegacyShortcutsFilter commentStamp: 'mt 12/25/2021 14:40' prior: 0!
- I am an event filter that provides keyboard shortcuts for TextEdtior that have been deprecated due to their incompatibility for non-US keyboard layouts.
-
- For more information, read on here:
- http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217304.html!
Item was removed:
- ----- Method: LegacyShortcutsFilter class>>filterEvent:for: (in category 'event filter') -----
- filterEvent: aKeyboardEvent for: textMorph
-
-
- aKeyboardEvent isKeystroke ifFalse: [^ aKeyboardEvent].
- aKeyboardEvent commandKeyPressed ifFalse: [^ aKeyboardEvent].
- Preferences cmdKeysInText ifFalse: [^ aKeyboardEvent].
-
- (Smalltalk platformName = 'Mac OS' and: [aKeyboardEvent shiftPressed])
- ifTrue: ["Work around an issue in the VM where SHIFT is not honored
- in the KeyChar event's character. This should only be the case for
- KeyDown events to encode virtual-key presses. The VM should not
- do this for KeyChar events. Works for U.S. keyboard layout only."
- aKeyboardEvent keyValue: (
- aKeyboardEvent keyCharacter caseOf: {
- [$9] -> [$(]. [$0] -> [$)].
- [$,] -> [$<]. [$.] -> [$>].
- [$[] -> [${]. [$]] -> [$}].
- [$'] -> [$"] }
- otherwise: [aKeyboardEvent keyCharacter]) asInteger].
-
- ('()[]{}|''"<>' includes: aKeyboardEvent keyCharacter)
- ifTrue: [textMorph
- handleInteraction: [(textMorph editor enclose: aKeyboardEvent toggleOnly: true)
- ifTrue: [aKeyboardEvent ignore]]
- fromEvent: aKeyboardEvent].
-
- ^ aKeyboardEvent
-
- "
- Preferences cmdKeysInText
- Preferences cmdGesturesEnabled
- Preferences honorDesktopCmdKeys
- PasteUpMorph globalCommandKeysEnabled.
- "!
Item was removed:
- ----- Method: LegacyShortcutsFilter class>>legacyShortcutsEnabled (in category 'preferences') -----
- legacyShortcutsEnabled
- <preference: 'Legacy keyboard shortcuts (US/UK only)'
- categoryList: #(Morphic keyboard editing)
- description: 'When true, text editors will support legacy keyboard shortcuts, which were originally introduced for US/UK keyboard layouts but are incompatible to several other international layouts. Includes shortcuts to enclose open brackets with closing ones and text selections with opening and closing ones.'
- type: #Boolean>
-
- ^ LegacyShortcutsEnabled ifNil: [false]!
Item was removed:
- ----- Method: LegacyShortcutsFilter class>>legacyShortcutsEnabled: (in category 'preferences') -----
- legacyShortcutsEnabled: aBoolean
-
- LegacyShortcutsEnabled = aBoolean ifTrue: [^ self].
- LegacyShortcutsEnabled := aBoolean.
-
- self legacyShortcutsEnabled
- ifTrue: [
- TextMorphForEditView allInstancesDo: [:textMorph |
- textMorph addKeyboardCaptureFilter: self]]
- ifFalse: [
- TextMorphForEditView allInstancesDo: [:textMorph |
- textMorph removeKeyboardCaptureFilter: self]].!
Item was removed:
- PolygonMorph subclass: #LineMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Basic'!
-
- !LineMorph commentStamp: '<historical>' prior: 0!
- This is really only a shell for creating single-segment straight-line Shapes.!
Item was removed:
- ----- Method: LineMorph class>>descriptionForPartsBin (in category 'parts bin') -----
- descriptionForPartsBin
- "Answer a description for the parts bin."
-
- ^ self partName: 'Line' translatedNoop
- categories: {'Graphics' translatedNoop}
- documentation: 'A straight line. Shift-click to get handles and move the ends.' translatedNoop!
Item was removed:
- ----- Method: LineMorph class>>from:to:color:width: (in category 'instance creation') -----
- from: startPoint to: endPoint color: lineColor width: lineWidth
-
- ^ PolygonMorph vertices: {startPoint. endPoint}
- color: Color black borderWidth: lineWidth borderColor: lineColor!
Item was removed:
- ----- Method: LineMorph class>>new (in category 'instance creation') -----
- new
- ^ self from: 0 at 0 to: 50 at 50 color: Color black width: 2!
Item was removed:
- ----- Method: LineMorph class>>newStandAlone (in category 'new-morph participation') -----
- newStandAlone
- "Answer a suitable instance for use in a parts bin, for example"
-
- ^ self new setNameTo: 'Line'!
Item was removed:
- Object subclass: #ListItemWrapper
- instanceVariableNames: 'item model'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Explorer'!
-
- !ListItemWrapper commentStamp: '<historical>' prior: 0!
- Contributed by Bob Arning as part of the ObjectExplorer package.
- !
Item was removed:
- ----- Method: ListItemWrapper class>>with: (in category 'instance creation') -----
- with: anObject
-
- ^self new setItem: anObject!
Item was removed:
- ----- Method: ListItemWrapper class>>with:model: (in category 'instance creation') -----
- with: anObject model: aModel
-
- ^self new setItem: anObject model: aModel!
Item was removed:
- ----- Method: ListItemWrapper>>acceptDroppingObject: (in category 'drag and drop') -----
- acceptDroppingObject: anotherItem
-
- ^item acceptDroppingObject: anotherItem!
Item was removed:
- ----- Method: ListItemWrapper>>asString (in category 'converting') -----
- asString
-
- ^item asString!
Item was removed:
- ----- Method: ListItemWrapper>>asStringOrText (in category 'converting') -----
- asStringOrText
- "Documentation only. You can create a custom wrapper that returns text with formatting. The tree widget will then use the text attributes of the first characters and applies them to the entire label. LazyListMorph works the same way."
-
- ^ self asString!
Item was removed:
- ----- Method: ListItemWrapper>>balloonText (in category 'accessing') -----
- balloonText
-
- ^nil!
Item was removed:
- ----- Method: ListItemWrapper>>canBeDragged (in category 'drag and drop') -----
- canBeDragged
-
- ^true!
Item was removed:
- ----- Method: ListItemWrapper>>contents (in category 'accessing') -----
- contents
-
- ^Array new!
Item was removed:
- ----- Method: ListItemWrapper>>handlesMouseOver: (in category 'event handling') -----
- handlesMouseOver: evt
-
- ^false!
Item was removed:
- ----- Method: ListItemWrapper>>hasContents (in category 'testing') -----
- hasContents
-
- ^self contents isEmpty not!
Item was removed:
- ----- Method: ListItemWrapper>>hasEquivalentIn: (in category 'testing') -----
- hasEquivalentIn: aCollection
-
- ^aCollection anySatisfy: [ :each |
- each withoutListWrapper = item withoutListWrapper]!
Item was removed:
- ----- Method: ListItemWrapper>>highlightColor (in category 'accessing') -----
- highlightColor
- "You can override the current theme's default with a custom value."
-
- ^ nil!
Item was removed:
- ----- Method: ListItemWrapper>>icon (in category 'accessing') -----
- icon
- "Answer a form to be used as icon"
- ^ nil!
Item was removed:
- ----- Method: ListItemWrapper>>item (in category 'accessing') -----
- item
- ^ item!
Item was removed:
- ----- Method: ListItemWrapper>>itemName (in category 'accessing') -----
- itemName
-
- ^ self item asString!
Item was removed:
- ----- Method: ListItemWrapper>>model (in category 'accessing') -----
- model
- ^ model!
Item was removed:
- ----- Method: ListItemWrapper>>preferredColor (in category 'accessing') -----
- preferredColor
- "You can override the current theme's default with a custom value."
-
- ^ nil!
Item was removed:
- ----- Method: ListItemWrapper>>sendSettingMessageTo: (in category 'setting') -----
- sendSettingMessageTo: aModel
-
- aModel
- perform: (self settingSelector ifNil: [^self])
- with: self withoutListWrapper
- !
Item was removed:
- ----- Method: ListItemWrapper>>setItem: (in category 'initialization') -----
- setItem: anObject
-
- item := anObject.!
Item was removed:
- ----- Method: ListItemWrapper>>setItem:model: (in category 'initialization') -----
- setItem: anObject model: aModel
-
- model := aModel.
- self setItem: anObject.!
Item was removed:
- ----- Method: ListItemWrapper>>settingSelector (in category 'private') -----
- settingSelector
-
- ^nil!
Item was removed:
- ----- Method: ListItemWrapper>>wantsDroppedObject: (in category 'drag and drop') -----
- wantsDroppedObject: anotherItem
-
- ^false!
Item was removed:
- ----- Method: ListItemWrapper>>withoutListWrapper (in category 'converting') -----
- withoutListWrapper
-
- ^item withoutListWrapper!
Item was removed:
- ----- Method: MIDIFileReader class>>playFileNamed: (in category '*Morphic-Sounds') -----
- playFileNamed: fileName
-
- ScorePlayerMorph
- openOn: (self scoreFromFileNamed: fileName)
- title: (FileDirectory localNameFor: fileName).
- !
Item was removed:
- ----- Method: MIDIFileReader class>>playStream: (in category '*Morphic-Sounds') -----
- playStream: binaryStream
-
- ScorePlayerMorph
- openOn: (self scoreFromStream: binaryStream)
- title: 'a MIDI stream'
- !
Item was removed:
- ----- Method: MIDIFileReader class>>playURLNamed: (in category '*Morphic-Sounds') -----
- playURLNamed: urlString
-
- | titleString |
- titleString := urlString
- copyFrom: (urlString findLast: [:c | c=$/]) + 1
- to: urlString size.
- ScorePlayerMorph
- openOn: (self scoreFromURL: urlString)
- title: titleString.
- !
Item was removed:
- MenuMorph subclass: #MVCMenuMorph
- instanceVariableNames: 'done mvcSelection'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Menus'!
-
- !MVCMenuMorph commentStamp: '<historical>' prior: 0!
- I simulate the MVC menu classes PopUpMenu, SelectionMenu, and CustomMenu when running in a Morphic world. I am also used to implement Utilities>informUser:during:.!
Item was removed:
- ----- Method: MVCMenuMorph class>>from:title: (in category 'instance creation') -----
- from: aPopupMenu title: titleStringOrNil
- "Answer a MenuMorph constructed from the given PopUpMenu. Used to simulate MVC-style menus in a Morphic-only world."
-
- | menu items lines selections labelString j |
- menu := self new.
- titleStringOrNil ifNotNil: [
- titleStringOrNil isEmpty ifFalse: [menu addTitle: titleStringOrNil]].
- labelString := aPopupMenu labelString.
- items := labelString asString lines.
- labelString isText ifTrue:
- ["Pass along text emphasis if present"
- j := 1.
- items := items collect:
- [:item | | emphasis |
- j := labelString asString findString: item startingAt: j.
- emphasis := TextEmphasis new emphasisCode: (labelString emphasisAt: j).
- item asText addAttribute: emphasis]].
- lines := aPopupMenu lineArray.
- lines ifNil: [lines := #()].
- menu cancelValue: 0.
- menu defaultTarget: menu.
- selections := (1 to: items size) asArray.
- 1 to: items size do: [:i |
- menu add: (items at: i) selector: #selectMVCItem: argument: (selections at: i).
- (lines includes: i) ifTrue: [menu addLine]].
- ^ menu
- !
Item was removed:
- ----- Method: MVCMenuMorph>>cancelValue: (in category 'private') -----
- cancelValue: selectionOrNil
- "Set the value to be returned if the user cancels without making a selection."
-
- mvcSelection := selectionOrNil.
- !
Item was removed:
- ----- Method: MVCMenuMorph>>displayAt:during: (in category 'invoking') -----
- displayAt: aPoint during: aBlock
- "Add this menu to the Morphic world during the execution of the given block."
-
- Smalltalk isMorphic ifFalse: [^ self].
-
- [self currentWorld addMorph: self centeredNear: aPoint.
- self world displayWorld. "show myself"
- aBlock value]
- ensure: [self delete]!
Item was removed:
- ----- Method: MVCMenuMorph>>informUserAt:during: (in category 'invoking') -----
- informUserAt: aPoint during: aBlock
- "Add this menu to the Morphic world during the execution of the given block."
-
- | title w |
- Smalltalk isMorphic ifFalse: [^ self].
-
- title := self allMorphs detect: [:ea | ea hasProperty: #titleString].
- title := title submorphs first.
- self visible: false.
- w := self currentWorld.
- aBlock value: [:string|
- self visible ifFalse: [
- w addMorph: self centeredNear: aPoint.
- self visible: true].
- title contents: string.
- self setConstrainedPosition: Sensor cursorPoint hangOut: false.
- self changed.
- w displayWorld "show myself"
- ].
- self delete.
- w displayWorld.!
Item was removed:
- ----- Method: MVCMenuMorph>>invokeAt:in: (in category 'invoking') -----
- invokeAt: aPoint in: aWorld
- "Add this menu to the given world centered at the given point. Wait for the user to make a selection and answer it. The selection value returned is an integer in keeping with PopUpMenu, if the menu is converted from an MVC-style menu."
- "Details: This is invoked synchronously from the caller. In order to keep processing inputs and updating the screen while waiting for the user to respond, this method has its own version of the World's event loop."
-
- ^ self invokeAt: aPoint in: aWorld allowKeyboard: Preferences menuKeyboardControl!
Item was removed:
- ----- Method: MVCMenuMorph>>invokeAt:in:allowKeyboard: (in category 'invoking') -----
- invokeAt: aPoint in: aWorld allowKeyboard: aBoolean
- "Add this menu to the given world centered at the given point. Wait for the user to make a selection and answer it. The selection value returned is an integer in keeping with PopUpMenu, if the menu is converted from an MVC-style menu."
- "Details: This is invoked synchronously from the caller. In order to keep processing inputs and updating the screen while waiting for the user to respond, this method has its own version of the World's event loop."
- | w originalFocusHolder |
- self flag: #bob. "is <aPoint> global or local?"
- self flag: #arNote. "<aPoint> is local to aWorld"
- originalFocusHolder := aWorld primaryHand keyboardFocus.
- self popUpAt: aPoint forHand: aWorld primaryHand in: aWorld allowKeyboard: aBoolean.
- done := false.
- w := aWorld outermostWorldMorph. "containing hand"
- [self isInWorld & done not] whileTrue: [w doOneSubCycle].
- self delete.
- originalFocusHolder ifNotNil: [aWorld primaryHand newKeyboardFocus: originalFocusHolder].
- ^ mvcSelection
- !
Item was removed:
- ----- Method: MVCMenuMorph>>selectMVCItem: (in category 'private') -----
- selectMVCItem: item
- "Called by the MenuItemMorph that the user selects.
- Record the selection and set the done flag to end this interaction."
-
- mvcSelection := item.
- done := true.
- !
Item was removed:
- Morph subclass: #MatrixTransformMorph
- instanceVariableNames: 'transform'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Balloon'!
-
- !MatrixTransformMorph commentStamp: '<historical>' prior: 0!
- MatrixTransformMorph is similar to TransformMorph but uses a MatrixTransform2x3 instead of a MorphicTransform. It is used by clients who want use the BalloonEngine for vector-based scaling instead of the standard WarpBlt pixel-based mechanism.!
Item was removed:
- ----- Method: MatrixTransformMorph>>addFlexShell (in category 'rotate scale and flex') -----
- addFlexShell
- "No flex shell necessary"
- self lastRotationDegrees: 0.0.!
Item was removed:
- ----- Method: MatrixTransformMorph>>asFlexOf: (in category 'initialize') -----
- asFlexOf: aMorph
- "Initialize me with position and bounds of aMorph,
- and with an offset that provides centered rotation."
- self addMorph: aMorph.
- self setRotationCenterFrom: aMorph center .
- self lastRotationDegrees: 0.0.
- self computeBounds!
Item was removed:
- ----- Method: MatrixTransformMorph>>balloonHelpTextForHandle: (in category 'halos and balloon help') -----
- balloonHelpTextForHandle: aHandle
- aHandle eventHandler firstMouseSelector == #changeRotationCenter:with:
- ifTrue:[^'set center of rotation'].
- ^super balloonHelpTextForHandle: aHandle!
Item was removed:
- ----- Method: MatrixTransformMorph>>boundsChangedFrom:to: (in category 'geometry') -----
- boundsChangedFrom: oldBounds to: newBounds
- oldBounds extent = newBounds extent ifFalse:[
- transform := transform composedWithGlobal:
- (MatrixTransform2x3 withOffset: oldBounds origin negated).
- transform := transform composedWithGlobal:
- (MatrixTransform2x3 withScale: newBounds extent / oldBounds extent).
- transform := transform composedWithGlobal:
- (MatrixTransform2x3 withOffset: newBounds origin).
- ].
- transform offset: transform offset + (newBounds origin - oldBounds origin)!
Item was removed:
- ----- Method: MatrixTransformMorph>>changeRotationCenter:with: (in category 'flexing') -----
- changeRotationCenter: evt with: rotHandle
- | pos |
- pos := evt cursorPoint.
- rotHandle referencePosition: pos.
- self referencePosition: pos.!
Item was removed:
- ----- Method: MatrixTransformMorph>>changed (in category 'updating') -----
- changed
- ^self invalidRect: (self fullBounds insetBy: -1)!
Item was removed:
- ----- Method: MatrixTransformMorph>>computeBounds (in category 'geometry') -----
- computeBounds
- | box |
- (submorphs isNil or:[submorphs isEmpty]) ifTrue:[^self].
- box := nil.
- submorphs do:[:m| | subBounds |
- subBounds := self transform localBoundsToGlobal: m bounds.
- box
- ifNil:[box := subBounds]
- ifNotNil:[box := box quickMerge: subBounds].
- ].
- box ifNil:[box := 0 at 0 corner: 20 at 20].
- fullBounds := bounds := box!
Item was removed:
- ----- Method: MatrixTransformMorph>>containsPoint: (in category 'geometry testing') -----
- containsPoint: aPoint
- self visible ifFalse:[^false].
- (bounds containsPoint: aPoint) ifFalse: [^ false].
- self hasSubmorphs
- ifTrue: [self submorphsDo:
- [:m | (m fullContainsPoint: (self transform globalPointToLocal: aPoint))
- ifTrue: [^ true]].
- ^ false]
- ifFalse: [^ true]!
Item was removed:
- ----- Method: MatrixTransformMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas!
Item was removed:
- ----- Method: MatrixTransformMorph>>drawSubmorphsOn: (in category 'drawing') -----
- drawSubmorphsOn: aCanvas
- aCanvas asBalloonCanvas transformBy: self transform
- during:[:myCanvas| super drawSubmorphsOn: myCanvas].!
Item was removed:
- ----- Method: MatrixTransformMorph>>extent: (in category 'geometry') -----
- extent: extent
- self handleBoundsChange:[super extent: extent]!
Item was removed:
- ----- Method: MatrixTransformMorph>>fullBounds (in category 'layout') -----
- fullBounds
-
- fullBounds ifNil:[
- fullBounds := self bounds.
- submorphs do:[:m| | subBounds |
- subBounds := (self transform localBoundsToGlobal: m fullBounds).
- fullBounds := fullBounds quickMerge: subBounds.
- ].
- ].
- ^fullBounds!
Item was removed:
- ----- Method: MatrixTransformMorph>>fullContainsPoint: (in category 'geometry testing') -----
- fullContainsPoint: aPoint
- | p |
- self visible ifFalse:[^false].
- (self fullBounds containsPoint: aPoint) ifFalse:[^false].
- (self containsPoint: aPoint) ifTrue:[^true].
- p := self transform globalPointToLocal: aPoint.
- submorphs do:[:m|
- (m fullContainsPoint: p) ifTrue:[^true].
- ].
- ^false!
Item was removed:
- ----- Method: MatrixTransformMorph>>handleBoundsChange: (in category 'geometry') -----
- handleBoundsChange: aBlock
- | oldBounds newBounds |
- oldBounds := bounds.
- aBlock value.
- newBounds := bounds.
- self boundsChangedFrom: oldBounds to: newBounds.!
Item was removed:
- ----- Method: MatrixTransformMorph>>hasNoScaleOrRotation (in category 'flexing') -----
- hasNoScaleOrRotation
- ^true!
Item was removed:
- ----- Method: MatrixTransformMorph>>heading (in category 'rotate scale and flex') -----
- heading
- "Return the receiver's heading (in eToy terms)"
- ^ self forwardDirection + self innerAngle!
Item was removed:
- ----- Method: MatrixTransformMorph>>heading: (in category 'rotate scale and flex') -----
- heading: newHeading
- "Set the receiver's heading (in eToy terms)"
- self rotateBy: ((newHeading - self forwardDirection) - self innerAngle).!
Item was removed:
- ----- Method: MatrixTransformMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
- transform := MatrixTransform2x3 identity!
Item was removed:
- ----- Method: MatrixTransformMorph>>innerAngle (in category 'flexing') -----
- innerAngle
- ^ (self transform a11 @ self transform a21) degrees!
Item was removed:
- ----- Method: MatrixTransformMorph>>invalidRect:from: (in category 'change reporting') -----
- invalidRect: rect from: aMorph
- aMorph == self
- ifTrue:[super invalidRect: rect from: self]
- ifFalse:[super invalidRect: (self transform localBoundsToGlobal: rect) from: aMorph].!
Item was removed:
- ----- Method: MatrixTransformMorph>>lastRotationDegrees (in category 'flexing') -----
- lastRotationDegrees
- ^(self valueOfProperty: #lastRotationDegrees) ifNil:[0.0].!
Item was removed:
- ----- Method: MatrixTransformMorph>>lastRotationDegrees: (in category 'flexing') -----
- lastRotationDegrees: deg
- deg = 0.0
- ifTrue:[self removeProperty: #lastRotationDegrees]
- ifFalse:[self setProperty: #lastRotationDegrees toValue: deg]!
Item was removed:
- ----- Method: MatrixTransformMorph>>privateFullMoveBy: (in category 'private') -----
- privateFullMoveBy: delta
- self privateMoveBy: delta.
- transform offset: transform offset + delta.!
Item was removed:
- ----- Method: MatrixTransformMorph>>removeFlexShell (in category 'flexing') -----
- removeFlexShell
- "Do nothing"!
Item was removed:
- ----- Method: MatrixTransformMorph>>rotateBy: (in category 'flexing') -----
- rotateBy: delta
- | pt m |
- delta = 0.0 ifTrue:[^self].
- self changed.
- pt := self transformFromWorld globalPointToLocal: self referencePosition.
- m := MatrixTransform2x3 withOffset: pt.
- m := m composedWithLocal: (MatrixTransform2x3 withAngle: delta).
- m := m composedWithLocal: (MatrixTransform2x3 withOffset: pt negated).
- self transform: (transform composedWithLocal: m).
- self changed.!
Item was removed:
- ----- Method: MatrixTransformMorph>>rotationCenter (in category 'rotate scale and flex') -----
- rotationCenter
- | pt |
- pt := self transform localPointToGlobal: super rotationCenter.
- ^pt - bounds origin / bounds extent asFloatPoint!
Item was removed:
- ----- Method: MatrixTransformMorph>>rotationCenter: (in category 'rotate scale and flex') -----
- rotationCenter: aPoint
- super rotationCenter: (self transform globalPointToLocal: bounds origin + (bounds extent * aPoint))!
Item was removed:
- ----- Method: MatrixTransformMorph>>rotationDegrees: (in category 'flexing') -----
- rotationDegrees: degrees
- | last delta |
- last := self lastRotationDegrees.
- delta := degrees - last.
- self rotateBy: delta.
- self lastRotationDegrees: degrees.!
Item was removed:
- ----- Method: MatrixTransformMorph>>setDirectionFrom: (in category 'rotate scale and flex') -----
- setDirectionFrom: aPoint
- | delta degrees |
- delta := (self transformFromWorld globalPointToLocal: aPoint) - super rotationCenter.
- degrees := delta degrees + 90.0.
- self forwardDirection: (degrees \\ 360) rounded.
- !
Item was removed:
- ----- Method: MatrixTransformMorph>>setRotationCenterFrom: (in category 'menus') -----
- setRotationCenterFrom: aPoint
-
- super setRotationCenterFrom: (self transformFromWorld localPointToGlobal: aPoint)
- !
Item was removed:
- ----- Method: MatrixTransformMorph>>transform (in category 'flexing') -----
- transform
- ^ transform ifNil: [MatrixTransform2x3 identity]!
Item was removed:
- ----- Method: MatrixTransformMorph>>transform: (in category 'accessing') -----
- transform: aMatrixTransform
- transform := aMatrixTransform.
- self computeBounds.!
Item was removed:
- ----- Method: MatrixTransformMorph>>transformFrom: (in category 'event handling') -----
- transformFrom: uberMorph
- (owner isNil or:[self == uberMorph]) ifTrue:[^self transform].
- ^(owner transformFrom: uberMorph) asMatrixTransform2x3 composedWithLocal: self transform!
Item was removed:
- ----- Method: MatrixTransformMorph>>transformedBy: (in category 'geometry') -----
- transformedBy: aTransform
- self transform: (self transform composedWithGlobal: aTransform).!
Item was removed:
- ----- Method: MatrixTransformMorph>>visible: (in category 'drawing') -----
- visible: aBoolean
- "set the 'visible' attribute of the receiver to aBoolean"
- extension ifNil: [aBoolean ifTrue: [^ self]].
- self assureExtension visible: aBoolean!
Item was removed:
- Object subclass: #MenuIcons
- instanceVariableNames: ''
- classVariableNames: 'Icons TranslatedIcons TranslationLocale'
- poolDictionaries: ''
- category: 'Morphic-Menus'!
-
- !MenuIcons commentStamp: 'sd 11/9/2003 14:09' prior: 0!
- I represent a registry for icons. You can see the icons I contain using the following script:
-
- | dict methods |
- dict := Dictionary new.
- methods := MenuIcons class selectors select: [:each | '*Icon' match: each asString].
- methods do: [:each | dict at: each put: (MenuIcons perform: each)].
- GraphicalDictionaryMenu openOn: dict withLabel: 'MenuIcons'!
Item was removed:
- ----- Method: MenuIcons class>>base64ContentsOfFileNamed: (in category 'icons creation') -----
- base64ContentsOfFileNamed: aString
- "Private - convenient method"
-
- | file base64Contents |
- file := FileStream readOnlyFileNamed: aString.
- base64Contents := (Base64MimeConverter mimeEncode: file binary) contents.
- file close.
- ^ base64Contents!
Item was removed:
- ----- Method: MenuIcons class>>blankIcon (in category 'accessing - icons') -----
- blankIcon
- ^self blankIconOfWidth: 16.
- !
Item was removed:
- ----- Method: MenuIcons class>>blankIconOfWidth: (in category 'accessing - icons') -----
- blankIconOfWidth: aNumber
- ^ Icons
- at: ('blankIcon-' , aNumber asString) asSymbol
- ifAbsentPut: [Form extent: aNumber @ aNumber depth:8]!
Item was removed:
- ----- Method: MenuIcons class>>checkBoxOff (in category 'accessing - icons') -----
- checkBoxOff
-
- ^ Icons
- at: #'checkBoxOff'
- ifAbsentPut:[ (Form
- extent: 12 at 12
- depth: 32
- fromArray: #( 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295)
- offset: 0 at 0) ].!
Item was removed:
- ----- Method: MenuIcons class>>checkBoxOn (in category 'accessing - icons') -----
- checkBoxOn
-
- ^ Icons
- at: #'checkBoxOn'
- ifAbsentPut:[ (Form
- extent: 12 at 12
- depth: 32
- fromArray: #( 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 4294967295 4294967295 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 4294967295 4294967295 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 4294967295 4294967295 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 4294967295 4294967295 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 4294967295 4294967295 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 429496
7295 4294967295 4294967295)
- offset: 0 at 0) ].!
Item was removed:
- ----- Method: MenuIcons class>>checkBoxPressed (in category 'accessing - icons') -----
- checkBoxPressed
-
- ^ Icons
- at: #'checkBoxPressed'
- ifAbsentPut:[ (Form
- extent: 12 at 12
- depth: 32
- fromArray: #( 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 4294967295 4294967295 0 0 4294967295 0 0 0 0 4294967295 0 0 4294967295 4294967295 0 0 4294967295 0 0 0 0 4294967295 0 0 4294967295 4294967295 0 0 4294967295 0 0 0 0 4294967295 0 0 4294967295 4294967295 0 0 4294967295 0 0 0 0 4294967295 0 0 4294967295 4294967295 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295)
- offset: 0 at 0) ].!
Item was removed:
- ----- Method: MenuIcons class>>cleanUp: (in category 'class initialization') -----
- cleanUp: aggressive
-
- aggressive ifTrue: [self initializeIcons].!
Item was removed:
- ----- Method: MenuIcons class>>configurationIcon (in category 'accessing - icons') -----
- configurationIcon
- "Private - Generated method"
- ^ Icons
- at: #'configuration'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self configurationIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>configurationIconContents (in category 'private - icons') -----
- configurationIconContents
- "Private - Method generated with the content of the file /home/dgd/configuration.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABwAAAAcCAYAAAByDd+UAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAAF30lEQVRIia2WfWyV1R3HP8/L7X3p09tCZRWx
- oE2x4Es2CIMmjiVjtKSQ4R9ONzbrtgQMakI3EoWiA3QMssTF1U2zGhZsQ5buzQmdZJszULAd
- ULTUYPClaKm7VLkwS2/v6/M897c/zn3u7a2VSNwvObnnOfec8znf3/n9zjkGn99M4HFgF3Az
- oAGjgHMNc3xuuw04BciSJV+TjRs3S3X1TQKkgCPADuDrgP+LggxgC5AKBkvl2Wd/Lx9/nJHh
- 4bScPBmX/ftPyKZNe6S29naxrLAASeBVlCfuBHxTJzSvArsF6ADqGxvvoq3teSorZxKNOsRi
- 2XyngwdfYHj4HebOnc+OHXsDn3wSXXH6dO+KgYFeRkfPJ4Be4HCunNSmAWlAC7C7oqIy2NTU
- SFNTE5HIKAMDQyxYsJRly77JkSMHaGtrJZNJsWrVvWzd+muCQatoov7+wzz66HdIJuNe0+yp
- sBqgB5CHH26V4eGYjIyMyd69f5HFi5eLrusC5IthmLJu3SY5evSyHD8eLypbtjwjgUBI0HVB
- 17wx+RVpwIPAxMKFX5aenrckGrXlwoWMDAwk8pM89dSfJByeIYBoWn4S8fuDUl+/Ulpa9kh7
- +yuyfPka9V+FJTz3YyHoFyCb4xACXgGkrKxcurr+JZFIQs6dS8uJEwrU1zcu69c/JrpuCCBr
- 1nxfDh36QHbt6pCGhnskFLImwQOqfus84W97hFPtgmkIEPOUVQEfTfZrIBCkrm4R9fUrqav7
- Cp2dv+T06V6CwVIeeeRXrF79vaJ9iMfH2blzA6+99jIiApVh6N4DJSaIwFc3kmPMNoE4QMua
- Ju667VYOHj/Bb4/1ZgcH+/TBwT7lb03Dssppbt7M0qUrimBDQ2fYvv2HvP/+WQUwDLCCqg5g
- u17XmFfRAfnp3XeL+9KL4rzwOxm7eY50z75O7ijxSVlhw/OltvZ2aW7+iWzY8Lj4fH7VXjVD
- 6GwVZlUIc65TrjzVLvxxhzfuDVB5mDUgk3adEoU3CGgaDcEAu/VxYlnhyZnllOkaf0+k6Emm
- ZWjojDY0dKYgc+kC2L0BKizwmeDkVP2zH36+v0ihCWBoWqoA1PPzOKJ+bzIN7rVCPBi2SIlo
- R5Np9sXi/DWeVLDftBTGlZgwnoYnOqC7b7L3Jzx3YkIqbefOYKMA9LxfOmkRAU2jMRRgnRVS
- DZXlRYskm4WxuIKV+GDj2iKFCqiRito2H7kuohsFoCiJljbdgeR1yh1zItD5D/gwqqC1c2D/
- NmhYUqRQuRQtOWE7HE6m0W2bnktj3GMFsfMKrwZ04dIV2L4PTp7NecmAzlalcCjyaYUGJH2u
- y1zTIKvrtI9PsPJClHczCnnOdpDPAl4cg+8+qWAVFtRVq+wuyV0Umfx1WdhDQ9OStuNwZ8DP
- t8MWe2fNZGUwkL9Zf3Dxv9wyMkrr5Su8ns4UA8+eh7EJWLYQurbDl2YUohTAyQMnRynJtKs6
- +TSN+8Kl3FcWYv7IKB86Lov8JQykMzx9JcbTV2LU+EwWewqCfvhREzQ3gKaptAC1t4YO/e8U
- KTRzMhMpZ9JLQTfALbjxyA2ziDguXRMJuiYSvGs7DHtRPf9GuL+xMNY7YVIZaPszvHgM1FPk
- aN6lpqYnku5koAoSR8DUwK9p1PhMts0I82b19fx7ThWrQwHVd2o8ecBNz3iwY8Bi4EweGHfd
- 6AfnR2g/cIALkUg+r1wES9OZaov8Pu4vK1Uf2SnhlEhDuBQGzwG0ASuYdDmYANFstoPx8ZqH
- 9nWsemhfh77AZ9oPhC2fLRC6WkqASgvPXn0Djr0JaTsOrAe6pnb3lt8PrEY9/372tu1c3Hx5
- jJhINpkV6U2lPxvoZFXSt3fD1uchbb8H1E8Hu5oZwFrgZdQJJ/NMI/GLynKJzLtBUjU3yh+q
- Kl1AmFclfGORdyO8BJRfC2g6qwaeAP4DiAHO2lAwvrm8zKZwZbnANj4dQl/IDOBbQDfqte3B
- LgEN/0/QdFYN7AQOAXOvZeD/AIXZmm50KVY/AAAAAElFTkSuQmCC'!
Item was removed:
- ----- Method: MenuIcons class>>confirmIcon (in category 'accessing - icons') -----
- confirmIcon
- "Private - Generated method"
- ^ Icons
- at: #'confirm'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self confirmIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>confirmIconContents (in category 'private - icons') -----
- confirmIconContents
- "Private - Method generated with the content of the file /home/dgd/confirm.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABwAAAAcCAYAAAByDd+UAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAACsElEQVR4nK3WvW8URxjH8c+CDxtsYg6FCJDy
- IqUIWKAUiCJFWuiRIqWCKn9AynRJnS4VShEpEimSBlGkiKBAGIkUWIoUBVtC4IvBb2BsH8fd
- +fD5NsWM7VO43bXPPNJoZnafme/MPL95oT8r4RCS3TbcTYNSibEynw1xusXiKyp1FvAQT5G+
- LeB7H/HdCFdwcLNRStri1gK/1HiMP7G+V+ChT7hd4vwRXMB+vIxpEs+pzvB1jakIzZzp/iLa
- x3w/yKWL+DECP8cpLGEULxgqcXaZ8ZR6HEtfwOQkv51h8CqGun68E6ETgoJmKadM1HkmxLWn
- 7cujneCDhMNfZjiOYgzlWB/mUxzO6zMXOBpjfDTHp2xbJSlN1PoGTlFJmZ3K8XmCf2O5yTRW
- +gZCm2s/d3XabY9wM+YbTC5yL8N1ywpVWma8zRe/8+5BDGAef+BbVNBhvca948yfYOFZUGpP
- y9uH+87yVco3+HDT+f8bLMVGHHmCOpenuY5XvTodyKKdY6jF1UFB/idj5yuCKgZwTDhQ4Q5W
- 6cyyJgh4d8AJmmfwPq5FWBXLoWO1MBt/xe8v0WH6dVBqT1guMDLW2nG/JzgSU7fD/TjrFOs8
- iMVMYJFKmxs5P+eF9VuO9Qb/hExms1xgQrOd839T/5vAaphh/xs/pZEHnLMtpA7z9VDMXM5C
- oIIZLgliaduKH3uZIZpZt2kqXAkvYr0V4rdnYCMr+nMBshW/2g4UWghMc5Z0OubLwa+6wqyg
- 0E7fwDyVzgkbv4X2DpezEIhGqveQl2zHb22HgikEJuGYeuMZ1hH24GSoNle3H06LewLGG/yN
- Y+MJxvEaq/xQDaC/QzXf8s5SKc0ElzCIAzE1hLVb48ZT7goamimC7QT4K2Yq4VkzkjDSYThh
- uEO7wk/CZfEgr59u+w8LnvWEFNR9UgAAAABJRU5ErkJggg=='!
Item was removed:
- ----- Method: MenuIcons class>>createIconMethodsFromDirectory: (in category 'icons creation') -----
- createIconMethodsFromDirectory: directory
- "
- Preferences disable: #showWorldMainDockingBar.
- MenuIcons createIconMethodsFromDirectory: '/home/dgd/'.
- Preferences enable: #showWorldMainDockingBar.
- "
- | iconContentsSourceTemplate iconSourceTemplate normalSize smallSize |
- iconContentsSourceTemplate := '{1}IconContents
- "Private - Method generated with the content of the file {2}"
- ^ ''{3}'''.
- iconSourceTemplate := '{1}Icon
- "Private - Generated method"
- ^ Icons
- at: #''{1}''
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self {1}IconContents readStream) ].'.
- ""
- normalSize := #('back' 'configuration' 'confirm' 'forward' 'fullScreen' 'help' 'home' 'jump' 'objectCatalog' 'objects' 'paint' 'project' 'publish' 'squeak' 'volume' 'window' 'open' 'loadProject' ).
- smallSize := #('smallExport' 'smallAuthoringTools' 'smallDebug' 'smallBack' 'smallCancel' 'smallConfiguration' 'smallCopy' 'smallCut' 'smallDelete' 'smallDoIt' 'smallExpert' 'smallFind' 'smallForward' 'smallFullScreen' 'smallHelp' 'smallHome' 'smallInspectIt' 'smallJump' 'smallLanguage' 'smallNew' 'smallObjectCatalog' 'smallObjects' 'smallOk' 'smallOpen' 'smallPaint' 'smallPaste' 'smallPrint' 'smallProject' 'smallPublish' 'smallQuit' 'smallRedo' 'smallRemoteOpen' 'smallSave' 'smallSaveAs' 'smallSelect' 'smallSqueak' 'smallUndo' 'smallUpdate' 'smallVolume' 'smallWindow' 'smallLeftFlush' 'smallCentered' 'smallJustified' 'smallRightFlush' 'smallFonts' 'smallLoadProject' ).
- normalSize , smallSize
- do: [:each |
- | png base64 contentsSelector selector |
- png := directory , each , '.png'.
- base64 := self base64ContentsOfFileNamed: png.
- ""
- contentsSelector := (each , 'IconContents') asSymbol.
- ((self respondsTo: contentsSelector)
- and: [(self perform: contentsSelector)
- = base64])
- ifFalse: [| contentsSource |
- contentsSource := iconContentsSourceTemplate format: {each. png. base64}.
- self class compile: contentsSource classified: 'private - icons'].
- ""
- selector := (each , 'Icon') asSymbol.
- (self respondsTo: selector)
- ifFalse: [| source |
- source := iconSourceTemplate format: {each}.
- self class compile: source classified: 'private - icons']].
- ""
- self initializeIcons!
Item was removed:
- ----- Method: MenuIcons class>>decorateMenu: (in category 'menu decoration') -----
- decorateMenu: aMenu
- "decorate aMenu with icons"
-
- | maxWidth |
-
- Preferences menuWithIcons ifFalse: [^ self].
- Preferences tinyDisplay ifTrue:[^ self].
-
- maxWidth := 0.
-
- aMenu items do: [:item |
- item icon isNil ifTrue: [
- | icon |
- icon := self iconForMenuItem: item.
- icon isNil ifFalse: [
- item icon: icon.
- maxWidth := maxWidth max: item icon width.
- ]
- ]
- ifFalse: [
- maxWidth := maxWidth max: item icon width
- ].
-
- item hasSubMenu ifTrue: [
- self decorateMenu: item subMenu.
- ].
- ].
-
- maxWidth isZero ifFalse: [
- self flag: #hacky. "mt: That manual icon scaling is not optimal..."
- aMenu addBlankIconsIfNecessary: (self blankIconOfWidth: (
- "Avoid duplicate scaling because the actual menu icons are already scaled at this point."
- RealEstateAgent scaleFactor > 1.0
- ifTrue: [RealEstateAgent defaultIconExtent x]
- ifFalse: [maxWidth]))].
- !
Item was removed:
- ----- Method: MenuIcons class>>exportAllIconsAsGif (in category 'import/export') -----
- exportAllIconsAsGif
- "self exportAllIconsAsGif"
-
- | sels |
- sels := self class selectors select: [:each | '*Icon' match: each asString].
- sels do: [:each | self exportIcon: (MenuIcons perform: each) asGifNamed: each asString].
- !
Item was removed:
- ----- Method: MenuIcons class>>exportAllIconsAsPNG (in category 'import/export') -----
- exportAllIconsAsPNG
- "self exportAllIconsAsPNG"
-
- | sels |
- sels := self class selectors select: [:each | '*Icon' match: each asString].
- sels do: [:each | self exportIcon: (MenuIcons perform: each) asPNGNamed: each asString].
- !
Item was removed:
- ----- Method: MenuIcons class>>exportIcon:asGifNamed: (in category 'import/export') -----
- exportIcon: image asGifNamed: aString
- "self exportIcon: self newIcon asGifNamed: 'newIcon'"
-
- | writer |
- writer := GIFReadWriter on: (FileStream newFileNamed: aString, '.gif').
- [ writer nextPutImage: image]
- ensure: [writer close]!
Item was removed:
- ----- Method: MenuIcons class>>exportIcon:asPNGNamed: (in category 'import/export') -----
- exportIcon: image asPNGNamed: aString
- "self exportIcon: self newIcon asPNGNamed: 'newIcon'"
-
- | writer |
- writer := PNGReadWriter on: (FileStream newFileNamed: aString, '.png').
- [ writer nextPutImage: image]
- ensure: [writer close]!
Item was removed:
- ----- Method: MenuIcons class>>fugueBroomIcon (in category 'accessing - icons') -----
- fugueBroomIcon
-
- ^ Icons
- at: #broom
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self fugueBroomIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>fugueBroomIconContents (in category 'private - icons') -----
- fugueBroomIconContents
- "Fugue Icons
- (C) 2013 Yusuke Kamiyamane. All rights reserved.
-
- These icons are licensed under a Creative Commons
- Attribution 3.0 License.
- <http://creativecommons.org/licenses/by/3.0/>"
-
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAGXRFWHRTb2Z0d2FyZQBBZG9i
- ZSBJbWFnZVJlYWR5ccllPAAAAoNJREFUeNqkU11Ik1EYfo6bm7WZW2r+MDNTZ9ZQcbYws0iN
- piZEBF4UXWgXCXURXQQiBTYhgi4qRo0y+gEpNImauKVkhkzDNrxoCjrNZSSapnNLv+n2nc5H
- GmFJgQcezuGc93nPc877vIRSivUMYqwkEFIIeQQQsnzA5rP1FEe0BKXZP894Bm6AQiKGPsjD
- sLSEmpD/uCSX8e4JYOv9LJF+noNhb/ExrW8BBvE/yClmO824YbpaKUgwG6sjvy8gQVdwQNv4
- qNkeCK6tQMHiz7H5kMs1fKe1Rw7/xARKTl8+Gq4hX5496bR/nkINz8MiKAhliGCIYohjRF2Y
- LCJnW2ZelrM8I6mlxYzCQj1arX4cTBzC4ZMXyhYD11soD074E3KrglwJkyl3S2WbZBvCI8Oj
- E1JjlDGqqCXvojjg4bB5ZwKaO0NRUFAKq/U5CpOGIRKJYG2638AuOxHCZLT5PDP+NF3Jvvhk
- bSY3y8eOdA+IvV9nsFGlxLf+MZRle2E2NyI/vxQvnXGYc88hEABhgEifSdw2O521dfSmyyji
- ZRFyxKSqIGK1Gu8bgTI5FgEfh3TFPBra+6BW70H5+dqGvBTUs2d8XKmCJVtDFqanHRd35GqK
- hxz9EFMRtmakwDc1C8oFoUjcglO7PNCdKW9i8beZ/C7BMr+qwDY6+/rpTeO1h3ZFlAJJOWqM
- D36CZ3IG0mg5Jj+48fjp3bdV+dTEwrtWeKt9YEnbTvy21y+q1ercIp59UHJWGsYcQ7B0tHUz
- 99WFSdH+O+EPIzElHa5RKnWN2pQVVce1gz1OvHn3vpcPolYiwavV8Ws50SKVgD4wNdUt98il
- EALLX5tp3d243gQ/BBgABJ4L2+7frOgAAAAASUVORK5CYII='!
Item was removed:
- ----- Method: MenuIcons class>>fugueDocumentClockIcon (in category 'accessing - icons') -----
- fugueDocumentClockIcon
-
- ^ Icons
- at: #documentClock
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self fugueDocumentClockIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>fugueDocumentClockIconContents (in category 'private - icons') -----
- fugueDocumentClockIconContents
- "Fugue Icons
- (C) 2013 Yusuke Kamiyamane. All rights reserved.
-
- These icons are licensed under a Creative Commons
- Attribution 3.0 License.
- <http://creativecommons.org/licenses/by/3.0/>"
-
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAGXRFWHRTb2Z0d2FyZQBBZG9i
- ZSBJbWFnZVJlYWR5ccllPAAAAhNJREFUeNqMU11LG1EQPbvZfEgaSKKBtFX71BcFjT8hCb4I
- Pjb1qc/9F4og9AcU6rPgk9KCb0Uw0D9gCsWAaSJBoSSp+Wg2rbp3d3vuDZtuWS0dmL3DvTNn
- 5szMaq7rQkppa2udx2P8W04cx/nq2Dbe7+yoC8N74cOTvc3N3Ts+WlIdBzbBvQSVSgV7x8ev
- aWrUmhenTwBsW3NkkGUpvbu5wa/RCKZpYjgcqvNwe3uXfkW6Pw8A2ASQ0Dq/4VAIsXAYEcOA
- oevQeNftdvF2fx+FhYV3X05PX3pxhq8CXQbrCgYKZCJCoFAoKDqJRAIfK5VeAEDICnwA94EI
- UvR8AwC2EBMKI3Kv1+vo9/sqa5xZs3NzMCIRRUf6BnsghKLwk8Gf2XGX/KdiMSytrMCIRlE7
- O4O4vUVoDKAHAAQv1XzOzxFlxqlkEh8ODtBh9+PpNBKpFK4uLhQt8QCA6sH3TgdxBs8yqNVq
- 4dnMDJ4yODk9jd71NcKcivBR+NMDy1IVWNwBnU5S2+02Xm1sIJvNYnVtTS7bmAJ9g1OQFPiY
- YrYfrMLNZHB4dDQeMRtZrVZhDgZqDR+mwDOXy+Fbs4lGrSabpVTazUYDS8vLakr3UuDaKjvN
- ClaLRZTLZXyiSpmdn0c+n1dvms/3L4BBrxf17AzLf1EqqR2Qv5J3Sioae+P3nQCMTPPy0eLi
- G/yHEOTSs38LMADvCBAJ/QIAlQAAAABJRU5ErkJggg=='!
Item was removed:
- ----- Method: MenuIcons class>>fugueUserSilhouetteQuestionIcon (in category 'accessing - icons') -----
- fugueUserSilhouetteQuestionIcon
-
- ^ Icons
- at: #userSilhouetteQuestion
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self fugueUserSilhouetteQuestionIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>fugueUserSilhouetteQuestionIconContents (in category 'private - icons') -----
- fugueUserSilhouetteQuestionIconContents
- "Fugue Icons
- (C) 2013 Yusuke Kamiyamane. All rights reserved.
-
- These icons are licensed under a Creative Commons
- Attribution 3.0 License.
- <http://creativecommons.org/licenses/by/3.0/>"
-
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAAGXRFWHRTb2Z0d2FyZQBBZG9i
- ZSBJbWFnZVJlYWR5ccllPAAAAgBJREFUeNqkk7+LGlEQx2f9rXiLvwhYHYQENaRJ4RJFsFMQ
- bLQOBCRFSBGLtJciYJc21wRsUqS7v0IRlSNFjjt/d6IJaKEXFV1v853H3rHZmKTIwIfdN+87
- s/PmzUqappEkSWSyJ+AFeKSvL8FH8MUoErEHEqQ8Hs/7eDz+MBwOy+yYTCaLdrvdX61Wb7Cs
- GRNY6Hd7qShKLBQKBfb7vU1VVVswGAwgYYz3zGJzgjiI+ny+o+12S8xutxP4/f4j3tM1v57D
- YF/x9etsNqvN5/M7arWalslkNN5jjTHWZqrgHNy3WCxUqVREb5LJJKVSKYpEItRsNiVd88cj
- PG+1Wg0EqqPRiIbDIS0WC5pOpzSbzVTeY83fErCd9nq9Gb9Eo1FKp9NUrVb56+w7/VcT2c4G
- g8G13W6nUqlEnU6HxuMxV8PnPzOLbQfWr4CVF+VyWfTB7XaT7nsNPgD10C0o4DPoF4tFLZ/P
- axggrV6vi/dCocDCvq5RzLfwDNP3DpMXQLfl9XpNVquVcBTCNQoB+3K53INut3sPiZ9iKt/C
- /el2lC8SiUQM12dxOByiZH4ul0sR7PV6xVBtNhsxVJjQm0ajcYXYx7cVHLtcLo4np9MpEvBT
- lmVRJsZZVMT9YA183PxjYw9OwA34Ab6BoT5x5zoXYAS+6xrWntz9jf9jPwUYAKt/9B8pRO/y
- AAAAAElFTkSuQmCC'!
Item was removed:
- ----- Method: MenuIcons class>>fullScreenIcon (in category 'accessing - icons') -----
- fullScreenIcon
- "Private - Generated method"
- ^ Icons
- at: #'fullScreen'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self fullScreenIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>fullScreenIconContents (in category 'private - icons') -----
- fullScreenIconContents
- "Private - Method generated with the content of the file /home/dgd/fullScreen.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABwAAAAcCAYAAAByDd+UAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAAHT0lEQVR4nL2WW2xc1RWGv7X3OWcutmfGYzuO
- 7TjBSYAAgaSQEGhRQVwU2pAgFQFC6iuKhBAvCEWVKtWPBCpVquhTq6pUBURFaVrUBmQuBRWh
- FJELhIRQGi42SUx8HY9n5lz2Xn3whAZIipCq/tJ6Odr7/Gv9/1rrHPg/QwAeffTRjjiOK2EY
- DotIRURKqpoXEauqAnhVTY0xdWDBWnu6VqtNDwwMzO3cubPxjQl37959jYgMqepaEbFAoKoB
- gIio9x5jjPPeZyLi2nc90BSRaRE5HgTBJ0NDQ5/ddddd7jxcS4SqKo888siNwJWLycJlx04e
- Gwisdb1dy+qD5aHaOe54EUmApqo2gWb7WR2Ycs69H4bh+IMPPjgtIvoVwtHR0c5CoXCtiNzw
- i5d+dm881Ojr7a8yO1UjPpGkF5cueXfHxjve+i9Je2BBROZVNRYRFZF559wnxpj3G43Gx6Oj
- o9mZw0GxWOxUVUSkM+5Y7Or+XoH+rirbe2/jqZeeCGtvLHSpqpwr2zYMUFbVsoi0VLWmqlZE
- Kt77Ffl8/pOHH374aKvVmhgdHfV269atPara49VveKPx2tW5FYEsmjrHakeodvTw8ZsnuoYr
- K5NKoWKNMREQyBL8OcgDoAOoiogXESMi/UC/MaZz27ZtdeO9j1Q1yLIs1EwlmcmIT6YkpzOG
- +4e5+d7vhs8cfHLTqfmTZVUtAmWgV1UHgG4RyZ2n6hFVXd2uvt8YU0qSZMCISM5amw+D0LmT
- mrp5pX4gxtU9B47up2ugg0t/uDb688Fn13/B/CUUgV6gH+g821fv/SKwQlU3GGM6RMSGYRgY
- wKhqBPCt5VcfKr7ZM71Fr383edU2XcPzyqEXef/Nf1LMdcTn6xoRCUSkDPS1ZeWM5+1ZVmOM
- zbIsDEQkExHnnOOWy249JiKzgLtk4NLTT4z9dlO9Wu8sz/fMb99y+wdf0zyISNSWcPosUmlX
- bAETiEjmvY/PyOS9t8YY19PVl+y84f53Do0fWL6sUk7+Mbb34oWFhTBpNUwaxzZzqc3li3Gx
- q9LsKlUa1d7l9eGRi2a7q1WstYalcfFtBTMRSVQ1DpxzznufGGMUEGst7S3TlQ/zZsvqa6de
- fO6pVdtv/0Hf+g1XUSqXKZe76SpXSOJW/sg7B8uH336LI+8c5KU//cZJWJwdXHXhB+vWX3m8
- r6/PAUZEUlVNRaQVGGMyVfUiknrvRUQCIC8ickaq2uxMfscd97BqZO1XZBwcWsH1N99ClrZo
- LNbs88/t6X3290/27vndYxuGRi45ccWm644PDg6qiGTW2iVC5xze+xRw3vvIGCNnv7RWm8n3
- 9Q9w9MPj7NULmM1gLhGqkbImDyM5ZV2UYa1h623f56Zbb+bQ/v2Fpx5/fM3zz/xqsG/4osb6
- jVuOr1y5shUkSVJvF7MgIqW21h1nBjtLU2NEomKxgw/mG7yRNVAEr8J4Aw4AXkNypsymYsh1
- +ZTVEVy+cSOfjo9z9z33FH6068cXnTq1qjIyMtIyu3btqgGZiEyqqvPeN9udBUCzUbd9y5YD
- ME9AybQoSYuyaVK2TUrSomSaRMQcXLT8fHoZT8/3YIzBWkso4FwWJEkSdnd3N4yIaBAEc977
- yXanTra7C4B8scOlSQJAqhkV02J1IeXb3cKNvYZ1nY6KbS0lYmLKJuZwK2QqCwijCO8VkCRN
- 08WdO3emAYCqzojIbHv5ApwClouIhmHkp6dOKyCha7CuXGKgaFCWPnvdXYLxGXNJhkeWQoXx
- 1BJFEUmWoiIzaZqehqWdRxRFp9pj8VG7sEkR+UhVW6qKima1+TlK1jFUAPExxrcQHyMas6YI
- ZRt/HhUbY8URBJZms4W10Wwcx5OfEz7wwAOxc+6kiBwTkRpLq2FeVY+r6qedpe7Fo4cP0dmc
- J/ANAhpYbbajQZdNWNMB3bZJ5Yy3JiOwAfX6AibM1SYmJv5DCLBr164jwIfe+1eNMVPttZQB
- 05Vq3/hf9jzNhYOriHydnG8Q0SDSBpFvEmqTauC4oGDpC5d8rlrFinDi0xNokD8+MTEx9QVC
- EdGHHnrosLX2befcq8BhVa0DfsXKtSde+Oseunv6qMYtCtKgSJMiDQrSIM8ieRbpNC0GcsoF
- BaFkhcZinddff33OefMeEAPYL2+OsbGxuR07dow75+aBmjGmWe1bPntg32vrioV85zVbvkNO
- Hfg6VhIio0TiyIknMo7IOMoIeQIO79/P3hdePjgxOffrNE0nz0kIsHfvXjc2NvbZnXfe+a8s
- y8aByeUrVr33xC8f2/jZqROl9euvoJwrk8cQkpLDEZKRQ8mrUJQ8Rw6+zcz0FH/7+74/TM0u
- 7gUWOXvAvw6qKvfdd19l38t/vDdNWvevv+Ly4as2b+bKzZsZWbuWIAi+cH7fKy+ze/dPpw4c
- PXl3Bq8A+o0Iv4w1VYadsk1FthuRS8uVSndPb09XoVg0C7V5NzMzMz0xWfvJbIMngXP9bv5v
- 0N9PB+exCuDf3d6HA+fU4WgAAAAASUVORK5CYII='!
Item was removed:
- ----- Method: MenuIcons class>>fullscreenWireframeIcon (in category 'accessing - icons') -----
- fullscreenWireframeIcon
- "(c) 2016, Plainicon on www.flaticon.com
- http://www.flaticon.com/free-icon/square-frame_79288
- CC 3.0 BY http://creativecommons.org/licenses/by/3.0/"
-
- ^ Icons
- at: #fullscreenWireframeIcon
- ifAbsentPut: [ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 1543503871 2583691263 2583691263 2583691263 2583691263 2583691263 2583691263 2583691263 2583691263 2583691263 2583691263 2583691263 2583691263 2583691263 2583691263 1543503871 2298478591 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2298478591 2298478591 0 3254779903 2298478591 2281701375 285212671 0 0 0 0 301989887 2281701375 2298478591 3254779903 0 2298478591 2298478591 0 2298478591 0 0 0 0 0 0 0 0 0 0 2298478591 0 2298478591 2298478591 0 2298478591 0 0 0 0 0 0 0 0 0 0 2298478591 0 2298478591 2298478591 0 251658239 0 0 0 0 0 0 0 0 0 0 251658239 0 2298478591 2298478591 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2298478591 2298478591 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2298478591 2298478591 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2298478591 2298478591 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2298478591 2298478591 0 251658239 0 0 0 0 0 0 0 0 0 0 251658239 0 2298478591 2298478591 0 2298478591 0 0 0 0 0 0 0 0 0 0 2298478591 0 2298478591 2298478591 0 2298478591 0 0 0 0 0 0 0 0 0 0 2298478591 0 2298478591 2298478591 0 3288334335 2298478
591 2281701375 285212671 0 0 0 0 301989887 2281701375 2298478591 3288334335 0 2298478591 2298478591 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2298478591 1476395007 2583691263 2583691263 2583691263 2583691263 2583691263 2583691263 2583691263 2583691263 2583691263 2583691263 2583691263 2583691263 2583691263 2583691263 1459617791)
- offset: 0 at 0) ]!
Item was removed:
- ----- Method: MenuIcons class>>homeIcon (in category 'accessing - icons') -----
- homeIcon
- "Private - Generated method"
- ^ Icons
- at: #'home'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self homeIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>homeIconContents (in category 'private - icons') -----
- homeIconContents
- "Private - Method generated with the content of the file /home/dgd/home.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABwAAAAcCAYAAAByDd+UAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAAHDklEQVRIic2WbXBUZxXHf8+9d1+y2WR3w5IQ
- SOgmgIA2VECgUJuGIoJBapkBHKY6dFp1BMEPLVosY+WLWh2ZdkoHLP3QocN0SkY7CoJFQEBB
- MLwk2YQEAqFJCCSbl33Nbu7u3nsfP2xgEiq+fHE8M3eemfuce35z7v885zzwPzbxsI1HYYkC
- 6wQEHuYjwQLSAtLW6Cqg14IOC05ehfC/Bc4HTwbeE7Bm8ee8uPJUslmLWNKgO6RT7LOjCEHG
- sMhmLSLDBqoqyBqSrGFhGBY+n4OhcLpThZoG6HoocDo4XHAemLtlfRnLljoBOFOf4PSFBC+s
- 81NeagfAtCRvv9+Pv0jjuWcmAJCIw6kGky8vr+BA3U2OHOs+G4SnyP2JTwPnwB5FsKmsxElh
- YW4rPmwSiZmUl9pRVXA5FfKcKh3dOjMCTtau9FHitxEJQ0OXytLqcgAsS/LTXzUQbAl/vQnq
- PgWsyulVt3XtFJYs1kBA6w2dQ6fibHuxGLsmkEBs2OSN9waonGpngkfjdl+W3v4sNdVlLF8W
- IJHI0tA8SPWSUrpuD/PyjgvNQXgsJzmo93Sz4M/Vs73OpxcqpFMG8WiWd34TYdMaD4phkU4Z
- ZEYMDh6NUTXNwYpFLipKbVRVOshKN6u+Oh3TlPxsVyMNwRA1T5bhn+Ck45N4iexLBUPQBqAB
- ZGFjoUPzLJupMPiJjlDgj006Cx+xkerLMCJACOgImYQHs6z4rJ1wt45QBNe7HSxfOw2Affuv
- 8Y0NGn6/jyPHuln7tQrWrA5wuXHwVeCj+0Bg02xPHof/GiOckSQNiGUkPb2Ci606Tk3gcQja
- Iya10+z0XdNRhECKPMqeKiXfpfHxidt4vElWLYphCgfbXxuidnk5s2Z4CUwtmG91J+a0QFCt
- gmqHovygRDfJT1lMzUAoK5mHoCIDJRko0CVtCQu3KegeMLh0x6DxTpZsgZvVayrouZPk98fa
- eXNHFgUj97j9NDalmT3TSzJl0Hw1PNIPf1IUqHmsoICAaVI8mq4OFI0KbBtdDWABsABBDYKV
- Ph/rnp+BaUrefreFva87UaV+v+KfXZbl+KkepJQ8sagEAc/VgKZImFeuafcdO4GAGN8P2qVk
- +gPvqCqkdJKLgx918PL38/Fo45tKoRahqsrOlaYhiifmMb2ysCQM1RpgNo6M4Ha7MaUkbhio
- isKglChAkc2GzGYpcblQAJtpYikKj68u42pbBKnGWDIrAVIZe74B2PxCHj/f1cP8z/t54vFJ
- 3LgV/4IGtN1KpQCsr6z0KN/eYCORFETjkqGIJBw2CfVDb1+c/v4skTgMDMHJX1xm7fpStr8U
- wNIMkDIHlBKkBVhUuuB2bxcDgzqLFxSz/4P2uVoQfjwX9piwJTZs+1Hl1DzeOqxyN1lBYkTg
- LbCjlEb4yYZLFHtACoW21JcomejA49FGO7iVO9djoAKJlBJXfojjp++wYK4fwKMBsgHuzoHg
- pfowZv5iooZk5xtH2L17N1u3buXMycO092xj4mQN3bTjLyqnwOtAz5gMDSSJRXTiMZ1kIs3T
- KwI5NpKbHRE6b8Wt7s6E+N0fOoWAa/erRcLVTMYikvHj8Wbp7OzE7XYzPDyMp2gKkU4/Vl4h
- g4MW3jI/ll1l/6/PEn2/lYk2Gy5F4brdpOaZeaOZwocH6gHOmJbcISAwE+q0MRr3AAxE7eQX
- ONm7dy/19fWcOHGCQCDAwkcmIp1e+iIxJuS5kEB7U4gVbvf9hlwwJR9LywMpicdSHKprBjjU
- nJtA54OAco/WDBEgFY5DKiPYuXMnGzduZM+ePdTW1pKhEMtRRCgskIqJJSzirf3jxo3vM34s
- AZYqOHm0DcuUSDg0tnIVxtudgcEMSd3A7XYTiUTwer34fD7chU6krZBY1MCyUoR6QxSmxh+D
- yXP9WIxgSZ0Lp9sBWprh1lgfjfHW09sTnTF/wSy2b/smsWGNSCRCNBolv8COpTmxFJBSp725
- h8n23DBuTSfxqTbmzc5HWkmkhCvnugAOPxB/PFBA/bu7/rJ0/YspXnlpKUPRDPvf+R4XG4d4
- ZeujSEW9P0H7e4fxjHaoItVGVtGYNKUAgM4bYRKxNAKO/0tgE2yfY8qLH+67+NbRuubJ3321
- hs3fmoeiqCAEEhM5WoFDoSTFqgrAJM1OS2YElzuXcbD+LsBIEv72IPBBDQnCb9MwKxbVd//y
- hx9bzy/fx+Vz15FSx5JphMjpNtifxD0KBEjnq9xsHeTIwVYOf9AKcO4mpB+M/9BrIkAVzBfw
- BvBk9cpKtrz2RS6d7WHV+tns3HyM8ps6Ybuka0Tnek+UTNq892lMwJYmOPBfAceAnxXwus2u
- zvT584iFddK6MdalH7gC/B24kA9nzsPIP4v1HwEBakALw3ck1AroA1qAZqA5mAP+f9o/ACsL
- HrLG8KKGAAAAAElFTkSuQmCC'!
Item was removed:
- ----- Method: MenuIcons class>>iconForMenuItem: (in category 'menu decoration') -----
- iconForMenuItem: anItem
- "Answer the icon (or nil) corresponding to the (translated) string."
-
- ^TranslatedIcons at: anItem contents asString asLowercase ifAbsent: [ ]!
Item was removed:
- ----- Method: MenuIcons class>>icons (in category 'accessing') -----
- icons
-
- ^ Icons ifNil: [Icons := Dictionary new]!
Item was removed:
- ----- Method: MenuIcons class>>importAllIcons (in category 'import/export') -----
- importAllIcons
- "self importAllIcons; initialize"
-
- | icons |
- icons := FileDirectory default fileNames select: [:each | '*Icon.gif' match: each ].
- icons do: [:icon | self importIconNamed: (icon upTo: $.)] !
Item was removed:
- ----- Method: MenuIcons class>>importIconNamed: (in category 'import/export') -----
- importIconNamed: aString
- "self importIconNamed: 'appearanceIcon'"
- "will create a method appearanceIconContents holding the string representation of the
- icon, and a method appearanceIcon to access a form built using that string"
-
- | writer image stream |
- writer := GIFReadWriter on: (FileStream fileNamed: './icons/', aString, '.gif').
- image := [ writer nextImage]
- ensure: [writer close].
- "store string representation"
- stream := String new writeStream.
- stream nextPutAll: aString, 'Contents' ; cr.
- stream nextPutAll: (self methodStart: aString).
- image storeOn: stream.
- stream nextPutAll: self methodEnd.
- MenuIcons class compile: stream contents classified: 'private - icons' notifying: nil.
- "create accessor method"
- stream := String new writeStream.
- stream nextPutAll: aString ; cr.
- stream nextPutAll: (self methodAccessorFor: aString).
- MenuIcons class compile: stream contents classified: 'accessing - icons' notifying: nil.
- ^ stream contents!
Item was removed:
- ----- Method: MenuIcons class>>importPngIconNamed: (in category 'import/export') -----
- importPngIconNamed: aString
- "self importIconNamed: 'appearanceIcon'"
- "will create a method appearanceIconContents holding the string representation of the
- icon, and a method appearanceIcon to access a form built using that string"
-
- | writer image stream |
- writer := PNGReadWriter on: (FileStream fileNamed: './icons/', aString, '.png').
- image := [ writer nextImage]
- ensure: [writer close].
- "store string representation"
- stream := String new writeStream.
- stream nextPutAll: aString, 'Contents' ; cr.
- stream nextPutAll: (self methodStart: aString).
- image storeOn: stream.
- stream nextPutAll: self methodEnd.
- MenuIcons class compile: stream contents classified: 'private - icons' notifying: nil.
- "create accessor method"
- stream := String new writeStream.
- stream nextPutAll: aString ; cr.
- stream nextPutAll: (self methodAccessorFor: aString).
- MenuIcons class compile: stream contents classified: 'accessing - icons' notifying: nil.
- ^ stream contents!
Item was removed:
- ----- Method: MenuIcons class>>initialize (in category 'class initialization') -----
- initialize
- "self initialize"
- self initializeIcons.
- Smalltalk addToStartUpList: self!
Item was removed:
- ----- Method: MenuIcons class>>initializeIcons (in category 'class initialization') -----
- initializeIcons
- "self initialize"
-
- Icons := IdentityDictionary new.
- self initializeTranslations.
- !
Item was removed:
- ----- Method: MenuIcons class>>initializeTranslations (in category 'class initialization') -----
- initializeTranslations
- "Initialize the dictionary of <translated menu string>-><icon>"
-
- TranslationLocale := LocaleID current.
- TranslatedIcons := Dictionary new.
- self itemsIcons do:
- [:assoc|
- assoc key do:
- [:str| TranslatedIcons at: str translated asLowercase put: assoc value]]!
Item was removed:
- ----- Method: MenuIcons class>>itemsIcons (in category 'menu decoration') -----
- itemsIcons
- "answer a collection of associations wordings -> icon to
- decorate
- the menus all over the image"
- | icons |
- icons := OrderedCollection new.
-
- "icons add: #('Test Runner' ) -> self smallTrafficIcon."
-
- "
- world menu"
- "icons add: #('previous project' 'go to previous project') -> self smallProjectBackIcon."
- icons add: #('go to next project') -> self smallProjectNextIcon.
- icons add: #('select' ) -> self smallSelectIcon.
- icons add: #('jump to project...' ) -> self smallProjectJumpIcon.
- icons add: #('open...' ) -> self smallOpenIcon.
- icons add: #('appearance...' ) -> self smallConfigurationIcon.
- icons add: #('help...' ) -> self smallHelpIcon.
- "icons add: #('windows...' ) -> self smallWindowIcon."
- icons add: #('changes...' ) -> self smallDocumentClockIcon.
- icons add: #('print PS to file...' ) -> self smallPrintIcon.
- icons add: #('debug...' ) -> self smallDebugIcon.
- icons add: #('export...' ) -> self smallExportIcon.
- icons add: #('save' ) -> self smallSaveIcon.
- "icons add: #('save project on file...' ) -> self smallProjectSaveIcon."
- "icons add: #('save as...') -> self smallSaveAsIcon.
- icons add: #('save as new version') -> self smallSaveNewIcon.
- icons add: #('save and quit' ) -> self smallQuitIcon."
- icons add: #('quit') -> self smallQuitNoSaveIcon.
- "icons add: #('load project from file...' ) -> self smallProjectLoadIcon."
- ""
- icons add: #('do it (d)' ) -> self smallDoItIcon.
- icons add: #('inspect it (i)' 'inspect world' 'explore world' 'inspect model' 'explore model' 'inspect morph' 'explore morph' 'inspect owner chain' 'explore' 'inspect' 'explore (I)' 'inspect (i)' 'basic inspect' ) -> self smallInspectItIcon.
- icons add: #('print it (p)' ) -> self smallPrintIcon.
- icons add: #('debug it (D)' ) -> self smallDebugIcon.
- icons add: #('tally it' ) -> self smallTimerIcon.
- ""
- icons add: #('copy (c)' 'copy to paste buffer' 'copy text' ) -> self smallCopyIcon.
- icons add: #('paste (v)') -> self smallPasteIcon.
- icons add: #('cut (x)' ) -> self smallCutIcon.
- ""
- icons add: #('accept (s)' 'yes' 'Yes' ) -> self smallOkIcon.
- icons add: #('cancel (l)' 'no' 'No' ) -> self smallCancelIcon.
- ""
- icons add: #('redo (Z)' ) -> self smallRedoIcon.
- icons add: #('undo (z)' ) -> self smallUndoIcon.
- ""
- icons add: #( 'find class... (f)' 'find method...' ) -> self smallSearchIcon.
- icons add: #('find...(f)') -> self smallFindIcon.
- ""
- icons add: #('remove' 'remove (x)' 'remove class (x)' 'delete method from changeset (d)' 'remove method from system (x)' 'delete class from change set (d)' 'remove class from system (x)' 'destroy change set (X)' ) -> self smallDeleteIcon.
- icons add: #('add item...' 'new category...' 'new change set... (n)' ) -> self smallNewIcon.
- ""
- icons add: #('objects (o)' ) -> self smallObjectCatalogIcon.
- icons add: #('authoring tools...') -> self smallAuthoringToolsIcon.
- icons add: #('projects...') -> self smallProjectIcon.
- ""
- icons add: #('make screenshot') -> self smallScreenshotIcon.
-
- ""
- icons add: #('leftFlush' ) -> self smallLeftFlushIcon.
- icons add: #('rightFlush' ) -> self smallRightFlushIcon.
- icons add: #('centered' 'set alignment... (u)' ) -> self smallCenteredIcon.
- icons add: #('justified' ) -> self smallJustifiedIcon.
- ""
- icons add: #('set font... (k)' 'list font...' 'set subtitles font' 'change font' 'system fonts...' 'change font...' 'default text font...' 'flaps font...' 'eToys font...' 'eToys title font...' 'halo label font...' 'menu font...' 'window-title font...' 'balloon-help font...' 'code font...' 'button font...') -> self smallFontsIcon.
- icons add: #('full screen on') -> self smallFullscreenOnIcon.
- icons add: #('full screen off' ) -> self smallFullscreenOffIcon.
- ""
- ^ icons!
Item was removed:
- ----- Method: MenuIcons class>>jumpIcon (in category 'accessing - icons') -----
- jumpIcon
- "Private - Generated method"
- ^ Icons
- at: #'jump'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self jumpIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>jumpIconContents (in category 'private - icons') -----
- jumpIconContents
- "Private - Method generated with the content of the file /home/dgd/jump.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABwAAAAcCAYAAAByDd+UAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAACuElEQVRIie3WT2hcVRQG8N+dJtGkZiyiNpUs
- 0gZRqWhM1GihxU1BMLhx0UVFKiJqXAhuxJV0UxHcFCvuSjbqzo0LqxUXXWgFE5GAUmtTzWia
- ltraZuwkk8kcFxOT+Zc0JSIU+sHl8c495/u++9479z5u4HpHuqbsfvdhQNIFwjRGjfnpvxXs
- tzcl+9G7QsapCG8Z8+H6BAf0Jj7A7jUZ42jwilGnrl3wIbtSxhG0g2wr2zdxd1Z0tUu5v/ll
- hvELzJarKwtR9qTvHVujSQzKpgGn04BID4vMgZ54v/hpTMR0XIx8vBEjIYYqY2pnpBdFGqgZ
- pw3KNqPONA2WHESPTIo4+Ki333zXcOuQrTabVwKbbKwkb7lVvLZRPFtD0bPI0YANDZFH7BDe
- gxi+Nw0//ZIDngMTpj1lv098bdb8cs3Mn2zOS5cwuRTt0+2oKblVV5gp21Px2FHs2LfdO55f
- mtumyyEvN9qOyjuMPehswrWaYITHwWN3tj2TdrjFzTXzg+7Rrq22qFioXFuxrQnXaoKSLRAP
- 3GavJ0DO+aXpEV8qKC7nz12hkF8WqRL8l6saLQ2CS67Lsjqc8If7vWq3Pmf9Zay+xc5OIJbv
- SysyriAYzki60/hFM0MFHzumZMFnRhur8xc4/1tNKE3UcdWh4ZGm5Btw/NzCifLvjjQTguIs
- E6NE1equoEpwiasKDW0R3S6n8IKZUubHlpxCf6e8QuPKTh5nfq7W7GGqmyAyXq9vi8Y+nJLL
- 3KUHfZdGJ81tvclC72KTl+Y58zOT4yxUvazAF6SvqsQZie8cqqdvvpcOyqaSH9ADdt4u9nUS
- uVqhikHpI5ysif4aLR70rctrE6SyeW/wuVhsxAy6KhbiDtKUyq5yTs1H6iqb99WPpzaHFe1a
- NW8Z6zieqvG/HcCNwuv+xbiB6x//APor/zPsp+AoAAAAAElFTkSuQmCC'!
Item was removed:
- ----- Method: MenuIcons class>>loadProjectIcon (in category 'private - icons') -----
- loadProjectIcon
- "Private - Generated method"
- ^ Icons
- at: #'loadProject'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self loadProjectIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>loadProjectIconContents (in category 'private - icons') -----
- loadProjectIconContents
- "Private - Method generated with the content of the file /home/dgd/loadProject.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABwAAAAcCAYAAAByDd+UAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAAGz0lEQVRIia2Ue3CUVxXAf/d+376TzeZB3oGQ
- BgykpOQhD4sUMFIeLTpFKoq0RVBwRKodp1ZnWizSoTgWiuO0yNCBFoulaYUyUqnOAGGYQcCk
- JjSmPBMCm3eyyZJsdr/v2+/6RyAWdNqBembOnHvnnHN/c8899wj+D1Iyd7nPiEVLRFyVIu2Y
- QNSKHtnQ0FBl3B4rPg9o/KxvpUnL2IZgKSBvc8dQbI3qic83H9sd/dzACTMf+aZS/E7XZGDa
- A5P6Tqc8GJOji7KJW3G7+WzQqq8esJvOTgQuIOUTH1dXnbxr4PgZS2ZIYVcX53vFr1dmiYLC
- dDb0LeZwWzZL3LXsGZoGQLzpbLv51iZTWYZfU7Kk4URVy+1l+EwpL3/YK4W9Kz3gZNdTeaIg
- 0wmWSUWgCwmsGVVNgSsEgDZ2UqZrzctJCKHHhf06IO4YOOh1rAQKN383UyZ6JOgOzjgr+O35
- Ig7lbMOjx3jA0zQSL5LT/XrlY63ArKIZix+6YyCI6VkpLntqcTJIjXPuEtY1zOJA9iskyTBY
- Jve6O27JcExZMA6EgRDT7wJIeUmBRxyuy0VJBy1WGobSeOPifQSvZxAllZretFszpIbw+ltA
- let3Acxwunyx37vnu+fZO/iqq4ajGWPY3jGP7SEgBLNHtbIl9Tij49dASIJmEs+keGVvpD/n
- boB17zeYeYFZgbF2XKL1d7Mh+wOOdK3AsDVSnDF+M+bPiK5roBQABYBjsGcsij/ecUkVojbe
- 350ZsTVev1SKcnrpNnwYtgZAyHBhDUZBSGzhASFp7dPpCBlCCHVGu1Ngen7REIpV6npvS83E
- ZYELwUSuDPipt3NHYuYmXcYRM1jUtJrgNRfP7ay7agyEXZqm/eSOb9h4/E/HlVCvxuuO5dnn
- TvUf9Uxmr/HFEX+SwyDbe51oXKPbEeDN2o7gQPu1PFBPNxyrunhXk6a8/GHvoNd5AijVxk+5
- 6vj62jzh8jLKMcT+e3bijXQSDCkWbIkEjfaWHCGoajz+7qNwY7StLuMRJXkIRT4CTSiEAoFC
- IhFCIWyQQiFu7hVohvBkhmVK+gVXuWX6MzsDuXn2NF9r9vmrA7KpIyKUsvuao9UfRu3eXmAd
- NbSJNRWUuhMCtZXLniK/uJSEQACPz4fL40HTFJqEUF8XDoeL5OQAQmpIqWFEI7S3tPPm5p9x
- 6nx39XlXRQwoBWIgakHVXIwe0q3lzmcRTtjdvZsaVuhxuLdoSiULV60DFQZl3aJxy+DIoR0k
- 6W0kZkwmI3ccEybcg0tajCnwk146k3P/2ho5F79yBmhEUMM/2ANABW9xv4CCIjhtLqCmH10q
- RhWUTAXV918wy4yx/pmneWLmRcblCqpO9lFSMQ2UweXWII9v2sqJ/kvwZGA+Y5iPLwZrh+rh
- BhDSkDoE0iEvmA796Eqge7wJYJusf/UIORnpgAKlSPZFeGHzRvZsW8ulvhQamkJ8w+8G22TZ
- Cy/x9+/0wugkSEwGXzJ0toBzyDPcWXhxi2JkHIHAHdUYAnTAoTkcoExyM9JYuqBypBvfeX8f
- KJOyOd+jeGIBc5eYCIZvr1IdUDkVxCca/Uoz+EijnH1olPGD5Ezcktn2JI7V/y0GoKOQUgLK
- INjZy4naj/5zgIqDMiiemA/KQAoLw4xSf6mJOTkFnLoUxl+YQZjIcLxHwcbEZAzrUZwm+DWS
- s0pJOhXBDkWrbwKv9/d0gW3y/UX5GGYPqDidnT18eXYW2CYoi/BAmGX7ttHS2UdSkptUzYn3
- tR4SNo1hEVP5A0ehcArETbBMnA4vX9EqmHglhS2/+CkotgNIBX2hjjZQFtlpLhyxMNXLn2dg
- 8XreXfQcweYgKBO/10EkFmXD/QtZNrqMjyJBVicU0nq8ERubFVTCgavI/e1k/dPNjJNZnN74
- Di8t+XFEDZg/opb9ALqUhMI97cMzQBkc2X6Axxs7h0v0cTd7X/uAb/9yMZve3s/5riAH62q4
- 3N1Jjt/P175UzNuvvMfecYdx44AXz2LbalebXV/fJhHYNKKo4UO6br6STpxQf087oIFtMveH
- C3jjbDP+5i7C+anMWz0bbJMnF85h/n1foDArhQS3Nvx19FR+Ps3NuqUvR6M+3Y2lDlLLyuE2
- /9+ixwV9ofarKC0bYQ+RkZ3FYwd/xWAkhs/rBWWDiuH1DTF5XALYQ6BMEE7wTMLbe5QHB61n
- /xKx6vBz9NNgAGLldFI0g/bRRWWOxJR0IuEQcctE0x1ITUfT9OG1/om1pg+rlJz5674hO24V
- 7aih5dNAI0CAVWWUS0kF4FUKTQjkTYu6oQIbRfx2a+u8t/M0TZ/BGZF/A2P54ZZvw1VGAAAA
- AElFTkSuQmCC'!
Item was removed:
- ----- Method: MenuIcons class>>methodAccessorFor: (in category 'import/export') -----
- methodAccessorFor: iconName
- "Template method for an icon accessor method"
-
- ^ '
- ^ Icons
- at: #{1}
- ifAbsentPut: [ self {1}Contents ]' format: {iconName}!
Item was removed:
- ----- Method: MenuIcons class>>methodEnd (in category 'import/export') -----
- methodEnd
-
- ^ ''!
Item was removed:
- ----- Method: MenuIcons class>>methodStart: (in category 'import/export') -----
- methodStart: aString
-
- ^'^ '!
Item was removed:
- ----- Method: MenuIcons class>>objectCatalogIcon (in category 'private - icons') -----
- objectCatalogIcon
- "Private - Generated method"
- ^ Icons
- at: #'objectCatalog'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self objectCatalogIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>objectCatalogIconContents (in category 'private - icons') -----
- objectCatalogIconContents
- "Private - Method generated with the content of the file /home/dgd/objectCatalog.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABwAAAAcCAYAAAByDd+UAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAAD5klEQVR4nN2VW2wUVRjH/+ecmdmd7c7e2qVb
- uu1ulrZWoNUURYILSiKoBcRIN+gLUUKMifLiAzHEhHcVtInaxJQYY0g0Jo1CEBXaKBA3RhMp
- 0Ai10NpUbO32uu3u7GXO8QF6o7NLL5FE/8nJZL75n+/3zZn5zgH+S6r0s+cAVN4z4NqQfLE6
- KLcDkBY6hy6D56oOSIVHDjjvC/hYI4BCACW3rznFlgh7oNTL3n5jr7ZuZ1i1MEYq/F62v6pc
- fnV4nNfHE6J5iXnnyVnooH++/oI22P5psRBR/5yxdb21D0BFvgSLXdIxVSGHO25k9LLiuYtz
- /NtEouN6+n0AXfkSzHzsNRE75ExRTienWVxq6euLGc19MeP8roND35xr8ganHrsd1AKA363i
- GSDVG2pDgffKfN6kmTF68aoxDPhv317jQowCwMnzyURPvyEatqgFTo3tuTnE37ob9JZqdr7Y
- 9PkpMT4RNx2hp1/unm3fsFZpPxCxDwRLpEbNxp6tKpdaHQUkBsC6sDdcpG7GjJ4vziYP9Y8Y
- pwAg3osvARAA4l8B9vYbu0zCeWHA8hp/SbrnwDlLeibanh4ajRtmxoSeUhaa1PMIHGlJeYJJ
- dLshcHzinN42H8jR1tIa3dPSGjXPIpDIB7FvUlYTTupLKtyRVXUrHpKLJUrdDD80XrEDmAaS
- hVadT1rYuu+x5+8/pvgtSExQ9FwbQurvNIrXSPijc0D/6/q4C6eRmvuGJrIBz/goi1AC5yBw
- cswwPgaQvdPHCf/F7rEi2taD0Stjv/E0PyEovqMZ7ROtzuqfaNefiiP9VT6WJUDY94cs2shl
- rVh0OXziQ9WdCFGpA8BKEz999HBVMniwUGhh676poD2svFnzUalw7bC1TMVMj6dyyj44qrq2
- v2a121dQBg+heFhS5K2Sxfu1kdo4KvixO6aIuKJvKQ97QrFL8f50yDirlVqaJI1FhMxdkkZC
- cZo6gj5kTdvCAbptt6LO26JWMxkPMjmAmT31ln+TpYnIvC4ukiAE6zVDXaf4pP361UzAVqtA
- rVIsdkmpB8z7ULESknM/rCFygQRUT8M2WyrBySt6Z9YtNAHZy2pJlg/wDM+4nrRh4tcURs4k
- khDEB5j/NOlRYeQ8Zi6LzGQW6Jyuzkj1Z51qrGhzQVHyRgaGLiih3GWM8HBiiG8EEQOqLX1i
- +AImgRxtUUZZ87tW597dik2eHe/iWWybHPyp2zA2zI67HrcGeUbsAEU3Eakfxy5gJFfBuaSW
- E/bzO6pzvNdRImLOleIzmye1irLfAQQXm2y28jU+8TD2khukQQDapOCnBzg/CkBfDvD/r38A
- 0MR5I7Mls/AAAAAASUVORK5CYII='!
Item was removed:
- ----- Method: MenuIcons class>>objectsIcon (in category 'accessing - icons') -----
- objectsIcon
- "Private - Generated method"
- ^ Icons
- at: #'objects'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self objectsIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>objectsIconContents (in category 'private - icons') -----
- objectsIconContents
- "Private - Method generated with the content of the file /home/dgd/objects.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABwAAAAcCAYAAAByDd+UAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAADhElEQVR4nMWWW0wcVRzGv3POXHZhZdldoAud
- RkzRQFsaxBpTNcUtIMZaTdoQBa+tsYRYS2mjD/riiyY2pkL6JulTaUgkaayJ8aUoohgfWlOl
- GiNqTY1chr1Bmc7uzuX40E4i7A7Nsqt+yTzM+X///++cyXeSAf5n1Ycp+2gDoVcrCVUVwr4s
- BXvxXyEFKO0NE5o8UxK05/zVXPdv5JO+Kr5bkBcrCZkAIBUNJgHbFcKSCX8N5+VK1nNYLtVC
- oIPFYBEAqCbsq6GSwMN7RE9Ok845apdmr6vc3gxgoRAgBYA0+NZ2UXY1eQlBq+CxBKC5EJgD
- FEWASjcP66o6yrwcUIoBNGxAi3J7TePXVlqjwFQxgCAE50+klnQ30xXLwPec2xsU5bZAr4Su
- ynJ62Zm9WgwANM4//9k2D4Qo8TUzaYXxJ8vAXi26aFZv6tnSsr/zrsad2tWpb/9yA4Yr2ECk
- WW5Sk7ag6Xx8rc2Fqwgbq6dC8nXZd+N9r998XPDEA4SqAtDumNq6+59q7e5/s6OzP5jrALU1
- bMacVPj2OnEBwJbVhqykSMBWC2iWgJABfGcCFwHc+Kdn76FDJfpyaQ/n9sLYyOBZAPxWaf/B
- J0o/PP1WIPjLNRN7jkdVRolOCBBdtMr0NHl17WjeRq1PH7snOj99LDE9ETRSyzt3NEieD476
- KzZvFFb4/pg18eAr6rXZmL2tICAAhMrZ5P310gMfnwgyWcweZ1rAfS/Nx3741egAcClnkvJR
- LGlFLk+nhx49Ek2qieyrNXR+2fhz3joN4BLgEt08lZmL2b0/zvgOtPUltNXFhlpR9HrJJue9
- GEB0dr4tNbU935hOm1Fn7crvBgyTY1eTDNjY7bAE1yl5KC4lj1siTlGCl1MZjoPvJBa/uJie
- ppTXtNzrkcMV9I6ZqLULwHjBsNauvp727iN3A4BSxeYb7hRioTJ6+FaZAHiopoINl/uEiLOw
- QuGWF0ZlWWxyA+ipzG/qxJnHACDyXN+TDGTpwvDAOABUBdk5NW69i5t3N6eyPiljdNvUuYE6
- t4bGfUcBAO3P9O+wLbvswsjAJ05NjVv73PocrSs0jzz7msKJHRkbGRzOtzd/IAdlnPYGzJmT
- efeuB0gAJhH7vdHRUes/AXIC47Ozp5bWA1sXsFBlpTRjWJmuN07OuTVoeqq4wIV4rOPTb67n
- /l8EAN3OFAL8G3xJPtRdAsoRAAAAAElFTkSuQmCC'!
Item was removed:
- ----- Method: MenuIcons class>>paintIcon (in category 'accessing - icons') -----
- paintIcon
- "Private - Generated method"
- ^ Icons
- at: #'paint'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self paintIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>paintIconContents (in category 'private - icons') -----
- paintIconContents
- "Private - Method generated with the content of the file /home/dgd/paint.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABwAAAAcCAYAAAByDd+UAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAAEK0lEQVR4nLXWW2xUdRoA8N85M53O2Av0Rgus
- tJZCKASvUO+E3aBFN7IbWGNMdqMmPGlMdC/ZGB/U+GI0IfqiPigvGLImXtaYdReMAomu2TXB
- FYGFRSUVSgstCKWdGTpzztmHKaQhiEaHLzk5+V++/M53/l9yTsqlibCHNS3kTjB8iYxKLKS1
- my39c7JJX0Mm6eHFS+mF3ezYsLY7GXru2uTdh/qSK3PppJtl5zZUU5vPH3ovz65Yv34Nde2S
- oMb1S2fBLVUHu+jC0w+t7aT9GtGZgiihrSUnYEnVwRRPLOnM1d7y81uJI6WxEyKhQqEMcVXB
- Lhbhdw+u6WB2H2PfiGLKAvliCSarCqb4/fzZtambbr2e2kbGBsRxIBIaz5fgZNXAn5HDPf3L
- ZjL3hsrkVIURJvJlAfurBmZYi8Zf9V9FXQeTp5k4WqkwCAwcGRezr2pgwAOLO3Nm9VxZmRjZ
- DaKEdFA2li9FuWqB3czDL1Yvm0HTwilwVwWMA/l8Hv69h/GqgAH3Ibhz5aJKs0wMkx8Bcczg
- 0VMCtk7P+amv9N7u2bVauhZXRsd2nVuIksCufcclvF8V8Ao60XtTbz2N84hKjHxxbr1Yju3+
- 6tuxy/lXVcCQ1XDj4gZSGY7upFw4t35gaFyS2Lad8vS89I8FcUcQkCSJ/25/22XRqHmtKUFA
- HLFt1yi8d4EH/dHRPP/qa3zWer+O324ycPUz/rS9x9YvSg6PTvpk38lCwuvnJ12wwn76WlmX
- ITvI5q3nncNUDDe3t+vu7dXU3KwUxxb03ezz44u8smmjhDe/5tT3gneycCn/XEUqwB4eDvnN
- P3jrvK3RgZ07fdLRJB1N+vqbQUE6LYoiA0fGinjhQsUEsJ7NXdz2Hx45zYcd/HUWc7NkM9Tt
- 5tPXWXE2qYdHc3W1G5bd2CXbkBEFjAyfduxI4tihwxNxFN31FdsuBKYRNLJ0Di37WXiKkSFe
- Ha6c7ztbGOrnqrMJK0kf4vFV110hW5NRnqQcJrJtDUYPHRZH0RvfhZ0Fkw0sXUl9LS+sYktW
- 5QO2k+dv574t0w7/NEEYBE1zk6xykVKqApbDREdTncFD39Z9F8a0Lt3OeEDbBzz5N/5yBvdS
- 28Lm1dwNS6g/yfI4STaOHJ/QnE9pyodmFkKNxVAuDqH4g8DbWTHCuq08FfPnUVyGXxPW8NrN
- /LHIwTDwcYqP3th7YHjGRKgtn9IydR05Oibg04uB07s03cqX/eyYw7XLpyZbsIbMOzy7sr3b
- L8MOj536/OVEkJ03lnGmJlFIx947M+TgyMn/Zdl4MTCYPuhndT0vddLVgAbUIYMU/p6qiR+Z
- sTxcUMgp1sSOZUt2ZE54+8SAwfzEjjQP7OfgDwbhScKPmR/SENIQVe71CTPRdpzriql0thCV
- UzgcVH7lN33J3otBZ+P/SNx4XWnWkNMAAAAASUVORK5CYII='!
Item was removed:
- ----- Method: MenuIcons class>>projectIcon (in category 'accessing - icons') -----
- projectIcon
- "Private - Generated method"
- ^ Icons
- at: #'project'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self projectIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>projectIconContents (in category 'private - icons') -----
- projectIconContents
- "Private - Method generated with the content of the file /home/dgd/project.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABwAAAAcCAYAAAByDd+UAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAAF3ElEQVRIid2Va2xcRxXHfzN37j7sZBs77+A8
- nIcTu25M4jYRKU0qqMqjIlLNoxQhERFUoKhfKJACElQBqRRqHq1SIqcQ2hKwKKkEaYhkpaZp
- aFJqgwN2E9dJGtO4iet4d+3dtb2Pe+fw4a7Xtkz7BVVCHOlo5s49M/9z/uecGfh/FzX9455G
- yrSiXixVaMIihEQIKQgpRVggJMW5Cv45QAEooPFK82kqUEDRe6CD04AogN2bWOloDgI7AP0u
- BdcDbDUARnNYoDFSHmNtw828Z+0NlMUqKI9VUharoCxWQSRaRigaIRQO4YZdXNfgGE0oEkEp
- hVgP6xew1kesw1hqjPjQEK91nKS99VHGUol64AYDKIEN6zZv56v729HagmRAJkCKLEkB8EH8
- 4loOxHL3p79IU9NH+OQnPowSH40N7LQlfJ1PZcyyrn43S6prOfDNuxBNRN97E1VAeXX9VrTO
- gVwBSYKMAxMg+QBEioBF4EQiwebqFO1HDzEwcHWaQ/5M20I/y1bXAaA9xOR9VmkFK2o3Mzh0
- iWMv9YAIYAMtzufHIuzcvgYRj47OHlp+fpAH7hxj4TxNc/MDaMfl5N9Heeihr7OlsWYK0Eug
- nQUA+AoxgAuwdNV6evsH6LmY5oNbG2Zl/BeHn+Oj25bTeFMT9zU5/PBzUBkzAOzdVaD3jSzj
- 1LGlcV2RdltKgXYCO60Q42gcEQiFwyCWmhVLuWVz7SzA1j+1YRz43W8fofnhR9i4Zpgtsan/
- P302yqP7vjKNTlsajUMJUGNxAIxrQOw7VLWA+KxfV8X+lmaeen4uACOZYE/j2hy9ff+akedJ
- 1Y5Mo1SjETDGLQK+QxsWD9Mq8LrliKWjfxmxckV+7C0u/uYIG7//pSJQsWLF4mg7VTRYHBQ4
- rhMYvB2gyAzPz/YXeP8HPsWBPTsAn1w2RyKZmk2p+EGrTUZoNUoJgGXenBBtp05zqqsroHCS
- SmBORIrtERzU9tyPZ9AXDmmWLp5LNpflr+fO4xrYVrs6ACwmUSvEiCWjFIynR3hvzUIO/+CO
- GQm3vsebb76F5xUo5HO4RpeoQnzyXp7O3vO82H2WVwsDxMMZoouiDHfGObHhfsDHcSJTgMAo
- QGYkwcKFZTMO+/2vj3HoR63U5yyuQLcRtn9mB/ft+XgpR9892Mr5qkHGygyXX08ydnWCBRUT
- pBel6ekfoH7lIpQbKVGqHUsKIJOMM/36On7sFF0PPs2zw5bvpeE7GXhmRGGe+DO/3HekdPvc
- tqmOnO/RdaiHPbXbeOn+e9ld20jsuihPnjgNMi1CD9HKBhGmkvEZV9jTza08OKFnvl/Al/MO
- xw+dKDl38/VriF9K48+3fOjGWlwHfN9n6G8p/ni1G98voJypCE22klQoDaPDw0F9TBZCtoA7
- Cy4QnQ8c832PJ9teZPSNMaKrXF4+d4GW9r9w8pWLVN5Rhh8TjnedZ8etuVIO9a9eIAvk08lr
- oCIlz2vet4EXlD8LrNd6VKxfAuLT2XeRr/3sGYYSKcIrDC+fe53qigoiqw1eyiL/EK6MeGQz
- qdJ+UxxT6eS1BahIidJv7P0s97x6ie6zg9yZ04SV4nntcbh6Dk88tgvEp275YlZdX0ly/jjm
- jEOoRvOTL+zk7tc2EjGahtWLccobuJpIzahSgNFM8toC9JxSr7kuHPzDt2k71sn+ox3kJnI0
- 3lpH611bcTSAz9yoobv5W4xkMswrD5daaduGqqnWMksYvHQOACt4pQiHBi5QYDFuWMBPgR0H
- fG7/2E5u39kEyp1SscE7abMgOeaFcyBZsLngsVYmsAsth2gD/zz5OEAuPEqfKV4mg/Er/Ty8
- 6xZW1t2I7xVIxQfJjAyDUjjGxXFMMBoX/TbzSRttJtc68fKtnD76FAKdj10gFwAqWoDbLved
- cS/3nfmPlflfyriCvQFUUT6/iWWOoU4Ly7A4aLS1aA0KhRZQCBpdHAUNuKKYfMRLqgQPRRJF
- EiHhOrTve4X4uxHJ/578G1jL6Ak/aE7qAAAAAElFTkSuQmCC'!
Item was removed:
- ----- Method: MenuIcons class>>publishIcon (in category 'accessing - icons') -----
- publishIcon
- "Private - Generated method"
- ^ Icons
- at: #'publish'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self publishIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>publishIconContents (in category 'private - icons') -----
- publishIconContents
- "Private - Method generated with the content of the file /home/dgd/publish.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABwAAAAcCAYAAAByDd+UAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAAHJElEQVRIia2Ua2wU1xXHf/fOzK696/Uav7Fx
- bIyhEIwDxgQETRojcEPd8gFCmwgRSKkKCh+oqFqllZJQWpK26iMvBAFUSkjSgEMaKESURsTm
- EV7BaXEcnsbGxvb6xa5f693Zmbn9YENcR02x1CMd3TM6d+7/nv//3CP4P1hR2QqvGY0UCVvN
- QDpRgagWXbK2trbCHLlX/M/TiimghyauEx2ZmvTIE6nSMl9G8DggR6SjKP4Y0X2/aKj8c+Te
- AGeyG7/rSSwnTL/1G/LZTAU2wJSHl3xPKV7TNZk05xvTQueSvxmV903OwrZsp6Gm2bpY1efU
- 19wPXEPKVZerKk5/NeBMSoFjbJ2DPj0Na8812HnlBJb67iT3sgIpnKqpeR7x29VjRX5BOptC
- SznSmsWyuGr2DMwBwK6vCcTeeTGmLDNRU7Ko9mRF40gaYCYTKGYV8ApSkF04gaPGr5jy/VLY
- Oe8hUuPOWqrnzfQkF7s25Ij8TBdYMUqSOpDA2rQq8t1BALTx0zLda1/yI4RuC2c3IL6osIR5
- KJ6hJKU8ZUmhiGTrDOQYOIk68bgoYwa1NHK99Qba09UcWLqM8lnpoBuc98zl2cuz2Zu5Db9r
- gFdvf5tdoeK7R8fO/O2a9Y/dE1Es1gAoZhVx2vsLdjz9tcmrS8Wt3D56PJ2o/gCYYSxPAldo
- 5jZ94DNQhQnIQ/UsmX0/V+IfYM3nZRwZ9woJohcch7BI5mjfxLuAWlZBinViv4kQTToPkoLN
- liUvrZfNhYqzgb3QchV64qHNDZMikJIz+KdtQVsdXO/mRvs4lDRotFIxlcYb1x+gPOM6KT6L
- C7dT/1MmqSE8iY0q3D1Tx2KRGOf1+EpyOHt1MwRNeIEBWvr2oPqy+b23nEgvhNqg/SZ8Ek/S
- Llt517wucD5gofsCH2Xksq3tUbYFgSCUprXwh5Tj3GffAiFpjvl5Jtkjb4e7s3VAL1o0j0+p
- g3AIdhnQai/mEz6khMc4K8tJPAmtibDVUr52byAzrSwaTivMc+wjaN2dbMr6O8c6nsJ0NJJd
- UX6XewjRcQuUAiAfMPq7xqP4i0RwMzjQTQ03wTsGdBsUPQAYHGZ/bwMbRTXPBX9ER+y+LPfs
- vfT2ZIQdjd11M1AuD52mF9MZbIeg6cbqj4CQOCIehKQlpNMWNIUQ6rxOPscbq690Q5qfxDSY
- Y8IZ8+vAOU4zAEwAy7krx8POX5US680Ptt98bfG63NqabLITvxhCCrhpppFhxlh6czXzw9Xs
- 33ewCUiTmnZIUoHNpdBbfNwO0X7IVaCYO0xyZ1jMpePvHVdCbbX/VZnjXDnb/VH8dN42Z93N
- +w2TLE8vEVuj00jireq25r7ArRxQP62trLg+yEMqpzkeWEG87qMyAs3Wblo49aWhMGR5qQWV
- MUMrt2s/zlOBhiYxsdgvdIM0Y4CDE3bg6Wsl1BvmzS2HmmOfn8kWgorLJ977CQyNtjXFLOkQ
- PHEJZvnAnAZt2iA/EokQCuGAFApx59tGavVGYWaLXpCupLTxJbcljctx5nhbsq429cn6trBA
- iZCj+PGVk+/uunNZsbaEGXEJSdULlm8gb+p0EvyJxHu9uOPj0KRC0xyCwU4Ml8GYpCSElEip
- YUYGCDR1smXz85xqklW3tbFRYAYQBVEN6oKmye21lRWB4ezoNhROfnAB5avXgQqCssCJgRp0
- 24py7PB2/EYAX8Y0MrLzmTI5FzcxcvPG8MjCckJbnz224wKb/psEw01KRVp+0WxQoS+BWbEo
- z/3s58wee4rvTL9BR/0pMjKSh/ZYEGvBcLmQIxrrq0xXAj3ekwDK4vmtlWRnpA89WMUYTy+b
- f72RPS9voC6URG19iMf8cYNgQ5dyuXWUGgUgYGiGASrGuIw0Hv/WwrvJdw+/DU6M4vkrmTol
- j7KlMQTWEOCgu9wSJVD3DqiQUgLKorm9i5PVnw1L26Aspk4ZDyqGFBZmLMLFugYy/PHkpCag
- G8boKEXR293VAcrih4vHY8Y6QVm0t3fyUOnYu5X09PWyfN8WGtu78fvjyHS72Ld8BZruG1WF
- UkEo2NYKyiYrNQ4j2kvVil/St3QT+xdvpLmhGZRFoscgHI2waW4Zy3Om8WlPM+3BIFL3jkpD
- KSXBnq4AKAkqxrFtB1h5qZ35A4qVl7uo+tOHoGK8WPE+VztaOHjxn7xz/gLZjo+6QBemaY2S
- Uptgd1cA0EBZlK0r543P6kms76AnL4VH15SCslhfXsqiokkUjE0iIU4b7FIthcrK0OiaxhaE
- goEmlDYW4QyQkZXFkwc20x+O4PXEg3LAieDxeJk+MQGcAVAmCBd4iqmveRUBXfcMqNzc6myp
- j73wVLnhS04n3BPEtmJouoHUdDRNH4z1YbGmD7o8z/mjeweUovJeAQXAD4qZKSUlgEcpNCGQ
- d1bUkAscFPbI1dE5sPMc9fcK+G+8HDQjZjwS2gAAAABJRU5ErkJggg=='!
Item was removed:
- ----- Method: MenuIcons class>>radioButtonOff (in category 'accessing - icons') -----
- radioButtonOff
-
- ^ Icons
- at: #'radioButtonOff'
- ifAbsentPut:[ (Form
- extent: 12 at 12
- depth: 32
- fromArray: #( 0 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 0 0 0 4294967295 0 0 0 0 0 0 4294967295 0 0 0 4294967295 0 0 0 0 0 0 0 0 4294967295 0 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 4294967295 0 0 0 0 0 0 0 0 0 0 4294967295 0 4294967295 0 0 0 0 0 0 0 0 4294967295 0 0 0 4294967295 0 0 0 0 0 0 4294967295 0 0 0 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 0)
- offset: 0 at 0)].!
Item was removed:
- ----- Method: MenuIcons class>>radioButtonOn (in category 'accessing - icons') -----
- radioButtonOn
-
- ^ Icons
- at: #'radioButtonOn'
- ifAbsentPut:[ (Form
- extent: 12 at 12
- depth: 32
- fromArray: #( 0 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 0 0 0 4294967295 0 0 0 0 0 0 4294967295 0 0 0 4294967295 0 0 0 0 0 0 0 0 4294967295 0 4294967295 0 0 0 4294967295 4294967295 4294967295 4294967295 0 0 0 4294967295 4294967295 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 4294967295 4294967295 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 4294967295 4294967295 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 4294967295 4294967295 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 4294967295 4294967295 0 0 0 4294967295 4294967295 4294967295 4294967295 0 0 0 4294967295 0 4294967295 0 0 0 0 0 0 0 0 4294967295 0 0 0 4294967295 0 0 0 0 0 0 4294967295 0 0 0 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 0)
- offset: 0 at 0)].!
Item was removed:
- ----- Method: MenuIcons class>>radioButtonPressed (in category 'accessing - icons') -----
- radioButtonPressed
-
- ^ Icons
- at: #'radioButtonPressed'
- ifAbsentPut:[ (Form
- extent: 12 at 12
- depth: 32
- fromArray: #( 0 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 0 0 0 4294967295 0 0 0 0 0 0 4294967295 0 0 0 4294967295 0 0 0 0 0 0 0 0 4294967295 0 4294967295 0 0 0 4294967295 4294967295 4294967295 4294967295 0 0 0 4294967295 4294967295 0 0 4294967295 0 0 0 0 4294967295 0 0 4294967295 4294967295 0 0 4294967295 0 0 0 0 4294967295 0 0 4294967295 4294967295 0 0 4294967295 0 0 0 0 4294967295 0 0 4294967295 4294967295 0 0 4294967295 0 0 0 0 4294967295 0 0 4294967295 4294967295 0 0 0 4294967295 4294967295 4294967295 4294967295 0 0 0 4294967295 0 4294967295 0 0 0 0 0 0 0 0 4294967295 0 0 0 4294967295 0 0 0 0 0 0 4294967295 0 0 0 0 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 0 0)
- offset: 0 at 0)].!
Item was removed:
- ----- Method: MenuIcons class>>smallAuthoringToolsIcon (in category 'accessing - icons') -----
- smallAuthoringToolsIcon
-
- ^ Icons
- at: #smallAuthoringToolsIcon
- ifAbsentPut: [ self smallAuthoringToolsIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallAuthoringToolsIconContents (in category 'private - icons') -----
- smallAuthoringToolsIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 2808846277 4285241285 4285241285 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4104749094 16777215 16777215 16777215 4285241285 4288461528 3765147589 4285241285 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4156465773 4038761825 16777215 16777215 16777215 4285241285 4269385423 4287147474 4272275675 3898314177 16777215 16777215 16777215 16777215 797072384 4273576540 4294437589 4256074563 275795968 16777215 16777215 2892732357 4183986884 4286491090 4288461528 4255103704 3881930943 3064638120 3131747241 3920013734 4104492405 4293443700 4291597568 2693556224 16777215 16777215 16777215 2540345030 3580466371 4268792519 4286622160 4289118684 4270501585 4285635011 4294967295 4291342725 4292591497 4292980025 3953030672 4288257175 16777215 16777215 16777215 16777215 4083520451 3731461315 4285701320 4286227917 4289250269 4219249868 4286878622 4272851774 4292917094 4291794688 4124363449 4288257175 16777215 16777215 167
77215 16777215 16777215 3951402422 4268004291 4286228432 4285636298 4272472796 4272064850 4291274851 4292526223 4071986259 4226279912 4288257175 16777215 16777215 16777215 16777215 16777215 4288257175 4259637483 4268725432 4286293452 4286030796 4273182039 4290882421 4289438090 4256807607 4260689397 4288257175 16777215 16777215 16777215 16777215 16777215 4288257175 4294901502 4259177190 4288849830 4289112743 4288981159 4288849829 4289375657 4275953373 4277795321 4288257175 16777215 16777215 16777215 16777215 16777215 4288257175 4294901502 4060020478 4294967295 4294967295 4294967295 4294967295 4294967295 3824020973 4277795321 4288257175 16777215 16777215 16777215 16777215 16777215 4288257175 4278124286 3003055870 3317805978 3874482915 4274568359 4291740331 4289906910 3102337511 3992582649 4288257175 16777215 16777215 16777215 16777215 16777215 4288257175 4278124286 3671774150 3233788567 4258252210 4292135090 4291940812 4290889933 3269254362 3791321850 4288257175 16777215 16777215 1677
7215 16777215 16777215 3868826775 4227726845 3923234754 2916008878 4241934256 4293847268 4290693332 4272668629 4190688481 3690790396 3868826775 16777215 16777215 16777215 16777215 16777215 3029965976 3471502058 4191934156 4192131794 4276808165 4294111470 4294177521 4292074211 4258191588 3506174971 3130694807 16777215 16777215 16777215 16777215 16777215 865835926 4070153367 3924421097 4244504061 4277926649 4294704122 4294506744 4294440951 3638484958 4019821720 1620219282 16777215 16777215 16777215 16777215 16777215 33554432 1553505174 3550059671 3952712855 4288257175 4288257175 4288257175 4288257175 3365510294 1653576333 16777215 16777215 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallBackIcon (in category 'accessing - icons') -----
- smallBackIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallBack'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallBackIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallBackIconContents (in category 'private - icons') -----
- smallBackIconContents
- "Private - Method generated with the content of the file /home/dgd/smallBack.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAABqklEQVQ4jb3Sv0uUARgH8M9792bHmZRJJYIt
- tghFeW8HJSGBhNDY0tAQKbRWUA1tTg5lf0AtTREaERWEEE1BDRZEtQSZS3CdyqXe+eP03rfh
- BClJsKAvPNPzfL/Pry//iPQfM0edsk9GwdTWJPNa5TwUSUQqcg5sVh781rVf4pa2bLNLnQx9
- 4Ef1O0YQowENEnMY885YXeCkUNkdiQvh2Q7DV4ZdC++p3n7PyCRhiu1pGkN2hNQSvsxXBfoC
- kSweCYO+XYMn9PedN6HgsTcahLp1yunQKCMWKykbjV+Z6h1lfuV+IHITV904pPXMEQWlDXu2
- aNJuD5hQMGeB0y8oLn0O0QYOZzeSi19ZmDWzWjWzuoKEVJp0yMIq1NLavMaAWiVjf4nG5npB
- ucTEWxbnWK6wsrQWy1RSPFkk8bF+xC49Up673Jx1sMzOvVRK1DI8qFKMmY6ZrrIcr0+YuL7+
- xi69Up4Z2J1xbJa4xngLd2cIDIp9E9iGUGJJYFKTl7/u3KVHpOhiNvG0KXE8SEQ+bWakjchr
- Fxlfc2Is59zWBOoI5HXLy/8N+f/iJ/5OkGsa/+A/AAAAAElFTkSuQmCC'!
Item was removed:
- ----- Method: MenuIcons class>>smallBroomIcon (in category 'accessing - icons') -----
- smallBroomIcon
-
- ^ self fugueBroomIcon!
Item was removed:
- ----- Method: MenuIcons class>>smallCancelIcon (in category 'accessing - icons') -----
- smallCancelIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallCancel'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallCancelIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallCancelIconContents (in category 'private - icons') -----
- smallCancelIconContents
- "Private - Method generated with the content of the file /home/dgd/smallCancel.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAACC0lEQVR4nK2RX0hTYRjGf+d85882bWZMESIC
- CSHOaYu6TIksRwRCXhgUOLqWsn9IlFAQ3YRSoFTQWEFGeFUXBd4FQVC3zrrJIOgiglzTOd12
- tp23myY6XBfRe/XxPt/zvs/3++B/Vgx27oXdjfQ9EI5C+8aeXjs4kDhu8zVu8dmFvi2Gdx01
- WThh892F85vELohctPHKvTFZfvVUxrYHSg4cqekuREe3mdnl6UnxBnrkWgDfgRiAAaCBlfOp
- +Ok5U31ZYHTmiVUaTMzqK+W4D8X+sPnm6nSySfM89A/v+eWDArUpxT44fM6i6LUhK8k7svTy
- sYwEVeFmi1VYev1McjMPpdyhZMTGdyBR82kbhzjQe8xmdqJFswr3pvA1DVpb0TMZAlcucDnr
- +289hubhecOfcKHvko1X7VCSn7olq+PXpdSuy7BFxYVT9feN+oYG5i6FplerlMduoGmgTKhA
- WYdvDTf/eUL//RAVaUN+NCPzBpJWSCaMFCLIWZN8FA40ij7wqIlqzZw2kCGDwoRNNa2QbBjJ
- R5CEyVIU3PrNh1IbzPMGcsZgzYFuB05PBvDTClluQXIRZNBg8SCE1hlo0OoY6ItF+FmE21D4
- WCH+Cd4BJIsErCAp8midYehU7JirEALW1lOcVKReNCODilUHurfgMzweQB4EkRjc3ZJDFHpc
- iP4F8v6GEP+1fgOfrL0AYYB91QAAAABJRU5ErkJggg=='!
Item was removed:
- ----- Method: MenuIcons class>>smallCenteredIcon (in category 'accessing - icons') -----
- smallCenteredIcon
-
- ^ Icons
- at: #smallCenteredIcon
- ifAbsentPut: [ self smallCenteredIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallCenteredIconContents (in category 'private - icons') -----
- smallCenteredIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 2862522779 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 2862522779 16777215 16777215 4288257175 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4289440683 4289440683 4289440683 4289440683 4289440683 4289440683 4289440683 4289440683 4294572537 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294440950 4294440950 4294440950 4294440950 4294440950 4294440950 4294440950 4294440950 4294572537 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 42
94572537 4294572537 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4294572537 4289309097 4289309097 4289309097 4289309097 4294572537 4294572536 4294506743 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572536 4294506743 4294440950 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4294572537 4294572537 4294572537 4294572536 4294506743 4294440950 4294375157 4294309365 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4289440683 4289309097 4289309097 4289309097 4289309097 4289309097 4294309365 4294309364 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572536 4294375157 4294309365 4294309364 4294243571 4294177778 4294111985 4294243571 4294177779 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572536 4294506743 4294440950 4294375157 4294309365
4294309365 4294243572 4294177779 4294177778 4294111985 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294440950 4294375158 4294309365 4289309097 4289309097 4289309097 4289309097 4294111985 4294046193 4294046193 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294375157 4294309365 4294309364 4294046193 4294046193 4293980400 4293914607 4294046193 4293980400 4293980399 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294967295 4288454554 16777215 16777215 2862522779 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 2862522780 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallChangesIcon (in category 'accessing - icons') -----
- smallChangesIcon
-
- ^ Icons
- at: #smallChangesIcon
- ifAbsentPut: [ self smallChangesIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallChangesIconContents (in category 'private - icons') -----
- smallChangesIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 490044345 2671475640 3728440505 4130765241 3845814969 3157949368 1395947704 87254732 16777215 16777215 16777215 2033415863 271610031 16777215 16777215 1345746614 4130962105 4201816526 4288331486 4289908199 4289907942 4288593630 4100561352 4030167480 1479833527 16777215 1714780343 4281563063 255031227 16777215 691173044 4114250680 4288134110 4289186277 4289448678 4290631148 4291288047 4292076787 4292602100 4291288045 4115827136 3224795577 4148724669 4231297207 238518454 16777215 2604301240 4252279246 4286425299 4282351034 4281628855 4231756985 4083652551 4272736226 4292798965 4292930549 4293062134 4254381786 4291879151 4181425337 222000817 16777215 4080630456 4282745533 4265508539 4114316473 1966241975 422804152 1161066169 3443096760 4117469896 4292141808 4293324792 4293587448 4293587448 4198202553 187593913 16777215 4264916919 4214979769 2641535701 3862395320 590575030 16777215 16777215 16777215 1613920439 4281628855 4291813359 4291682544 4
293390584 4198202808 171147443 16777215 4231231415 2119404740 729984219 324965577 33587328 16777215 16777215 71336127 3292101303 4204509915 4293652984 4292930549 4293587448 4214980024 154759594 16777215 222000817 16777215 16777215 16777215 16777215 16777215 16777215 2687727799 4281563063 4165830334 4149447104 4149447104 4149447360 4281563063 138444991 16777215 4180899767 4264785847 4264785847 4248008631 4231231415 4214454199 3107157943 490044345 406156725 406156725 406156725 406156725 406156725 473396918 16777215 16777215 4231231415 4293521912 4293521912 4293456120 4255630561 3761732280 271610031 16777215 16777215 16777215 16777215 445231586 964537051 4231231415 204177599 16777215 4231297207 4293587448 4291616752 4291879151 4264785847 1781757623 16777215 16777215 16777215 187593913 3912595640 2373363157 3260780998 4281563063 87254732 16777215 4248271288 4293587448 4293390584 4293456376 4291419116 4115958721 3392765112 909407928 16777215 1781757623 3980361147 4283862726 4265311417 41
97940152 16777215 16777215 4248402616 4292798965 4271947742 4293258743 4293062134 4292076530 4271619037 4115892929 4214519992 4282022840 4265245624 4282417339 4283665089 2822470841 16777215 16777215 4265048504 4150630087 3560339896 4099247298 4290630890 4291879409 4291091181 4290368490 4289383143 4287871453 4287476954 4288265438 4114184888 707885494 16777215 16777215 4281563063 2469820856 16777215 1412724406 3996678584 4082995909 4287608282 4288857058 4288923108 4288002782 4235765200 4130962105 1530230966 16777215 16777215 16777215 2721216695 16777471 16777215 16777215 87254732 1395947704 3191569337 3912858808 4197742775 3829103801 2856222137 607287480 16777215 16777215 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallConfigurationIcon (in category 'accessing - icons') -----
- smallConfigurationIcon
-
- ^ Icons
- at: #smallConfigurationIcon
- ifAbsentPut: [ self smallConfigurationIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallConfigurationIconContents (in category 'private - icons') -----
- smallConfigurationIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4282944717 4282944717 4282944717 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1480812686 4282944717 4282944717 1480812686 4282944717 4291155690 4282944717 1480812686 4282944717 4282944717 16777215 16777215 16777215 16777215 16777215 16777215 4282944717 4291155690 4287805149 4282944717 4285374933 4289250531 4285374933 4282944717 4287805149 4291155690 4282944717 16777215 16777215 16777215 16777215 16777215 4282944717 4287805149 4289250531 4289250531 4289250531 4289250531 4289250531 4289250531 4289250531 4287805149 4282944717 16777215 16777215 16777215 16777215 16777215 1480812686 4282944717 4289250531 4287082715 4098460874 4284323793 4098460874 4287476956 4289250531 4282944717 1480812686 16777215 16777215 16777215 16777215 4282944717 42829
44717 4285374933 4289250531 4098460874 2923986606 1497524108 2537911972 3998060491 4289250531 4285374933 4282944717 4282944717 16777215 16777215 16777215 4282944717 4291155690 4289250531 4289250531 4284323793 1497524108 16777215 1497524108 4284323793 4289250531 4289250531 4291155690 4282944717 16777215 16777215 16777215 4282944717 4282944717 4285374933 4289250531 4166095308 3445593287 1497524108 3225977527 4098460874 4289250531 4285374933 4282944717 4282944717 16777215 16777215 16777215 16777215 1480812686 4282944717 4291155690 4287082715 4166095308 4284323793 4098460874 4288330975 4289250531 4282944717 1480812686 16777215 16777215 16777215 16777215 16777215 4282944717 4287805149 4289250531 4289250531 4289250531 4289250531 4289250531 4289250531 4289250531 4287805149 4282944717 16777215 16777215 16777215 16777215 16777215 4282944717 4291155690 4287805149 4282944717 4285374933 4289250531 4285374933 4282944717 4287805149 4291155690 4282944717 16777215 16777215 16777215 16777215 1677721
5 16777215 4282944717 4282944717 1480812686 4282944717 4291155690 4282944717 1480812686 4282944717 4282944717 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4282944717 4282944717 4282944717 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallCopyIcon (in category 'accessing - icons') -----
- smallCopyIcon
-
- ^ Icons
- at: #smallCopyIcon
- ifAbsentPut: [ self smallCopyIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallCopyIconContents (in category 'private - icons') -----
- smallCopyIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 1335796123 2140773783 2140773783 2140773783 2140773783 2140773783 2140773783 2140773783 2140773783 2140773783 2140773783 1403036570 16777215 16777215 16777215 16777215 2107219353 2147483647 2147483647 2147483647 2147483647 2147483647 2147483647 2147483647 2147483647 2147483647 2147483647 2140773783 16777215 16777215 16777215 16777215 2107219353 2147483647 2146694131 2146694129 2146694129 2146694129 2146694129 2146694129 2146694131 2146694131 2147483647 2140773783 16777215 16777215 16777215 16777215 2107219353 2147483647 2146694131 2144588753 3500845735 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 2879299995 2107219353 2147483647 2146694131 2146694131 4254834329 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4288257175 2107219353 2147483647 2146694131 2144588753 4254768536 4294967295 4294177778 4294177778 4294177778 4294177778 4294177778 4294
177778 4294177778 4294177778 4294967295 4288257175 2107219353 2147483647 2146694131 2146694129 4254834329 4294967295 4294177778 4291940816 4291940816 4291940816 4291940816 4291940816 4291940816 4294177778 4294967295 4288257175 2107219353 2147483647 2146694129 2144457169 4254768536 4294967295 4294177778 4294177778 4294177778 4294177778 4294177778 4294177778 4294177778 4294177778 4294967295 4288257175 2107219353 2147483647 2146562545 2146562545 4254834329 4294967295 4294177778 4291940816 4291940816 4291940816 4291940816 4291940816 4294177778 4294177778 4294967295 4288257175 2107219353 2147483647 2146562545 2144325583 4254768536 4294967295 4294177778 4294177778 4294177778 4294177778 4294177778 4294177778 4294177778 4294704123 4294309365 4288257175 2107219353 2147220475 2146430959 2146430959 4254834329 4294967295 4294177778 4291940816 4291940816 4291940816 4291940816 4291940816 4294046193 4294572536 4291743694 4288257175 2107219353 2146825717 2146957301 2146825717 4254834329 4294967295
4294177778 4294177778 4294177778 4294177778 4294177778 4288520347 4288520347 4288520347 4288520347 4288257175 1352639388 2140904857 2140904857 2140904857 4254768536 4294901501 4294177778 4294177778 4294177778 4294177778 4294704123 4289243814 4294704123 4294572537 4293454312 4288257175 16777215 16777215 16777215 16777215 4221214104 4294704122 4294177778 4294177778 4294177778 4294704123 4294704123 4289243814 4294704123 4293519848 4288257175 3432619159 16777215 16777215 16777215 16777215 4221214104 4294375158 4294572536 4294506743 4294835708 4294769916 4292664540 4289243814 4293454312 4288257175 2140773783 16777215 16777215 16777215 16777215 16777215 2744950939 4288322968 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 3214580887 2140773783 16777215 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallCutIcon (in category 'accessing - icons') -----
- smallCutIcon
-
- ^ Icons
- at: #smallCutIcon
- ifAbsentPut: [ self smallCutIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallCutIconContents (in category 'private - icons') -----
- smallCutIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 2086296920 4270888083 4169895821 16777215 16777215 16777215 16777215 3580785006 4271151255 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4288060314 4294440951 3950673018 3178000237 16777215 16777215 16777215 4254110610 4292401881 4018045312 16777215 16777215 16777215 16777215 16777215 16777215 4288257693 4292467931 4293980656 3833232506 16777215 16777215 1851284056 4290165433 4291744465 4288060571 16777215 16777215 16777215 16777215 16777215 16777215 4271217305 4290626241 4294441207 4186343815 3178000237 16777215 4288257693 4292073430 4290297019 4169435271 16777215 16777215 16777215 16777215 16777215 16777215 1700288598 4288323486 4292928482 4294046449 4001268610 3597693552 4290823620 4292204502 4288257693 3177671015 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4220227726 4290757570 4294572537 4271151254 4289441710 4290823106 4290823363 3900144248 16777215 16777215 16777215 16777215 16777215 16777215 16777
215 16777215 1549162838 4288257693 4293257190 4294309621 4289178795 4290033847 4287994521 1549162838 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3698554484 4290954692 4293651948 4290165433 4288389279 3580785006 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2539610207 4288060314 4291744208 4290625727 4283997890 1549162838 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2134145207 4266566084 4283212999 4287417300 4292537599 4292537599 4266631363 2134145207 16777215 16777215 16777215 16777215 16777215 16777215 2134145207 4288667371 4292537599 4292537599 4283213770 3744684890 4285454303 4292537599 4292537599 4292537599 4283212999 2134145207 16777215 16777215 16777215 2134145207 4288667371 4292537599 3945492591 4287941348 4279934652 16777215 458557696 4292537599 4283279307 4118390190 4292537599 4283212999 2134145207 16777215 16777215 4268539848 4292537599 3125100092 16777215
4287941605 4280000187 16777215 16777215 4283212743 4272087534 16777215 3057990715 4292537599 4281899979 16777215 16777215 4280130745 4288734706 16777215 3477099345 4292537599 4281899979 16777215 16777215 4281899979 4290041584 3544143702 16777215 4292537599 4281899979 16777215 16777215 4281899979 4292537599 4288734706 4292537599 4245856928 1549473302 16777215 16777215 1549473302 4269132498 4292537599 4292537599 4292537599 4245727654 16777215 16777215 16777215 4281899979 4280195254 4280130488 1549473302 16777215 16777215 16777215 16777215 2538548780 4281899979 4281899979 4281899979 16777215 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallDebugIcon (in category 'accessing - icons') -----
- smallDebugIcon
-
- ^ Icons
- at: #smallDebugIcon
- ifAbsentPut: [ self smallDebugIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallDebugIconContents (in category 'private - icons') -----
- smallDebugIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2134145207 16777215 16777215 4231297207 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2134145207 16777215 16777215 4231297207 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2134145207 16777215 16777215 4231297207 4231297207 16777215 2134145207 4231297207 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2134145207 4231297207 4290304767 4290304767 4231297207 4231297207 4231297207 16777215 4231297207 4231297207 4231297207 16777215 16777215 16777215 16777215 16777215 16777215 4231297207 4290304767 4231297207 4290304767
4290304767 4290304767 4231297207 2134145207 16777215 16777215 16777215 16777215 16777215 4231297207 16777215 16777215 16777215 4231297207 4290304767 4290304767 4290304767 4290304767 4290304767 4231297207 16777215 16777215 16777215 16777215 16777215 16777215 4231297207 2134145207 2134145207 4231297207 4290304767 4290304767 4281694904 4290304767 4290304767 4290304767 4231297207 16777215 16777215 16777215 16777215 16777215 16777215 4231297207 4231297207 4231297207 4290304767 4290304767 4290304767 4281694904 4290304767 4290304767 4231297207 4231297207 4231297207 4281628855 16777215 16777215 16777215 16777215 16777215 16777215 4231297207 4290304767 4290304767 4290304767 4281694904 4290304767 4231297207 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4231297207 2134145207 4231297207 4290304767 4290304767 4290304767 4285966811 4231297207 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4231297207 16777215 16777215 4231297207 4231297207 423129
7207 4231297207 2134145207 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4231297207 16777215 16777215 16777215 4231297207 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4231297207 16777215 16777215 16777215 4231297207 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4231297207 16777215 16777215 16777215 16777215 16777215 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallDeleteIcon (in category 'accessing - icons') -----
- smallDeleteIcon
-
- ^ Icons
- at: #smallDeleteIcon
- ifAbsentPut: [ self smallDeleteIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallDeleteIconContents (in category 'private - icons') -----
- smallDeleteIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1382511397 4284837928 4284837928 4284837928 4284837928 4284837928 4284837928 4284837928 4284837928 4284837928 4284837928 4284837928 4284837928 1986424869 16777215 1449488679 4287666543 4292994782 4292994782 4292994782 4292994782 4292994782 4292994782 4292994782 4292994782 4292994782 4292994782 4292994782 4292994782 4288192890 1147498793 4284837928 4292994782 4287139466 4285493612 4285625199 4285822577 4285954164 4286151542 4286283129 4286480507 4286612094 4286809472 4286941059 4290691515 4292994782 4284837928 4284837928 4292994782 4284112991 4285888370 4286019958 4286283128 4286414715 4286612094 4286809473 4287006852 4287072902 4287270280 4287336074 4289243813 4292994782 4284837928 4284837928 4290955444 4292994782 4292994782 4292994782 4292994782 4292994782 4292994782 4292994782 4292994782 4292994782 4292994782 42929
94782 4292994782 4290231460 4284837928 2590339368 4284837928 4288851047 4287338045 4287206716 4287075131 4286877754 4286614585 4286416951 4286022196 4285693233 4285495344 4285363760 4285035308 4284837928 2590207782 16777215 4284837928 4291812235 4290760282 4290760282 4290694233 4289904210 4289970017 4290232690 4289115217 4288325447 4287733059 4287272512 4288324968 4284837928 16777215 16777215 4284837928 4291812235 4290760282 4290760282 4290628441 4291022450 4292731857 4292731857 4292074155 4289575523 4288983124 4288391252 4288324716 4284837928 16777215 16777215 4284837928 4291943566 4290760282 4290760282 4292140202 4291088506 4290627953 4292139948 4292205742 4289509987 4289246047 4288917339 4289574266 4284837928 16777215 16777215 4284837928 4292009105 4290957409 4291220332 4292600262 4292731857 4290365032 4290101861 4290101613 4290956176 4289114972 4288719960 4289903745 4284837928 16777215 16777215 4284837928 4292337822 4291286129 4291286127 4292534726 4291285891 4290430569 42919425
78 4290232689 4292468932 4288983643 4288390740 4290100612 4284837928 16777215 16777215 4284837928 4292403360 4291220334 4291154541 4291154294 4292205742 4291614119 4292600263 4292534470 4290035573 4288786006 4288259408 4289772418 4284837928 16777215 16777215 4284837928 4292206493 4291154538 4291022952 4290693989 4290365026 4290036063 4291679916 4289378136 4288983381 4288654161 4288127821 4289705854 4284837928 16777215 117440512 4284837928 4206542989 4292140187 4291943322 4291876761 4291614359 4291416725 4291284884 4291021715 4290890129 4290692752 4290363789 4204569458 4284837928 100663296 16777216 2103470115 4284837928 4284837928 4284837928 4284837928 4284837928 4284837928 4284837928 4284837928 4284837928 4284837928 4284837928 4284837928 2120049952 33554432)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallDoItIcon (in category 'accessing - icons') -----
- smallDoItIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallDoIt'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallDoItIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallDoItIconContents (in category 'private - icons') -----
- smallDoItIconContents
- "Private - Method generated with the content of the file /home/dgd/smallDoIt.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABl0
- RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAAMRSURBVDiNfVNbaFRXFF3n3DNz
- r3cm10nsaJxYMU5joon4QvGZYjUGtLZEBWkiRWwj+iEq4odIW6S0P/VXEIvFDzP4iB/6IRLR
- ZDCjVpsJksekKsaQaXwlmceN9c6duWf7EQ0y2O6/zVqstdl7bUZE+L+qXzW3GEAFgM5QJJbK
- x1m+wJ7ayl+IaCdj7HZ6TB4wvPyvJVWqO9qTyaRMuTYUif39IZ/nuW0JzhT7ThzzB5YtcG90
- CYS/WqcXNW43iuo26MWJ11ZD/gQir896dEVyIdBQV6gvX2QHPyt1QzKG+AuZ0VVl457aygYC
- Os0xWR+KxGzxznmmz+BnfAbH44GsJK5AuIHyOeP6BGDrJp82I+BetGKJh5+7nAy03jX3A/hN
- AMBkQzn7XcMnqwt9ghV4OIgLXLgyaoXvmHYuR1hfbajbvixUv6hWOQAESzW15XZyHWPsuAAA
- KVFaXu5h6jiOe1FTXmtLDjWFHx5kDP1ZZ86Piotvrts0RQ1HUnbTpZGRtq6hZgCCA4Ak+uHw
- TwOJyL3XNnGBrphldT9NnJdE4Zwju3I2+/npgG0SF7BsBoDxpbOnDRNRlgPA7y09ZzIZ+qPj
- wViGuILi6ZrqNyZNJ6IUAGgaX6npwkVcQU2N3/3rsbJpJVP104wxJgDg28/nba+c593d2Dir
- gDjHmmq/cr8jvW13bVWh28Wl1yvW7tjx6WTiCgDAY3DQ+AXH1+w4pAZKJgmX5kIqnUVBgQtH
- jlZ4e7rTX3s8AoESDZqm4OLFuNXaOpzjnLEnz9LNABwBAEQ4394+eijamSodTdjO0mVF7l3f
- B/WqhVMmAkIA0mMSj4eSJyN9z05LIg7gCQeAUCSWMc3c4pY/48sfDiaPMs6zxBUMxi3s29vx
- prk5niGuIFhmqH6fXuZI2UdEvUQkJ5IYisQcAL31q+Y6fb3pXGc0hZvX/3nT3T9yim5gQ9eD
- ZMnwK8tq7xm6yhhTiMj56DO9S+ZCEnTk+ei/Zlv3YNM3KytuPXqemB/tf+mRRI+I6MV77kcF
- JkDGBBHl/pMA4C2oHVtvUbiwmAAAAABJRU5ErkJggg=='!
Item was removed:
- ----- Method: MenuIcons class>>smallDocumentClockIcon (in category 'accessing - icons') -----
- smallDocumentClockIcon
-
- ^ self fugueDocumentClockIcon!
Item was removed:
- ----- Method: MenuIcons class>>smallExpertIcon (in category 'accessing - icons') -----
- smallExpertIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallExpert'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallExpertIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallExpertIconContents (in category 'private - icons') -----
- smallExpertIconContents
- "Private - Method generated with the content of the file /home/dgd/smallExpert.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAACS0lEQVR4nJWRu09TcRTHP+1tL33QVkjB0lqN
- QABRiiE6SDCEElJcYWbV4GRSw9zBP8BFSRwk6mCiI4Mp0dCQaHwwgQllACqlPEIfVOhte3vb
- n4M0ImICZzq/c36f73lJnMHehJDfRiiLGW44nGRGfMj6swjU1qObfoSHNWJ2lcZ7z1B0p4W/
- PsEraTR61yg7BWHFwsRKM3On5X0+Jx/uXiM3NYRYGuPTx4c0AvyvAxm4CnQDWeAxsNpgZrLX
- w/eZH9ieB1GlFRZOgseQSNY214pWf6twd7oFIID3wOXDP9dDIfQCdMc7eMo5xj13PPR099Du
- biefyBOdjyLbZcIvw0qlXLkFfyobjsCjyIxzG1wXXTTVNdFyvoWOng7Mo2ZiuzEKhYJl9vXs
- K+AmoAIcPeMEV8BoNVJjrMEsm7Fb7HjqPbS526iz1jEwMoCl3uIDAlWoKmAAfDRAqVyiWCqS
- V/NklSzxVJxoIkrqIIWiKji8DoDe4yNYARPy70fyZ5LN9CY2k428mscoGUntp4in4miSBuA8
- LpAFVsjQghXWU+uYZBOlcomtvS0kvcR+fp+N9AaZRAbg80lLnGaVB1wAIQTLm8vs5fZwWBzo
- 9XqUosJ2bBttV8sB4Sp09IxmYJ4uOungXysAc0CW+8BkNSxVnVAopDcYDEs7iztdpa1SE4bD
- 7AEQB90XnXrJeWkqGAy+6+/vVyORSO4vgUAgYHe5XA19fX0LxXRxmzjFynJFsiVtCa/R+214
- aPjF4ODgohBC1jRN8fv96UgkIn4BMVjYCuwVUJAAAAAASUVORK5CYII='!
Item was removed:
- ----- Method: MenuIcons class>>smallExportIcon (in category 'accessing - icons') -----
- smallExportIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallExport'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallExportIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallExportIconContents (in category 'private - icons') -----
- smallExportIconContents
- "Private - Method generated with the content of the file /home/dgd/smallExport.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABl0
- RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAAJTSURBVDiNlZPNTxNhEMaf2d2y
- 29IWW6rAoiEhVRP5sBIlcqgHL0YTrScvePDEyZuJqf+BB2/ExHjxwFUTKtFEkyZgoySgpGCU
- AEK4uKLUVtvdbbfd3fEgEChN0Oc4mfc3z8w7Q8yMRgrGFRnATQA5ADPFTOVbozxqBAjGlSE1
- 1vY0erpbbfepmExPlX4s564WM5WpAwGBC/K18EXfuO9UE9UKNkgU0NPVh6X0mvX17cYVAOsA
- 1ouZigsAQj1RbpdGPapA5moVuefmRz1b0RcWs1DOsexpE9NSRFglkR9t5+8BpNRwgLVatjhj
- FQsvy7d/vSj3G/O1QfNzzdF/m4je6kTizmUIihjYfiPtKc/87MlqcxevUSSh6bVgXPGKIZpQ
- opLoaRGhiAp0S4djuF/2OUip4WGJecBnO4cB3N0KH1KOSRFRITCAUq2E7EIWANJ7hphSw61g
- XurN637ZdeUPkaAJolhCy68E48rxJlWY9g/IrXKnB/lX5uzmmD5Y7+BByLKNUNWWfbaLTsMy
- wPwYAIqZykpVc0/8nLBGN8asudJy/yjFks07DsY7QlEAK5LjFgTABkAAxKoohABcSmj513Tm
- 3kMwj+yamUNE48x8Y7uFHgCeuh9lAIvXj4wMAZiMnT2P9o6jICLkNr9jdvoNAxiWACCh5T/V
- 78OOYskQAHRHT0IU/xrwB4KYm3nnOI7dsm+R/lf/AnABwND1nUC5bMJ1HQGA2/CYdotiSZlI
- eM/s9nq9PgtEKJtGExFpzNx3IGAL4gcQBzCw5XoeQIaz9wt/AFR4+5g8QPOiAAAAAElFTkSu
- QmCC'!
Item was removed:
- ----- Method: MenuIcons class>>smallFindIcon (in category 'accessing - icons') -----
- smallFindIcon
-
- ^ Icons
- at: #smallFindIcon
- ifAbsentPut: [ self smallFindIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallFindIconContents (in category 'private - icons') -----
- smallFindIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 3500845735 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 2879299995 16777215 16777215 16777215 16777215 4254834329 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4288257175 16777215 16777215 16777215 16777215 4254768536 4294967295 4294177778 4294177778 4294177778 4294177778 4294177778 4294177778 4294177778 4294177778 4294967295 4288257175 16777215 16777215 16777215 16777215 4254834329 4294967295 4294177778 4291940816 4291940816 4291940816 4291940816 4291940816 4291940816 4294177778 4294967295 4288257175 16777215 16777215 16777215 16777215 4254768536 4294967295 4294177778 4294177778 4294177778 4294177778 4292796125 4287862162 4287862162 4287862162 4287862162 4287927954 16777215 16777215 16777215 16777215 4254834329 4294967295 4294177778 4291940816 4291940816 4290164917 4287862162 4290430675 4289841372 4289578718 4290037208 4287862162 155225510
6 16777215 16777215 16777215 4254768536 4294967295 4294177778 4294177778 4292796381 4287862162 4290036947 4288002781 4291288045 4291682288 4289119970 4288461783 4287862162 830636669 16777215 16777215 4254834329 4294967295 4294177778 4291940816 4287862162 4289772744 4287674587 4292996085 4293718521 4293456120 4291944945 4288200674 4255366615 4287862162 16777215 16777215 4254834329 4294967295 4294177778 4294177778 4287862162 4289578459 4289711079 4292864501 4293193462 4293061877 4291419375 4289383143 4270634460 4287862162 16777215 16777215 4254768536 4294901501 4294177778 4294177778 4287862162 4290038751 4289711336 4292338931 4292864758 4292142066 4291813617 4291156462 4253726428 4287862162 16777215 16777215 4221214104 4294704122 4294177778 4294177778 4287862162 4289970895 4287936987 4290565356 4291551216 4291419376 4292273395 4289645027 4221615577 4287862162 16777215 16777215 4221214104 4294967295 4294967295 4294967295 4292401366 4287862162 4289381852 4288463072 4290367719 4290499818
4289447648 4288856541 4287862162 3800664454 16777215 16777215 2744950939 4288322968 4288257175 4288257175 4288257175 4287665037 4287862162 4290630372 4288068314 4287281116 4289052891 4287862162 4289901490 4289901490 3632300413 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2306834557 4287862162 4287862162 4287862162 4287862162 4288585629 4291151300 4289901490 4289901490 4288059028 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4288585629 4291151300 4289901490 4288059028 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 33554432 4288585629 4288585629 4288059028)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallFontsIcon (in category 'accessing - icons') -----
- smallFontsIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallFonts'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallFontsIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallFontsIconContents (in category 'private - icons') -----
- smallFontsIconContents
- "Private - Method generated with the content of the file /home/dgd/smallFonts.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAABw0lEQVR4nNWRP0xTURTGv3vP+8Pro9CqQ1Pw
- 34tplIGYgIZASZogFWpinEy0mGCJiX+Cg4uM3R1MHNwMMwMrcRAGFhwaEjVRQTSS1DQMbaWN
- 0tf77r0OakUWWDnJGb58J79zvhzg0BftFuPj03an5/XHI6erpdK6OAiA7xYVXZ8KtXW+Vu3W
- 44Ne8B+AOM8BgON2TOz10ulbbipzP7YX0IqQzNxJCOEnORlHiYx4JBpb3Sp+WgOAgbHJR4Lo
- 2U6j1nPy3MUnXV7vZScRn69sbMjWFqnFvWr52wspmrMA4IQjd/96vt94U1xfzRaW5nIqCOYs
- 27kSqltT/yLk85wxlmqPHiuRZS0C0Kbjjnh9yRMAEA5HKt2J/pnBzO1lTubV33HJawGGCsUx
- KcR3JnFzp1YdFU3/LQOzouHYNABIKWY58esfVhYegOnnAKC15gBgAIBSavLr58LDrS8f3wHA
- hdHsiAn7le123AAwo5TcNsgwvd7hs8ToGgAwzttSqbxBA+mJrNbqkuse6S5tvl8AgONnzueC
- ps8CIcqxUz3Jxo/6U61UFyPq+1krvwyk8Bnnoer22iYAMADmn97v5fY+M4exfgFP/5Zri/7V
- SwAAAABJRU5ErkJggg=='!
Item was removed:
- ----- Method: MenuIcons class>>smallForwardIcon (in category 'accessing - icons') -----
- smallForwardIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallForward'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallForwardIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallForwardIconContents (in category 'private - icons') -----
- smallForwardIconContents
- "Private - Method generated with the content of the file /home/dgd/smallForward.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAABr0lEQVQ4jb3ST0uUcRTF8c/jPDPqlKORiqSt
- JqSNRfM0LlqElkRtItAIa9HWF9DKXkCbIAQhIohoURQFtQ2iYDYZkpAEUS1CamOBjppmOvNr
- MZRUi/5And2F+z33cO/ln6tXt6KBv4N365SYkwgKbivq+LElAnv1YUjQLrIkWEAdBrVkthnt
- YfwFMx/nRM6YdGXDomifxIrBzcFwLjiaDQ5mgr500J8OxvIhE46FsfV7IR7vDopRkLjsuFQt
- QeKiVDTSUhpyMtOvS6u02IJlT7z0yLRVaw7YZacu1x/eND9aYq161ycnIokJjalepSPqpW3X
- ql7arLL3yj+tpV2z2TvPODcN52ORipUKryasVta9DlWiOuI0cYaGJjry3wxmlcnHtSJoigVv
- wbs1mpdRJVQIYWNsNkeujdVl3jzn0nzNK3Y2kjiNq9/lbEixNaYjxUgjqSWyLSx+oJTl2mJZ
- 1YApk7UzJgqCHeo0qKqIfBZ0ilxwagv750ilub+JW/OLgkOeevzrR0pM6Y2CG7lguD5IzEgU
- fg1+VcFhiRWJIPHAHm2/D2+kyEv0/Dn4v/QF8kyGaRoL4uEAAAAASUVORK5CYII='!
Item was removed:
- ----- Method: MenuIcons class>>smallFullScreenIcon (in category 'accessing - icons') -----
- smallFullScreenIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallFullScreen'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallFullScreenIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallFullScreenIconContents (in category 'private - icons') -----
- smallFullScreenIconContents
- "Private - Method generated with the content of the file /home/dgd/smallFullScreen.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAADIklEQVR4nH2TTWhcVRzFz//e++7Me+1MxkxS
- 0jR0nJZSbI0am07c2OomI7HrilB0GVy5kJDtZJNVEHQTcONKF2otlGmUEhoQSUtClTAWalJp
- Pmtik/l47828efM+/m6yiFA8cDaHw1n84BAAMDNNTU2ZWutjWmsrCALDNE3HNM3q+Ph4gP8R
- TU9P90oprwHIARBHHBJRi5nrQog9rfVap9N5OjEx0fzPwMzMTG6nuvVp+dmPH/fnTiad9ebO
- Bxc++uVIJwbgMbMNYJ+INpj5t8nJyS0iYjk6OnpybXf12vbQ6mU+7xvVf+rd/UFuP22mIyIC
- AAagiShFRD1E1EtEpxcXF7PFYrEq4ji2rIRFkR3B3nBx7t08/dS4ddULvB4AJwD0AegCoABI
- Zu6N4/jNOI4vM/NZRURGvuesnX80uOqppvXEezLgd1hpqWMAICIJ4DgzHwNgA3CJKH2YaUVE
- YcJIBO+9+v5TIQQeri+5sd9OLMz9MAgiYZkWeW2/menudc9deH03ne5yD9n4YRiGKgzDkIg6
- RGQws3Xp5YKz8uDeqTvz91PKMAAAraaLysoy5m5/f/Hu7Tsbr7w2sjmQO+MqpTxFRB0hhB/H
- sRRCSAAwrWRi6VkVXzeycCKB00kTQ6cK+OSzM+LDG5v57779Jr8wd9MYLFwtKwCNKIr2AdSZ
- uYuIglS6S246LsJAISUktpvAhkO4K9O4nu7D8PAw7IbTr5RqKc/zqpZl7QA4OKSuojDg4ypE
- MRWhS0vUgwjL+y10AFTaBoa0xt+7e3YGmQNRKpXazLzGzAfM/JiZ9xzb9nuojazyICMbL8kW
- BlM+BgwbGdmElBLr61vPZ2dn6woAMpnMSq1WSwohiswc1WqNR1lCIYyqiEmCmZBLCJyQIZIc
- od1qot5w/wDAEgDK5XI8Pz+/OTY29lgI4Wid6Cz9eq9QvPK2UtyAZBeafJjko08aqCwt88KD
- Sqlet/+iFz2sVCqpPysPz9vV7a9G3iqMvDF8SXZnMxBSI/Da+PLzL36/+fP9dwDYLxw4qouA
- drK4EofIsYBBgPLauHXgYQcA/gWOnHIlydMKjQAAAABJRU5ErkJggg=='!
Item was removed:
- ----- Method: MenuIcons class>>smallFullscreenOffIcon (in category 'accessing - icons') -----
- smallFullscreenOffIcon
-
- ^ Icons
- at: #smallFullscreenOffIcon
- ifAbsentPut: [ self smallFullscreenOffIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallFullscreenOffIconContents (in category 'private - icons') -----
- smallFullscreenOffIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 3597627500 4288322713 4288322713 4288322713 4288322713 4288322713 4288322713 4288322713 4288322713 4288322713 4288322713 4288322713 4288322713 4288322713 4288322713 3597627500 4288322713 4294966267 4294966267 4294966267 4294966267 4294966267 4294966267 4294966267 4294966267 4294966267 4294966267 4294966267 4294966267 4294966267 4294966267 4288322713 4288322713 4294966267 4290033079 4290033079 4290033079 4290033079 4294045933 4294045933 4294111726 4294111726 4290033079 4290033079 4290033079 4290033079 4294966267 4288322713 4288322713 4294966267 4290033079 4290033079 4290098872 4294045933 4294045933 4294111470 4294177519 4294177519 4294177519 4290098872 4290033079 4290033079 4294966267 4288322713 4288322713 4294966267 4290033079 4290098872 4290362044 4290822852 4294111726 4294111726 4294243312 4294243312 4290559423 4290296251 4290033079 4290033079 4294966267 4288322713 4288322713 4294966267 4290033079 4294111726 4290757059 4291612368 4292270298 4294177519 4294178289 42
92072919 4291480782 4290691266 4294309105 4290098872 4294966267 4288322713 4288322713 4294966267 4294177519 4294177519 4294243312 4292270298 4292730849 4293125607 4293191400 4292928228 4292270298 4294374898 4294113010 4294374898 4294966267 4288322713 4288322713 4294966267 4294243312 4294243312 4294308849 4294178289 4293059814 4294309105 4294374130 4293191400 4294440435 4294440435 4294440691 4294178803 4294966267 4288322713 4288322713 4294966267 4294440691 4294440691 4294440691 4294506228 4293257193 4294505716 4294572277 4293651951 4294571509 4294376182 4294638070 4294637302 4294966267 4288322713 4288322713 4294966267 4294506484 4294506484 4294571509 4292007126 4292862435 4293454316 4293651951 4293322986 4292533470 4294638070 4294703863 4294637302 4294966267 4288322713 4288322713 4294966267 4290033079 4294572277 4290559423 4291086024 4291941333 4294571509 4294637302 4292401884 4291349196 4290559423 4294703863 4290033079 4294966267 4288322713 4288322713 4294966267 4290033079 429003307
9 4290164665 4290427837 4294376182 4294638070 4294703095 4294768888 4290362044 4290098872 4290033079 4290033079 4294966267 4288322713 4288322713 4294966267 4290033079 4290033079 4290033079 4294703863 4294637302 4294441975 4294768888 4294834681 4294834681 4290033079 4290033079 4290033079 4294966267 4288322713 4288322713 4294966267 4290033079 4290033079 4290033079 4290033079 4294769656 4294769656 4294900474 4294834681 4290033079 4290033079 4290033079 4290033079 4294966267 4288322713 4288322713 4294966267 4294966267 4294966267 4294966267 4294966267 4294966267 4294966267 4294966267 4294966267 4294966267 4294966267 4294966267 4294966267 4294966267 4288322713 3647762028 4288322713 4288322713 4288322713 4288322713 4288322713 4288322713 4288322713 4288322713 4288322713 4288322713 4288322713 4288322713 4288322713 4288322713 3698093161)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallFullscreenOnIcon (in category 'accessing - icons') -----
- smallFullscreenOnIcon
-
- ^ Icons
- at: #smallFullscreenOnIcon
- ifAbsentPut: [ self smallFullscreenOnIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallFullscreenOnIconContents (in category 'private - icons') -----
- smallFullscreenOnIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 2576981400 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 2576981400 4288257175 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4288257175 4288257175 4294967295 4281563063 4281563063 4281563063 4281563063 4294046192 4294046192 4294111985 4294111985 4281563063 4281563063 4281563063 4281563063 4294967295 4288257175 4288257175 4294967295 4281563063 4281563063 4281760184 4294046192 4294046192 4294111728 4294177777 4294177777 4294177777 4281760184 4281563063 4281563063 4294967295 4288257175 4288257175 4294967295 4281563063 4281760184 4282942140 4285175492 4294111985 4294111985 4294243571 4294243571 4283861695 4282679483 4281957047 4281563063 4294967295 4288257175 4288257175 4294967295 4281628855 4294111985 4284912835 4287672272 4289643482 4294177777 4294243827 42
89052375 4287080654 4284584386 4294309364 4281825720 4294967295 4288257175 4288257175 4294967295 4294177778 4294177778 4294243570 4289511898 4291023329 4291943399 4292206568 4291286500 4289446362 4294375157 4294309621 4294375157 4294967295 4288257175 4288257175 4294967295 4294243570 4294243571 4294309107 4294243827 4291877862 4294309363 4294374901 4292272104 4294440693 4294440693 4294440949 4294375414 4294967295 4288257175 4288257175 4294967295 4294440949 4294440949 4294440950 4294506486 4292141033 4294506487 4294572536 4292863983 4294572537 4294572793 4294638329 4294638073 4294967295 4288257175 4288257175 4294967295 4294506743 4294506742 4294572280 4288461014 4290892259 4292535020 4292995311 4292009706 4289840862 4294638329 4294704122 4294638330 4294967295 4288257175 4288257175 4294967295 4281628855 4294572536 4283664831 4285701320 4288198101 4294572537 4294638330 4289381084 4286292684 4283599039 4294704122 4281563063 4294967295 4288257175 4288257175 4294967295 4281563063 428175992
7 4282219705 4283204797 4294572793 4294638329 4294704123 4294769659 4282942140 4281825720 4281563063 4281563063 4294967295 4288257175 4288257175 4294967295 4281563063 4281563063 4281563063 4294704122 4294638330 4294638586 4294769916 4294835452 4294835452 4281563063 4281563063 4281563063 4294967295 4288257175 4288257175 4294967295 4281563063 4281563063 4281563063 4281563063 4294769915 4294769915 4294901245 4294835709 4281563063 4281563063 4281563063 4281563063 4294967295 4288257175 4288257175 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4288257175 2643827092 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 2694091921)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallHelpIcon (in category 'accessing - icons') -----
- smallHelpIcon
-
- ^ Icons
- at: #smallHelpIcon
- ifAbsentPut: [ self smallHelpIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallHelpIconContents (in category 'private - icons') -----
- smallHelpIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 16777215 672815513 2232900251 3306642333 4061617052 4061617052 3306642333 2232900251 672815513 16777215 16777215 16777215 16777215 16777215 16777215 33587328 2031573916 4113327778 4254773454 4291285987 4293849847 4293849847 4291285987 4254708174 4130104994 2014796699 33587328 16777215 16777215 16777215 33587328 3289865116 4133981369 4293455348 4290102746 4285699261 4282479274 4282479274 4285699261 4290168539 4293520883 4134047161 3289865116 33587328 16777215 16777215 2031573916 4134441147 4293652469 4284844728 4283530415 4291549157 4294178297 4293586676 4289971418 4283925171 4285633726 4293718518 4150890169 2031573916 16777215 672815513 4113459107 4293521140 4284779191 4279720860 4286159552 4294835710 4292732142 4294112760 4294967295 4291286244 4282151596 4286094019 4293586933 4130236322 672815513 2232900251 4271748304 4290102746 4279720860 4279720860 4283793842 4283925171 4281626024 4284845241 4294967295 4294770173 4283334836 4283071922 42
90892002 4255234002 2232900251 3306642333 4291417573 4285699261 4279720860 4280574624 4281165988 4281822889 4282348973 4288065743 4294967295 4293718262 4283729335 4283860408 4287869136 4291812328 3307101598 4061617052 4293981175 4282085031 4280311967 4281165988 4281823145 4282414509 4286225605 4294638845 4294901502 4287606223 4284386493 4284518078 4286095046 4294112761 4061748381 4061617052 4293981175 4282216616 4280903075 4281757096 4282348973 4283006130 4293718518 4294967295 4289512155 4284846529 4285109698 4285241284 4286752203 4294178298 4061944989 3306642333 4291417573 4286027967 4281363109 4282151595 4282874544 4284188857 4291878122 4292009707 4285372612 4285438406 4285701320 4285898697 4289183708 4292141036 3307167391 2232900251 4254971088 4290365661 4281757352 4282480557 4283269044 4284254907 4288460756 4288723928 4285569735 4285964490 4286358733 4286555855 4291944429 4255957466 2233031837 672815513 4130236323 4293586933 4285962689 4282874544 4283597493 4285437634 4294967295
4294967295 4286292940 4286424783 4286884818 4289250528 4293981433 4130433443 672815513 16777215 2014796699 4134572988 4293784054 4286554310 4283794871 4285635011 4294967295 4294967295 4286621647 4286884818 4289447393 4294178811 4151876034 2015125149 16777215 16777215 33587328 3289865116 4151415997 4293784054 4291089381 4288197844 4286423754 4286949839 4289381599 4292141550 4294112762 4152270533 3290652832 33587328 16777215 16777215 16777215 33587328 2031573916 4130367396 4272471510 4292075243 4294178554 4294244347 4292403949 4256351709 4130630309 2015256221 33587328 16777215 16777215 16777215 16777215 16777215 16777215 672815513 2232900251 3306970782 4061879709 4061879709 3307233441 2233031837 672815513 16777215 16777215 16777215 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallHomeIcon (in category 'accessing - icons') -----
- smallHomeIcon
-
- ^ Icons
- at: #smallHomeIcon
- ifAbsentPut: [ self smallHomeIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallHomeIconContents (in category 'private - icons') -----
- smallHomeIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 1291782669 4290904064 4290904064 2180975120 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1291782669 4290904064 4294904335 4294904335 4290904064 1291782669 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1291782669 4290904064 4294904335 4287978586 4288768873 4294904335 4290904064 1291782669 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1291782669 4290904064 4294904335 4289883499 4288059284 4289440682 4292057497 4294904335 4290904064 1291782669 16777215 16777215 16777215 16777215 16777215 1291782669 4290904064 4294904335 4289955460 4288717214 4291085765 4291677644 4291217093 4292128687 4294904335 4290904064 1291782669 16777215 16777215 16777215 1291782669 4290904064 4294904335 4290158236 4289704110 4291546058 4293190884 4293190884 4293190884 4292861919 4292264385 4294904335 4290904064 1291782669 16777215 129178266
9 4290904064 4294904335 4290228141 4289901233 4292993505 4293848814 4293848814 4293848814 4293783021 4293783021 4293717228 4293253336 4294904335 4290904064 1291782669 4290904064 4294904335 4290822334 4289835696 4292927712 4293651435 4293717228 4293717228 4293717228 4293651435 4293519849 4293519849 4293519849 4293716457 4294904335 4290904064 1740701696 4294904335 4293388776 4284967526 4284967526 4284967526 4284967526 4293717228 4287269773 4287138960 4287137928 4287138960 4287138185 4294440951 4294904335 1455489024 16777215 4284967526 4294243572 4284967526 4287665037 4287730830 4287796367 4293717228 4287138959 4286949841 4287137928 4286818512 4287073167 4294375158 4284967526 16777215 16777215 4284967526 4294177779 4284967526 4288059539 4288059539 4288059539 4293717228 4287073166 4285110471 4287137928 4283533503 4286941325 4294309365 4284967526 16777215 16777215 4284967526 4294111986 4284967526 4288191125 4288191125 4288453494 4293717228 4286811028 4281563063 4287137928 4281563063 4286
613908 4294309365 4284967526 16777215 16777215 4284967526 4294111986 4284967526 4288191382 4288191382 4288322448 4293717228 4290691267 4291086541 4291217352 4291152333 4289967027 4294309365 4284967526 16777215 16777215 4284967526 4294046193 4284967526 4288257175 4288257175 4288257175 4293717228 4289835441 4289901234 4289901234 4289901234 4289901234 4294309365 4284967526 16777215 16777215 4284967526 4294440951 4286085750 4289178277 4289243814 4289309350 4294309365 4294440951 4294440951 4294440951 4294440951 4294440951 4294769916 4284967526 16777215 16777215 2892392806 4284967526 4284967526 4284967526 4284967526 4284967526 4284967526 4284967526 4284967526 4284967526 4284967526 4284967526 4284967526 2540137061 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallInspectItIcon (in category 'accessing - icons') -----
- smallInspectItIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallInspectIt'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallInspectItIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallInspectItIconContents (in category 'private - icons') -----
- smallInspectItIconContents
- "Private - Method generated with the content of the file /home/dgd/smallInspectIt.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAACX0lEQVR4nKWST08TURTFT2f6nyntlJbWAq2h
- BYxUSAoblBg0rsTECiEkfgANSgyuXejaj2CMicaFhhhdINGYKAYQYjUYTG1EBIZph1JaSodO
- W9uZqSvISAYT41299847v3fuzQP+szQHD3wNtf2+o9Yhu03frNUSBp6vrJZF6cnUNPtCDaBV
- rG2dQef9sZFQX9/p5oLB6lmRqwa+xDMdk5OxS5IoR1bZ7eF4vJhQS0C1+unx188H+yr0ufdr
- 5LBBeYkqzZXq+YehkbFX62+mmB4A4p5GAgBNG++8fBo+L3kGp1lywHww5qZA10wu6G03wnnv
- x4VkY3JTmNjTCADobHd2N3rdCY64YFHrsyLJBJu1GCVrx/LxFnuvUiMAWNpa6LqCxsuqmQFA
- KPzSAcDiRqPJ5TI7AeiUAKfnCAVJY5IOA2R3BCMAVGQ9HLRZC8CqBKzMRzi+prrmUDOn0rwp
- 9oN1AUDAniww8VwKQPqPGURjmSW5lAlZq9Hd/b5FiYgtJ+xvZ7/6RVEm9ZDELvMXOs7ll5QP
- kACQ48vR+chGz/WBYluy4E7PLPJNc5+WfCyXpiVJJkx6qXzv2ShVM/7ZzpxsIKKxbEQoivF9
- AICdrUwpOheJnxnqSXV1eLitOqpYDjhyhXDw2+5F7yxtybnNuHqC6KV4K6MznF1niu+EUjl1
- 8CvbAs22260BOuRxU26djtRv7xQTCS4fJQnNsYkHV05RmTRZZRYrg4/XuZ+s0H7Y4PfSEYq9
- sdVPP/o+c3NXmr8s3r3VnQoG611/A6iW02kaDff7P/iaaq/9s1mtfgOeOPMUwSrvxgAAAABJ
- RU5ErkJggg=='!
Item was removed:
- ----- Method: MenuIcons class>>smallJumpIcon (in category 'accessing - icons') -----
- smallJumpIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallJump'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallJumpIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallJumpIconContents (in category 'private - icons') -----
- smallJumpIconContents
- "Private - Method generated with the content of the file /home/dgd/smallJump.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAABdklEQVQ4jcWSPUuCcRTFf/d51LSIgmfphSBo
- iobCBx16oSUaApemgqCGQGhq6wNEn6ChrakIWlskiKgpqCdqqKkXSlJCibA3M/U2aFZaEDR4
- xv8593DP/R+oNuRXxqYDxS6qHBzO/2Zg4xeXLJPV7jLlgSphHA6/Pptlw8MCO572RmtsYda0
- Jnq49L8h6UclmmkVmKaFPeI/bRPEkiC3xlzT82p+W1/1TRd1Q306qjwNKEuo2KjYxAhifYwZ
- JYMsIbxm3dT8nG9cBsmRZ41dXsiAYUIA6BWAZrKEKgwMIUBn/dOke4gkKby4aaC2QD4kAdBu
- /dQW4fp+KDG8eOhiBh81XJMAVbiLFXitTF7aIK/sc5KqW8lskSBVHM7DxQE83hX8nS/ail9o
- Iyo5wufRM/dzX6NJ+h6ujiGVKPC7IBEA4riY5YYXKO+BzbAIESwR7VdoAe5BjgROFSCnMILD
- Zil1RSgbv9TLOg/a8f0+Pxfp31WuPt4BdGiFIfxoncEAAAAASUVORK5CYII='!
Item was removed:
- ----- Method: MenuIcons class>>smallJustifiedIcon (in category 'accessing - icons') -----
- smallJustifiedIcon
-
- ^ Icons
- at: #smallJustifiedIcon
- ifAbsentPut: [ self smallJustifiedIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallJustifiedIconContents (in category 'private - icons') -----
- smallJustifiedIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 2862522779 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 2862522779 16777215 16777215 4288257175 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4289440683 4289440683 4289440683 4289440683 4289440683 4289440683 4289440683 4289440683 4294572537 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294440950 4294440950 4294440950 4294440950 4294440950 4294440950 4294440950 4294440950 4294572537 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 42
94572537 4294572537 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4289309097 4289309097 4289309097 4289309097 4289309097 4289309097 4289309097 4289309097 4294506743 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572536 4294506743 4294440950 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4294572537 4294572537 4294572537 4294572536 4294506743 4294440950 4294375157 4294309365 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4289309097 4289309097 4289309097 4289309097 4289309097 4289309097 4289309097 4289309097 4294309364 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294375157 4294375157 4294309365 4294309364 4294243571 4294177778 4294111985 4294046193 4294177779 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572536 4294506743 4294440950 4294375157 4294309365
4294309365 4294243572 4294177779 4294177778 4294111985 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294440950 4289309097 4289309097 4289309097 4289309097 4289309097 4289309097 4289309097 4289309097 4294046193 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294375157 4294177778 4294111985 4294046193 4294046193 4293980400 4293914607 4293848814 4293783021 4293980399 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294967295 4288454554 16777215 16777215 2862522779 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 2862522780 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallLanguageIcon (in category 'accessing - icons') -----
- smallLanguageIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallLanguage'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallLanguageIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallLanguageIconContents (in category 'private - icons') -----
- smallLanguageIconContents
- "Private - Method generated with the content of the file /home/dgd/smallLanguage.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAABlElEQVR4nMWRv0sbARTHP+bulOCQwaQnauoF
- rYGiDpa2Wtupg7q5Fsng/+CmODqUigouDuLg4L/goCBxiFkEtRXj0CVNuWhE6cn9MOZeB1NI
- S07qlC+84T34fHnf96DRaqozawE+Aa8ikchLTdOaS6XSN+AY2ASsxwxTuq7/XFz8LPn8d/F9
- V0Q8Mc28rK+vSSJh3AAzgXBvb49/eVkQEa9u2faNDA+/FWCu3tr24WE2EP5TppkXTdMEeA6g
- Vg3eGUZ3uF9R+PVlCTXehZowqBQvENtG6ezAy2RRYlHaPrxndHSEvb30R2AjVDVwXNflLneO
- 1vcCpV2n+c1rymc5lK5OvEwWymWaWlupFAo4jgvg1EZQAHN3Z1tEPPHvbh9Wrjh/974r52cn
- EgqFHKDt3zsM6fqz61zua2D+YvGHJJN9LjAe9AkjHA5nVleXxbKuxPddsawrOTjYl/n52fto
- NLoF9AfBAKiqmj09PZJ0elcGBwcqwA4wCUQeBauKT0yM+anUlAesAPH/gWo1DSwAsaeCjdNv
- pz0BrfQjq7kAAAAASUVORK5CYII='!
Item was removed:
- ----- Method: MenuIcons class>>smallLeftFlushIcon (in category 'accessing - icons') -----
- smallLeftFlushIcon
-
- ^ Icons
- at: #smallLeftFlushIcon
- ifAbsentPut: [ self smallLeftFlushIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallLeftFlushIconContents (in category 'private - icons') -----
- smallLeftFlushIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 2862522779 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 2862522779 16777215 16777215 4288257175 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4289309097 4289309097 4289309097 4289309097 4289309097 4289309097 4289309097 4294572537 4294572537 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 42
94572537 4294572537 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4289309097 4289309097 4289309097 4289309097 4289309097 4294572537 4294572537 4294572536 4294506743 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572536 4294506743 4294440950 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294440950 4294440950 4294440950 4294440950 4294375157 4294309365 4294309364 4294375157 4294309365 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4289440683 4289309097 4289309097 4289309097 4289309097 4289309097 4289309097 4294309365 4294309364 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572536 4294572536 4294506743 4294440950 4294375157 4294309365 4294309364 4294243571 4294177779 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572536 4294309365 4294309364 4294243571 4294177778
4294309365 4294243572 4294177779 4294177778 4294111985 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294440950 4289309097 4289309097 4289309097 4289309097 4294243571 4294177778 4294111985 4294046193 4294046193 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294375157 4294309365 4294309364 4294243571 4294177779 4294111986 4294046193 4294046193 4293980400 4293980399 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294967295 4288454554 16777215 16777215 2862522779 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 2862522780 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallLoadProjectIcon (in category 'accessing - icons') -----
- smallLoadProjectIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallLoadProject'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallLoadProjectIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallLoadProjectIconContents (in category 'private - icons') -----
- smallLoadProjectIconContents
- "Private - Method generated with the content of the file /home/dgd/smallLoadProject.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAADA0lEQVQ4jY2SW0zbZRjGf9+/358eKIUW6AE7
- SlvcxiImc8PIlnmKkmAyt5ktWaYx8cAu1At3ockWZ2I27iDemHjjMTEsgnE6ncQsJrhMM2RM
- kQnLQKRoS4GW0lJKD/T/eWe8EOJ7++b3vHne5xH8j2l56MjjhmF6QkBIYYwZQl2YunpxEsC0
- JXnsmOke966+XU3Os/aO4w3r7SeahMvrZ+7O87X+7So5Nzm8pcBO1843nzpQ9/K7r3jNDTua
- Xc/UjFf9WH/QW7r/iKN889vttf7wLW0LXjjsFafOnqgXCUuA8nKaVtsM+8wR0M0m/fgZuzC0
- V+Wm1x8+HPDVWUV8zU2hsooLyd2YSgYRw0l7dYxFm9t7S4jWTQVM6InpeDH1UzbgOOoaw+w8
- wBvZw/zQ8g5kkqTWFB0Wrbiphd+GBrLlYjFyfvKu+cvxe/l51c16WZIvCC7F7+N0v1peXS/1
- b/UDBMaLhc96ymfGGmMFw0RX7QhmY5We79KR769P/1m2r3eLrr10un3B3lp/yOkNNEtzZaWm
- 61JomgCBSC8l1ODlQUatj2Y8TmtFKbfmmM1MDUdDE/VMr+2XUuqd574cbREqDarAYux3ZkY+
- wtCqaXvkKLl8lmvRiJqc/XRgWtpkydZxkj23r9IVaOXQRKes99/dmFqJk1gpgTKwCI1CbgV7
- jRldK/LYh29x4+mUoDF4snRlKc9zA130VgU0iwsDhHR5/N50ZpmNsg9QFFWUBw+dQlAklVnC
- 7HWit4cpsQHNixY+dxYIaTL8l5cpjT9kPpvJBX02ssk73P7gEpVtYYQnxLMfv41UGsFcgbkF
- Mw2eMCPBLL7dbumPVDHR/fV17PwqkwuRGIZivG+QB3q+YnjvNrb1v8R8fIk2TxNWn5XZ3pny
- L/tmTcb54aEo9EcVCzj4hiHyMp2Yj61mNmh74SA33DUE9+xAaE6uvNYNqgBaNXXj76Wvnbt4
- GsEnjJL7d9RSCfpef3J/SJXLJqXUPwtNSqHrZk1WWEQuu/IFN3n/v7ryN/fUMc5/02mQAAAA
- AElFTkSuQmCC'!
Item was removed:
- ----- Method: MenuIcons class>>smallNewIcon (in category 'accessing - icons') -----
- smallNewIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallNew'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallNewIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallNewIconContents (in category 'private - icons') -----
- smallNewIconContents
- "Private - Method generated with the content of the file /home/dgd/smallNew.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAACb0lEQVR4nI2RzWsUaRCHn3r7ne6e7p5MPjTu
- mMRE8bIOe9iFsKwiePAgQcGFBW+aYy7e/APyXwQPe9uL5CJIbnszgrCw7IQISr7Nl05kY9Rm
- ZpJ53/LQKIgfWJeqQz1Vv1+V8I24dH2y98iVhowJhsXrsBcdBjmuav569GDmMYAtGqfGvNM/
- EH6Kk2j05OCxU0kS1yppEvdkKZVKRpYlVLKUl81X3Lv/98/ABQD57erUkBVduHljov/X8XHS
- ai/tQ8g7nrztyDuOI6c4p3Q9XK5H/H7rTuvhL7WM6WlvrLizfb2V/omJK7hSD/u5J+84nPNY
- K1TigJ5yQDW1VJOAUlSmr1opn/9v53RhQSQ7MTiAKqRxgPeKU3Be8b7IH+quV7pOGRup8Xox
- rwMrRpUDAZLQUA4N5ciQhIY0MiRRkbM4II0NQ/0hWRwwOlJD8fVCgdVm3moTlQxOQb3iFbwW
- W70qcWioJpbQCgBjIzWAc8WAQ7uX5y1KgRBZQVUKWAVrhCQy2EA+ee/o8A8AdQAzPzfz+s3b
- vCOilKxQskJoTXG8JPgMBhg7VQP4kelpYwA96naf/79/gDWCDYQ4NJTs5+CHGOirkibl+NK/
- zTMGQGF9e7dJYArZ5uvsJyqcuroBEJWN7Rd7iIB8BwwwUhsEtBighvXt3VffR1J85uBtjogJ
- LYBR1nde7H2xud3usLKxw/LaJkurmyyvbbG6sU27c9gQCf60AD5w/yw+W+0uPl2x7/IWK+tb
- LK1usby2ydZOs6WqT0AXvNAQrw31dmF+7u4+wEfHF69NTSJ6G9hFpCHogvHaOB7vL83Ozrqv
- 2XkPgdkFGpcRD6AAAAAASUVORK5CYII='!
Item was removed:
- ----- Method: MenuIcons class>>smallObjectCatalogIcon (in category 'accessing - icons') -----
- smallObjectCatalogIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallObjectCatalog'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallObjectCatalogIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallObjectCatalogIconContents (in category 'private - icons') -----
- smallObjectCatalogIconContents
- "Private - Method generated with the content of the file /home/dgd/smallObjectCatalog.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAAB9UlEQVR4nGNgIAxYGBgYuIlQhx2YqrNFR7hx
- bcAlz4xHL6OiDKuZkQZbUUMynyM/N6MTEyNj0IMXf1cQZbOICINkuAvXpR+HpP//Py7z/9Q8
- sY9OJuye6OpYGBgYGMzDC90EBHidYIJ//zIw7Tl7unvlnu1mJhqs5xJ9uDXff/7HdPvx/8dY
- DZCWFvVZ0JSbCxO8dOshw57YS8sYGBgu7D714+/eUz/KmJmZ5MSF/hs+fslwBcMAfGDXqZ82
- DAwMH3HJMxEyAJ9muAvevvt0o3ry0o0wwU9ffrAzMP9F1RjKwMz7gtPCwFk2+8e/X/qnDz3Q
- ZzjA8IcRh8EcDAwMP5AFzBtVXnOKcIs8f/jxJ6vQX+an+94Gvt/1bQuKF5zZ2ELS2LhOVLDz
- XvZg5VjAwMAAt+A/4//Hl3bf2nfz1AOeL/e+bWNXZS5kYEBNSMzBrFwLJ3EKmrqwcgipM7No
- nfj748ar//+vCbow8P/48t+XRZxRk+kDM9M/1n9ZXCpssh/Yvnchu0BGg4lZHsbRY2ZlE2Fg
- cWRgYGD4+4PN6zfLHxdGDiZJxn9/bzFzMj3+cu7nKr4PaHkkio1r2zt+qf9/BWT+t3HyvRVn
- YFBiYGBgYDBmYOWz5YjhteO0YgjFm/wZ+GxZ2Ds9WdhXq7CyWuBTSDUAANeVnXOvNaMbAAAA
- AElFTkSuQmCC'!
Item was removed:
- ----- Method: MenuIcons class>>smallObjectsIcon (in category 'accessing - icons') -----
- smallObjectsIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallObjects'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallObjectsIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallObjectsIconContents (in category 'private - icons') -----
- smallObjectsIconContents
- "Private - Method generated with the content of the file /home/dgd/smallObjects.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAAB/0lEQVR4nJWQXUgUURTH/zN3ZnMGbXcM+9AN
- spaelETtQyLbsiWofAjspYwegggfpJ6KoqjH6KEEeyjDoBfFCvbBqChZiGJD7EMa66koQzPX
- zf1o292ZuXN6aWSM2KYDl8s55///nXsuw+/wAfW1jO3LEsEGZvA/sVGSe64qgXm9YgXdVLTM
- dubr92xeDmnrdTWQokCQnBNVl+VCjLV78YvVIsJ7JMXvLu6Uy1RNEHd5AiQEGn/LDcNdfG+b
- dpZs/S96bUOtvGkRYIrz4cvFH09GedEiADo37bP5THzVga7pyMETDW5xS53v+Pq18i0AFU5N
- cO56Ue5SBWzOEY3rttUDwAp3ngxJHI0kGyMjt69Rxw5lqO+M1tZ5YX6MCZT8PGu/8bImGuuq
- hi8e0+bmHlYTxYNE8SDdOK1NhWqkFk8AAFq4SYl9uLfScgC7tyy5CwDMI6CwdF2EKoVPrYwJ
- wkzSpi/frMLoO7NPWpA0tavgzLfIZso/MXHHiBzqbnv5YGhsIJc3++/nz3/PcL3KLx4GUOZ8
- Iho6uqN7tzU3O3kqm2OPnr++tKay/IXAjcnHg70Jvx+r02l8dM9YeIHmL8epo/trnHzyawLP
- XulBblM2Ntg7DQB/mgFALLW4ZSMfG7gyUUpTEkBE6VJ9wLXCbDIVbT1yLuVuZgrFp/8C/AKq
- oMu3BdqijAAAAABJRU5ErkJggg=='!
Item was removed:
- ----- Method: MenuIcons class>>smallOkIcon (in category 'accessing - icons') -----
- smallOkIcon
-
- ^ Icons
- at: #smallOkIcon
- ifAbsentPut: [ self smallOkIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallOkIconContents (in category 'private - icons') -----
- smallOkIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 248039624 79675327 33554431 33554431 33554431 33554431 33554431 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 16777215 16777215 16777215 16777215 2438055777 2135606620 16777215 16777215 33554431 33554431 33554431 33554431 33554431 33554431 50331647 50331647 50331647 50331647 61516458 2471741027 4285252467 4284989551 2034219344 16777215 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 2437793121 4285186674 4287618449 4286961290 4284332135 2066328132 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 2437923681 4285055344 4287487120 4287356046 4284397928 4281637445 134225920 33554431 33554431 1147794552 1718086006 33554431 33554431 33554431 33554431 243
7792609 4284989551 4287290254 4287159181 4284332135 4231042883 134225920 16777215 196721081 1047000951 3865102958 4286107261 1885067371 33554431 33554431 2437792091 4284923758 4287224460 4287027851 4284266341 4230977347 152844572 61516458 93952409 1198060663 3831679084 4287027080 4287552399 4233345377 1884605796 2336866654 4284857964 4286962059 4286896264 4284069475 4230911554 152844572 33554431 33554431 33554431 169502259 4284334440 4285910139 4287684243 4286961546 4284990064 4285252723 4286764935 4286634375 4284003682 4247426367 152844572 33554431 33554431 33554431 33554431 33554431 186080558 4283676768 4285252979 4287159181 4287027594 4286568581 4286568325 4283806817 4264203071 171134259 50331647 33554431 33554431 33554431 33554431 33554431 33554431 186080535 4283018583 4284595563 4286634118 4286371460 4283741024 4264071742 152844572 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 186074647 4282229325 4284003683 4283544158 4263940413 152844572 335
54431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 186074647 4281243715 4213674302 136331296 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 186074647 136331296 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 33554431 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallOpenIcon (in category 'accessing - icons') -----
- smallOpenIcon
-
- ^ Icons
- at: #smallOpenIcon
- ifAbsentPut: [ self smallOpenIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallOpenIconContents (in category 'private - icons') -----
- smallOpenIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 16777215 4167658343 4218055784 4234767207 4234833000 4234833000 4251741802 4251807595 3597825392 359492973 16777215 16777215 16777215 2676854157 3968633996 3968633996 3968633996 4285098855 4294572537 4294638330 4294704123 4294769916 4294769916 4294835709 4289835697 3782111083 242052461 16777215 16777215 4035677067 4292072403 4291940817 4291809231 4284967526 4292993505 4292598747 4292598747 4292598747 4292401368 4292269782 4294901502 4272202915 3563942253 158429553 16777215 4018570886 4291875024 4290690750 4290427578 4284967526 4293125091 4289506732 4289506732 4289506732 4289506732 4292730332 4294901502 4294835709 4272335015 2590863724 16777215 4001464705 4291611851 4290427578 4290295992 4285098855 4293454056 4293256677 4293190884 4293190884 4293190884 4293322470 4293783021 4293585642 4292467161 4050678382 16777215 3967647101 4291414473 4290295992 4290032820 4285098855 4293651435 4289704110 4289506731 4289506731 4289506731 4293190884 4293519
849 4293519849 4292467417 4084101228 16777215 3950540920 4291085508 4290098613 4289835441 4285164648 4293914607 4293848814 4293848814 4293783021 4293783021 4293783021 4293783021 4293717228 4292927712 4050546540 16777215 3916591730 4290822336 4282744759 4281957047 4281957047 4281826232 4281759928 4281759928 4281628856 4281628855 4281628855 4281628855 4281563063 4281563063 4281563063 3828906425 3916394351 4290559164 4281628856 4291354096 4291354096 4291354096 4291354096 4291354096 4291354096 4291419632 4291419888 4291419888 4291419888 4291419888 4291025902 4264785848 3882445161 4290295992 4281628855 4291550960 4288463588 4288463588 4288463588 4288463588 4288463588 4288463588 4288463588 4288463588 4288463588 4288660965 4290894317 4247943351 3848561764 4290032819 4281759927 4291682288 4288857574 4288857574 4288857574 4288857574 4288857574 4288857574 4288857574 4288857574 4288857574 4288660709 4290893805 4214519992 3831389790 4289835441 4281825720 4291288047 4289054438 4288988902 4288988
902 4288988902 4288988902 4288988902 4288988902 4288726245 4288331748 4288003810 4290434027 4197742776 3797572186 4289440683 4281957047 4289711337 4288200675 4287938018 4287609569 4287477985 4287346912 4287149791 4286821086 4286689758 4286689758 4286952670 4288725988 4164188600 3764083547 4289309097 4282088119 4288660196 4287412448 4287083999 4287083999 4287083999 4287083999 4287083999 4287083999 4287083999 4287083999 4287215583 4287609312 4147542200 3764017754 4287601320 4282088119 4284193486 4284259279 4284259279 4284259279 4284259279 4284259279 4284259279 4284259279 4284259279 4284259279 4284259279 4283404487 3644225976 2656459876 4281563063 4281563063 4281563063 4281563063 4281563063 4281563063 4281563063 4281563063 4281563063 4281563063 4281563063 4281563063 4281563063 3996481463 1194293175)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallPaintIcon (in category 'accessing - icons') -----
- smallPaintIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallPaint'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallPaintIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallPaintIconContents (in category 'private - icons') -----
- smallPaintIconContents
- "Private - Method generated with the content of the file /home/dgd/smallPaint.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAAB60lEQVR4nJXQT0iTcRzH8ffze/5srT0zNvqr
- KM42JTskoRJISVARCf0RCTp4KCMhELpJx4gQomNBl+jgtX8QnQorqIyg/5atpZmOlk62PXPP
- 9uCz5+kQ7bAObd/rh8+LD1+o8cJwIgzDgKi1S0Qw/Gi0wx0f3O62wAi1KG0Q6tu1/nLnnr3o
- uh8JumoCXFmMjZze56eYxgYcyFQNNENTT7v/VKi1B4w5Vl0AFqoGBAwdP9IlIWuQX8SyS4hq
- gV5QhMTJju6dsPwJcFk2TFyYrAr4AQd2tKzd4tkQhdQUpVVIpsylbxCvCpBgf19vM5hLkEtQ
- tFzeTqfu/M2V/wKStNsQIV6+eMNWbN7FinxdyI3/AwyAvAbOBED9CFcfgw2gB4NqtP88iqZx
- /d5dpiZuGrPwvAwcgnA9DM7Bg04YC4DPgM3AaBgiqrAablw6h+INkU1bzvRs9ixQKgNe8Ot/
- kGPfYTIGFySYAVCFGDrYHq4reSQsJcur1x+exaE8H0Dcgvef4WIaMl7YdhSeKnA4At224yS0
- lE1jRqHekPFpmlT5IwXAgTYVGppgXStIebjWHNy0uNGr1+krwowWPL77TpKcaV2pBGSAOHxp
- hPwvMGMQL8D8z8KKFdACqt+W1du5+YmHyUT/DDypBH4Dwguh75kYJgEAAAAASUVORK5CYII='!
Item was removed:
- ----- Method: MenuIcons class>>smallPasteIcon (in category 'accessing - icons') -----
- smallPasteIcon
-
- ^ Icons
- at: #smallPasteIcon
- ifAbsentPut: [ self smallPasteIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallPasteIconContents (in category 'private - icons') -----
- smallPasteIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 16777215 33554432 3983042920 4286743170 4286743170 4286743170 4286743170 3983042920 33554432 16777215 16777215 16777215 16777215 16777215 1278376377 4281628855 4281628855 4281628855 4286677633 4289377716 4289378230 4289378230 4289377716 4286677633 4281628855 4281628855 4281628855 1278376377 16777215 138420224 4281628855 4289252074 4292537599 4287207318 4286874756 4288652194 4288717730 4288717730 4288586401 4286874756 4287206547 4292537599 4289252074 4281628855 71319552 524958216 4281628855 4292537599 4287207061 4294375158 4293651435 4291940817 4291940817 4291940817 4291940817 4293651435 4294440951 4287206290 4292537599 4281628855 273694720 524958216 4281628855 4292537599 4287270541 4294967295 4294309365 4294309365 4294309365 4294309365 4294309365 4294309365 4294967295 4287270798 4292537599 4281628855 273694720 524958216 4281628855 4292537599 4287270541 4294967295 4294309365 4291546572 4291546572 4291546572 4291546572 4294243828 4294967295 4
287270798 4292537599 4281628855 273694720 524958216 4281628855 4292537599 4287270541 4294967295 4294309365 4294309365 4294309365 4294309365 4294243828 4294112499 4294967295 4287270798 4292537599 4281628855 273694720 524958216 4281628855 4292537599 4287270541 4294967295 4294309365 4291546572 4291546572 4291480779 4291480522 4293980656 4294967295 4287270798 4292537599 4281628855 273694720 524958216 4281628855 4292537599 4287270541 4294967295 4294309365 4294243828 4294178035 4294046449 4293980656 4293322983 4294967295 4287270798 4292537599 4281628855 273694720 524958216 4281628855 4292537599 4287270541 4294967295 4294243572 4294112242 4294046449 4293980656 4293257190 4292665053 4294967295 4287270798 4292537599 4281628855 273694720 524958216 4281628855 4292537599 4287270541 4294967295 4294046706 4293980656 4293915120 4292730846 4291744208 4291678672 4294967295 4287270798 4292537599 4281628855 273694720 524958216 4281628855 4292537599 4287270541 4294967295 4293980656 4293849327 429319139
7 4291743951 4294967295 4294967295 4294967295 4287270798 4292537599 4281628855 273694720 524958216 4281628855 4292537599 4287270541 4294967295 4293783791 4293125861 4292138709 4291612622 4294967295 4294967295 4287270798 4292537599 4292537599 4281628855 273694720 524958216 4281628855 4292537599 4287076246 4294178035 4294901502 4294901502 4294901502 4294243828 4294835965 4287270798 4292537599 4292537599 4292537599 4281628855 273694720 138420224 4281628855 4289252074 4292537599 4287142553 4287468177 4287468177 4287468177 4287468177 4287468177 4292537599 4292537599 4292537599 4289252074 4281628855 71319552 16777215 1278376377 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 1278376377 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallPinIcon (in category 'accessing - icons') -----
- smallPinIcon
-
- ^ Icons
- at: #smallPinIcon
- ifAbsentPut: [ self smallPinIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallPinIconContents (in category 'private - icons') -----
- smallPinIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1560237654 2550092884 872371541 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1560237654 4294923605 4294923605 4294923605 1560237654 16777215 16777215 16777215 16777215 4294923605 16777215 16777215 16777215 16777215 16777215 1560237654 4294923605 4294923605 4294936712 4294936712 4294923605 1560237654 16777215 16777215 16777215 4294923605 4294923605 16777215 16777215 16777215 1560237654 4294923605 4294923605 4294936712 4294936712 4294923605 4294923605 4294923605 872371541 16777215 16777215 1560237654 4294923605 4294923605 1560226346 2113885782 4294923605 4294923605 4294936712 4294936712 4294923605 4294923605 4294923605 4293283149 2550092884 16777215 16777215 16777215 2113885782 4294923605 4294923605 4294923605 4294923605 4294936712 4294936712 4294923605 4294923605 4294923605 4293283149 4291576900 2107979575 16777215 16
777215 16777215 16777215 2902410822 4294923605 4294923605 4294936712 4294936712 4294923605 4294923605 4294923605 4293283149 4291576900 2107979575 16777215 16777215 16777215 16777215 16777215 872371541 3187614499 4294923605 4294923605 4294923605 4294923605 4294923605 4293283149 4291576900 2107979575 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1560237654 3405717793 4294923605 4294923605 4294923605 4293283149 4291576900 2107979575 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3212409209 4286151033 3405717793 4294923605 4294923605 4291773765 2545302845 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3212409209 4286151033 3212409209 1560237654 3187614499 4294923605 4294923605 1560226346 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3212409209 4286151033 3212409209 16777215 16777215 872371541 2902410822 4294923605 4294923605 16777215 16777215 16777215 16777215 16777215 16777215 2675472504 4286151033 3212
409209 16777215 16777215 16777215 16777215 16777215 2113885782 4294923605 4294923605 16777215 16777215 16777215 16777215 2138601592 4286151033 2675472504 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1560237654 4294923605 4294923605 16777215 16777215 16777215 4286151033 2138601592 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallPrintIcon (in category 'accessing - icons') -----
- smallPrintIcon
-
- ^ Icons
- at: #smallPrintIcon
- ifAbsentPut: [ self smallPrintIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallPrintIconContents (in category 'private - icons') -----
- smallPrintIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2176367288 4290296247 4290296247 4290296247 4290296247 4290296247 4290296247 4290296247 4290296247 4290296247 2176367288 16777215 16777215 16777215 16777215 16777215 4290296247 4294638330 4294638330 4294638330 4294638330 4294638330 4294638330 4294638330 4294638330 4294572537 4290296247 16777215 16777215 16777215 16777215 16777215 4290296247 4294638330 4291809231 4291809231 4291809231 4291809231 4291809231 4291809231 4291809231 4294572537 4290296247 16777215 16777215 16777215 16777215 16777215 4290296247 4294638330 4294243572 4294243572 4294243572 4294309365 4294309365 4294309365 4294309365 4294572537 4290296247 16777215 16777215 16777215 16777215 16777215 4290296247 4294572537 4291809231 4291809231 4291875024 4291875024 4291875024 4291940817 4291940817 4294572537 4290296247 16777215 16777215 1677721
5 16777215 16777215 4290296247 4294572537 4293322470 4293454056 4293519849 4293519849 4293585642 4293651435 4293717228 4294572537 4290296247 16777215 16777215 16777215 16777215 16777215 4290296247 4294506744 4289835441 4289835441 4289835441 4289967027 4293388263 4293388263 4293388263 4294572537 4290296247 16777215 16777215 16777215 2173603982 4287598991 4288125078 4290361785 4290295992 4290361785 4290361785 4290361785 4290361785 4290361785 4290295992 4290295992 4288125078 4287598991 2173603982 16777215 4287598991 4294835709 4294638330 4294375158 4294375158 4294375158 4294375158 4294375158 4294375158 4294375158 4294375158 4294375158 4293651435 4293783021 4287598991 16777215 4287598991 4294835709 4292664540 4294046193 4290559164 4294309365 4293256677 4293519849 4293388263 4293454056 4293322470 4293125091 4289703855 4292335317 4287598991 16777215 4287598991 4294177779 4292269525 4293190884 4293190884 4293190884 4293190884 4293190884 4293125091 4293190884 4293190884 4292927712 428858511
6 4291875024 4287598991 16777215 4287598991 4294309365 4291480266 4288190358 4287466635 4287466635 4287203463 4287334792 4287203205 4286940290 4287071877 4287334792 4290756543 4291875024 4287598991 16777215 4287598991 4294309365 4291282887 4291151301 4291151301 4291151301 4291151301 4291151300 4291019715 4290822336 4290953922 4291085508 4291151301 4291940817 4287598991 16777215 4287598991 4293980400 4292861919 4292927712 4292927712 4292861919 4292861919 4292861919 4292861919 4292861919 4292730333 4292861919 4292796126 4292664540 4287598991 16777215 2811269520 4287598991 4287598991 4287598991 4287598991 4287598991 4287598991 4287598991 4287598991 4287598991 4287598991 4287598991 4287598991 4287598991 2811269520)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallProjectBackIcon (in category 'accessing - icons') -----
- smallProjectBackIcon
-
- ^ Icons
- at: #smallProjectBackIcon
- ifAbsentPut: [ self smallProjectBackIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallProjectBackIconContents (in category 'private - icons') -----
- smallProjectBackIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 2083747767 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 2083747767 16777215 16777215 4281628855 4292537599 4292537599 4292537599 4292537599 4292537599 4293176763 4293176763 4292537599 4292537599 4292537599 4292537599 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4292537599 4292537599 4292537599 4292985039 4293751676 4293751676 4292985039 4292537599 4292537599 4292537599 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4292537599 4292537599 4292793830 4293496216 4294901760 4294901760 4293496216 4292793830 4292537599 4292537599 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4292537599 4292537599 4292985039 4294901760 4294901760 4294901760 4294901760 4292985039 4292537599 4292537599 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4292537599 4292537599 4292537599 4292537599 4292537599 4292537599 4292537599 4292537599 42
92537599 4292537599 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4278239744 4278239744 4278239744 4278239744 4292537599 4292537599 4290694609 4287727293 4287727293 4290694609 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4278239744 4278239744 4278239744 4278239744 4292537599 4292537599 4287595701 4281014002 4281014002 4287661239 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4278239744 4278239744 4278239744 4278239744 4292537599 4292537599 4287463852 4280948465 4280948465 4287464110 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4278239744 4278239744 4278239744 4278239744 4292537599 4292537599 4290628297 4287595700 4287595700 4290628298 4292537599 4281628855 16777215 16777215 2083747767 4291090666 4284271650 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 2083747767 16777215 16777215 3169845236 4278231040 4278231040 3053453311 3053453311 3053453311 16777215 16
777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3053453311 4284271650 4289589680 4278231040 4278231040 4278231040 4278231040 3053453311 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4281118976 4283491340 4278248192 4278247936 4278246144 4278244352 4278231040 3053453311 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3053453311 4281118976 4285526614 4278231040 4278231040 4278231040 4278231040 3053453311 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3169910772 4278231040 4278231040 3053453311 3053453311 3053453311 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallProjectIcon (in category 'accessing - icons') -----
- smallProjectIcon
-
- ^ Icons
- at: #smallProjectIcon
- ifAbsentPut: [ self smallProjectIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallProjectIconContents (in category 'private - icons') -----
- smallProjectIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2083747767 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 2083747767 16777215 16777215 4281628855 4292537599 4292537599 4292537599 4292537599 4292537599 4293176763 4293176763 4292537599 4292537599 4292537599 4292537599 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4292537599 4292537599 4292537599 4292985039 4293751676 4293751676 4292985039 4292537599 4292537599 4292537599 4292537599 4281628855 16777215 16777215 4281628855 4292537599 42
92537599 4292537599 4292793830 4293496216 4294901760 4294901760 4293496216 4292793830 4292537599 4292537599 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4292537599 4292537599 4292985039 4294901760 4294901760 4294901760 4294901760 4292985039 4292537599 4292537599 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4292537599 4292537599 4292537599 4292537599 4292537599 4292537599 4292537599 4292537599 4292537599 4292537599 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4278239744 4278239744 4278239744 4278239744 4292537599 4292537599 4290694609 4287727293 4287727293 4290694609 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4278239744 4278239744 4278239744 4278239744 4292537599 4292537599 4287595701 4281014002 4281014002 4287661239 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4278239744 4278239744 4278239744 4278239744 4292537599 4292537599 4287463852 4280948465 4280948465 4287464110 4292537599 4281628855 1677721
5 16777215 4281628855 4292537599 4278239744 4278239744 4278239744 4278239744 4292537599 4292537599 4290628297 4287595700 4287595700 4290628298 4292537599 4281628855 16777215 16777215 2083747767 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 2083747767 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallProjectJumpIcon (in category 'accessing - icons') -----
- smallProjectJumpIcon
-
- ^ Icons
- at: #smallProjectJumpIcon
- ifAbsentPut: [ self smallProjectJumpIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallProjectJumpIconContents (in category 'private - icons') -----
- smallProjectJumpIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 2083747767 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 2083747767 16777215 16777215 4281628855 4292537599 4292537599 4292537599 4292537599 4292537599 4293176763 4293176763 4292537599 4292537599 4292537599 4292537599 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4292537599 4292537599 4292537599 4292985039 4293751676 4293751676 4292985039 4292537599 4292537599 4292537599 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4292537599 4292537599 4292793830 4293496216 4294901760 4294901760 4293496216 4292793830 4292537599 4292537599 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4292537599 4292537599 4292985039 4294901760 4294901760 4294901760 4294901760 4292985039 4292537599 4292537599 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4292537599 4292537599 4292537599 4292537599 4292537599 4292537599 4292537599 4292537599 42
92537599 4292537599 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4278239744 4278239744 4278239744 4278239744 4292537599 4292537599 4290694609 4287727293 4287727293 4290694609 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4278239744 4278239744 4278239744 4278239744 4292537599 4292537599 4287595701 4281014002 4281014002 4287661239 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4278239744 4278239744 4278239744 4278239744 4292537599 4292537599 4287463852 4280948465 4280948465 4287464110 4292537599 4281628855 16777215 16777215 4281628855 4292537599 4278239744 4278239744 4278239744 4278239744 4292537599 4292537599 4290628297 4287595700 4287595700 4290628298 4292537599 4281628855 16777215 16777215 2083747767 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4284271650 4291090666 2083747767 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 30534
53311 3053453311 3053453311 4278231040 4278231040 3500729258 16777215 16777215 1275109632 4278231040 1275109632 4278231040 1275109632 4278231040 1275109632 3053453311 4278231040 4278231040 4278231040 4278231040 4278241792 4278231040 3417498546 16777215 4278231040 4278246144 4278231040 4278246144 4278231040 4278246144 4278231040 3053453311 4278231040 4278246144 4278246144 4278246144 4278246144 4278241792 4278231040 16777215 1275109632 4278231040 1275109632 4278231040 1275109632 4278231040 1275109632 3053453311 4278231040 4278231040 4278231040 4278231040 4278241792 4278231040 3417498546 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3053453311 3053453311 3053453311 4278231040 4278231040 3500729258 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallProjectLoadIcon (in category 'accessing - icons') -----
- smallProjectLoadIcon
-
- ^ Icons
- at: #smallProjectLoadIcon
- ifAbsentPut: [ self smallProjectLoadIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallProjectLoadIconContents (in category 'private - icons') -----
- smallProjectLoadIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 1278376377 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 1278376377 16777215 16777215 16777215 16777215 16777215 16777215 4281628855 4292537599 4292537599 4292537599 4294928966 4294928966 4292537599 4292537599 4292537599 4281628855 16777215 16777215 16777215 16777215 4281628855 4281628855 4281628855 4292537599 4292537599 4294949256 4294901760 4294901760 4294949256 4292537599 4292537599 4281628855 16777215 16777215 1412725174 4281628855 4281628855 4287412967 4281628855 4288923367 4292537599 4294933841 4294901760 4294901760 4294933841 4292537599 4292537599 4281628855 16777215 1412725174 4281628855 4290304767 4290304767 4290304767 4287412967 4281628855 4278247936 4278247936 4292537599 4292537599 4290947299 4290947299 4292537599 4281628855 16777215 4281628855 4290304767 4287412967 4281628855 4287412967 4281628855 4279353404 4278247936 4278247936 4292537599 4290947299 428251571
1 4282515711 4290947299 4281628855 16777215 4281628855 4290304767 4281628855 4281628855 4281628855 4281628855 4278247936 4278247936 4278247936 4292537599 4290947299 4282515711 4282515711 4290947299 4281628855 16777215 4281628855 4281628855 4281628855 16777215 16777215 1278376377 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 1278376377 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4286151288 4286151288 4286151288 4286151288 4286151288 4286151288 4286151288 4286151288 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4286151288 4294770683 4294770683 4294770683 4294770683 4294770683 4294770683 4286151288 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4286151288 4294770683 4294770683 4294770683 4294770683 4294770683 4294770683 4286151288 16777215 16777215 16777215 16777215 16777215 16777215 16777215 167
77215 4286151288 4294770683 4294770683 4294770683 4294770683 4294770683 4294770683 4286151288 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4286151288 4286151288 4286151288 4286151288 4286151288 4286151288 4286151288 4286151288 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4286151288 4294770683 4294770683 4294770683 4294770683 4294770683 4294770683 4286151288 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4286151288 4286151288 4286151288 4286151288 4286151288 4286151288 4286151288 4286151288 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallProjectNextIcon (in category 'accessing - icons') -----
- smallProjectNextIcon
-
- ^ Icons
- at: #smallProjectNextIcon
- ifAbsentPut: [ self smallProjectNextIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallProjectNextIconContents (in category 'private - icons') -----
- smallProjectNextIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 3178078063 4282619024 4282619024 4282619024 4282619024 4282619024 4282619024 4282619024 4282619024 4282619024 4282619024 4282619024 4282619024 3178078063 16777215 16777215 4282619024 4292666586 4292666586 4292666586 4292666586 4292666586 4294159759 4294159503 4292666586 4292666586 4292666586 4292666586 4292600791 4282619024 16777215 16777215 4282619024 4292666587 4292337348 4292337348 4292337348 4293637757 4294139970 4294139970 4293571966 4292271812 4292271812 4292337350 4292600791 4282619024 16777215 16777215 4282619025 4292666589 4292337349 4292337349 4292337349 4294079056 4294901760 4294901760 4294079056 4292337349 4292337349 4292271812 4292600790 4282619024 16777215 16777215 4282619025 4292732381 4292337608 4292337608 4292337608 4294901760 4294901760 4294901760 4294901760 4292337350 4292271810 4292271553 4292600791 4282619024 16777215 16777215 4282619025 4292666586 4292337609 4285977428 4285977170 4285911632 4285911631 4292271554 4291084195 4287727293 42
87727293 4291084196 4292534996 4282619024 16777215 16777215 4282619025 4292469200 4292140219 4278239744 4278239744 4278239744 4285713988 4292074168 4287595701 4281014002 4281014002 4287661239 4292337610 4282619024 16777215 16777215 4282619025 4292140221 4291942577 4278239744 4278239744 4278239744 4285582397 4291942577 4287463852 4280948465 4280948465 4287464110 4292140221 4282619024 16777215 16777215 4282619026 4292074170 4292074167 4278239744 4278239744 4278239744 4285713987 4292074167 4290886292 4287595700 4287595700 4290886293 4292073912 4282619024 16777215 16777215 4282619026 4291415968 4291415968 4291415968 4291415968 4291415968 4291415968 4291415968 4291415968 4291415968 4284271650 4293915107 4291153049 4282619024 16777215 16777215 3178078063 4282619024 4282619024 4282619024 4282619024 4282619024 4282619024 4291354847 4291354847 4291354847 4278231040 4278231040 4290962394 3178078063 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3053453311 4278231040 4
278231040 4278231040 4278231040 4289589680 4284271650 3053453311 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3053453311 4278231040 4278244352 4278246144 4278247936 4278248192 4283491340 4281118976 3053453311 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3053453311 4278231040 4278231040 4278231040 4278231040 4285526614 4281118976 3053453311 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 3053453311 3053453311 3053453311 4278231040 4278231040 3169910772 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4281118976 3053453311 16777215 16777215 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallProjectSaveIcon (in category 'accessing - icons') -----
- smallProjectSaveIcon
-
- ^ Icons
- at: #smallProjectSaveIcon
- ifAbsentPut: [ self smallProjectSaveIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallProjectSaveIconContents (in category 'private - icons') -----
- smallProjectSaveIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 1278376377 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 1278376377 16777215 16777215 16777215 16777215 16777215 16777215 4281628855 4292537599 4292537599 4292537599 4294928966 4294928966 4292537599 4292537599 4292537599 4281628855 16777215 16777215 16777215 16777215 16777215 16777215 4281628855 4292537599 4292537599 4294949256 4294901760 4294901760 4294949256 4292537599 4292537599 4281628855 16777215 16777215 16777215 16777215 16777215 16777215 4281628855 4292537599 4292537599 4294933841 4294901760 4294901760 4294933841 4292537599 4292537599 4281628855 16777215 16777215 16777215 16777215 16777215 16777215 4281628855 4278247936 4278247936 4278247936 4292537599 4292537599 4290947299 4290947299 4292537599 4281628855 16777215 4281628855 4281628855 1412725174 16777215 16777215 4281628855 4278247936 4278247936 4278247936 4292537599 4290947299 4282515711 4282515711 4290947299 4281628855 16777215 4281628855 4290304767 4281628855 141
2725174 16777215 4281628855 4278247936 4278247936 4278247936 4292537599 4290947299 4282515711 4282515711 4290947299 4281628855 16777215 4281628855 4287412967 4290304767 4281628855 16777215 1278376377 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 4281628855 1278376377 16777215 16777215 4281628855 4290304767 4281628855 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4281628855 4281628855 4290304767 4281628855 4281628855 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4286151288 4286151288 4286151288 4281628855 4287412967 4290304767 4287412967 4281628855 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4286151288 4294770683 4294770683 4290434020 4281628855 4287412967 4281628855 4284643980 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4286151288 4294770683 4294770683 4294770683 4290434020 4281628855 4290434020 4286151288 1677
7215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4286151288 4294770683 4294770683 4294770683 4294770683 4294770683 4294770683 4286151288 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4286151288 4286151288 4286151288 4286151288 4286151288 4286151288 4286151288 4286151288 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4286151288 4294770683 4294770683 4294770683 4294770683 4294770683 4294770683 4286151288 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4286151288 4286151288 4286151288 4286151288 4286151288 4286151288 4286151288 4286151288)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallPublishIcon (in category 'accessing - icons') -----
- smallPublishIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallPublish'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallPublishIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallPublishIconContents (in category 'private - icons') -----
- smallPublishIconContents
- "Private - Method generated with the content of the file /home/dgd/smallPublish.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAADG0lEQVQ4jY2Sb2jUdQDGP9/fn7vN29+7tv2c
- t5tenulsUd1miWlEFCjZzRdRVPiiEnohBBaLIiRIg9heDAuiFwVJONgcWrBilajlKlKU5cEa
- zrlluzvnbfd/9/f3/fYiKgoOel4/z4cHnkfwP7Tl4X2PSanvEeBXyCkp1PC1705NA4h/Obfi
- oMU8R6fLQzi5H/9Tl+6+rT7b3Nn4RK63Lxap73LZ878sVc6NNqhycWjmwtgx/e9wkG4cvM2T
- vr5nB171zPiSL3gmbgeeeyjwzIcHLWf7XRvdzzddrf+hZa9V3ravwb48scnjvTOsE8R0Pej5
- eus7oYH0675guUcn7IzTGLDE8tpE99D6dmFaXUTjgu1101wvdjAj12rC11WSV852GMChbe89
- /ehZbRy+SkuUlCrkMlYSNxC/RVh0P0Kdqmd4+T70smRBNrO9McLSmlYrLES3galtDnsXYSxt
- M5TowGsexrr8MhP2zc7JHkfh8M62QGUKZ/NO3sr2MbnlA0gvk8gpHq/RShoV+X08lgS30pFU
- iJf7eS3h52jaVyM9M0em10XHY/dwJdNK3jYoFAVfxO7njRG1ksmXRzTyjKjha1FWAEEjk2T4
- mRt/TiRfKp4ctN+c8kWKUueA5yJOmWHwTGrh/E+zN+26/FFxoIfdjpaOY7hb3Tu6g9Lpcmmm
- oQtNEyCEmJu/pY5fiIqcozXV1lzrKK/mGlK50qlVQxyc+3Y0ZRiGufv98amNQiVAFliKzDJ3
- 8ThSr6d3VwhTt7HuOK8Ojcbay6vZ9tl15jzjJ+2/1jdavAFfIrlEPFkCVaFGGBTzaeoaHZh6
- BWSB2lpd/f7jaB64/t+XGu42r5XKJKnYLYCipBbZFXoFoQokUnFqTYXDIWS1mxuFbHp1g+Ui
- uzLHrx+fxtXrR7StZ/+nQxhK0NHkYgf3qmoAbfnWQgTg6okvCQ5+TnRgDGkXiMbiWKzBUIpS
- SaveIBWPRjKpEr0vhrjU2syG4CaE3sQ3/e+CLIDWwEdHPslVBSjBif69D/iVbetK/dNUMwxh
- mk7NcNSI1WzydDXAH4NwUmsvAPcyAAAAAElFTkSuQmCC'!
Item was removed:
- ----- Method: MenuIcons class>>smallQuitIcon (in category 'accessing - icons') -----
- smallQuitIcon
-
- ^ Icons
- at: #smallQuitIcon
- ifAbsentPut: [ self smallQuitIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallQuitIconContents (in category 'private - icons') -----
- smallQuitIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 4284901482 4290098613 4288124823 4287401100 4286677377 4286085240 4285558896 4285295724 4294046194 4294112244 4294309366 4294440952 4294440952 4293980658 4287598995 679904902 4284901482 4290493371 4288585374 4287730065 4287137928 4286545791 4286019447 4285756275 4294046194 4294309365 4294572537 4294704124 4294769916 4294638330 4289243563 1066044042 4284901482 4291217094 4289111718 4288387995 4287664272 4287137928 4286677377 4286282619 4294046194 4294309366 4294638330 4288727272 4282685399 4294704123 4289769906 1183484554 4284901482 4291282887 4289572269 4289045925 4288387995 4287730065 4287203721 4286808963 4294046451 4294112502 4285771742 4284261853 4278219466 4292536564 4288260277 1736008038 4284901482 4291414473 4289769648 4289243304 4288716960 4288190616 4287664272 4287203721 4293324017 4282553556 4285444580 4289977081 4281306583 4280321491 4279467214 4278544569 4284901482 4291480266 4289835441 4289374890 4288848546 4288322202 4287795858 4286351764 4279335885 428
5707496 4288007672 4288401400 4288861177 4288926713 4289189626 4278348735 4284901482 4291480266 4289967027 4289506476 4288980132 4288519581 4285894306 4278218436 4285182955 4285906421 4283345650 4283542770 4283674098 4283805170 4288335864 4278348992 4284901482 4291480266 4290164406 4289638062 4289177511 4288585374 4278217663 4281832927 4284527603 4280522222 4278946541 4278224107 4278224106 4278224364 4286300406 4278348992 4284901482 4291480266 4290295992 4289835441 4289243304 4288716960 4286944417 4278217920 4280782815 4281638640 4278223849 4278223849 4278223849 4278224106 4284133619 4278348735 4284901482 4291480266 4290295992 4289901234 4289374890 4288914339 4288387995 4287337370 4280057289 4279600088 4281835503 4282689009 4282097645 4282294251 4282425579 4278348735 4284901482 4291480266 4290295992 4290032820 4289572269 4289111718 4288716960 4287927444 4285625720 4283604181 4278220498 4281572332 4278218436 4278482381 4278218435 4079241345 4284901482 4291480266 4290295992 4290295992
4289835441 4289309097 4286743170 4288322460 4292467419 4293454314 4286230746 4278219466 4278218951 4293520107 4288190874 814056837 4284901482 4291480266 4290361785 4290624957 4288124824 4288454561 4291875283 4292533470 4292730592 4292796385 4292862178 4288002776 4283209424 4292665056 4286875272 495223940 4284901482 4291743438 4289177769 4288783012 4291283661 4291612369 4291743954 4291743955 4291809747 4291809747 4291809747 4291809747 4291809747 4291612626 4285690998 176193664 3309849418 4286282878 4284967275 4285033068 4285098861 4285098861 4285098861 4285098861 4285164654 4285164654 4285164654 4285164654 4285164654 4285098861 3326889805 41975936 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallQuitNoSaveIcon (in category 'accessing - icons') -----
- smallQuitNoSaveIcon
-
- ^ Icons
- at: #smallQuitNoSaveIcon
- ifAbsentPut: [ self smallQuitNoSaveIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallQuitNoSaveIconContents (in category 'private - icons') -----
- smallQuitNoSaveIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 4284967526 4290098613 4288124823 4287401100 4286677377 4286085240 4285558896 4285295724 4294111985 4294243570 4294375157 4294506743 4294506743 4293980912 4287730575 369098751 4284967526 4290493371 4288585374 4287730065 4287137928 4286545791 4286019447 4285756275 4294111985 4294309365 4294572537 4294769915 4294769916 4294638330 4289375144 587202559 4284967526 4291217094 4289111718 4288387995 4287664272 4287137928 4286677377 4286282619 4294111985 4294375157 4294638330 4293435552 4292297797 4294704123 4289835696 654311423 4284967526 4291282887 4289572269 4289045925 4288387995 4287730065 4287203721 4286808963 4294177777 4294374642 4292768627 4292697180 4291428352 4294237146 4290091673 988390307 4284967526 4291414473 4289769648 4289243304 4288716960 4288190616 4287664272 4287203721 4294043878 4292100674 4293160558 4294554547 4292292400 4292026402 4291695379 4173529088 4284967526 4291480266 4289835441 4289374890 4288848546 4288322202 4287795858 4287921276 4291629331 429342
3730 4294481302 4294482843 4294550178 4294550435 4294616999 4240637952 4284967526 4291480266 4289967027 4289506476 4288980132 4288519581 4288836982 4291035136 4293618282 4294276470 4294069839 4294070609 4294071124 4294071637 4294482586 4240703488 4284967526 4291480266 4290164406 4289638062 4289177511 4288585374 4290707456 4292818744 4294140000 4293796644 4293724943 4293591040 4293525504 4293656576 4294343547 4240703488 4284967526 4291480266 4290295992 4289835441 4289243304 4288716960 4288775557 4290772992 4292814633 4293932085 4293459968 4293459968 4293459968 4293525504 4294138458 4240637952 4284967526 4291480266 4290295992 4289901234 4289374890 4288914339 4288387995 4288318347 4291370268 4292351255 4293867320 4294001733 4293737276 4293606975 4293607489 4257415168 4284967526 4291480266 4290295992 4290032820 4289572269 4289111718 4288716960 4287927444 4286083697 4292170578 4291952640 4293669684 4291035136 4291625991 4290969600 3368550400 4284967526 4291480266 4290295992 4290295992 42
89835441 4289309097 4286743170 4288388250 4292467673 4293520104 4292508538 4291428352 4291231744 4293585897 4288256664 436207615 4284967526 4291480266 4290361785 4290624957 4288125079 4288586140 4291941328 4292665050 4292796637 4292862430 4292928223 4292384661 4291841612 4292731100 4287006852 268435455 4284967526 4291743438 4289243559 4288914593 4291415495 4291678668 4291875534 4291875790 4291875791 4291875791 4291875791 4291875791 4291875791 4291809996 4285822578 100663295 2238541675 4286348923 4285098855 4285164648 4285230441 4285230441 4285230441 4285230441 4285296234 4285296234 4285296234 4285296234 4285296234 4285230441 2255647856 33554431 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallRedoIcon (in category 'accessing - icons') -----
- smallRedoIcon
-
- ^ Icons
- at: #smallRedoIcon
- ifAbsentPut: [ self smallRedoIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallRedoIconContents (in category 'private - icons') -----
- smallRedoIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4282691328 860270336 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4282691328 4282691328 1128640256 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4282691328 4289526392 4282691328 1094955264 16777215 16777215 16777215 16777215 16777215 16777215 16777215 122271232 1178971904 2655301120 3477384960 4282691328 4282691328 4289526392 4289526392 4282691328 1094955264 16777215 16777215 16777215 16777215 16777215 910339840 2974068224 3298668032 3719096654 4289591414 4289591671 4289919871 4289001324 4285128704 4289526392 4282691328 1094955264 16777215 16777215 16777215 1246081024 3359944448 4256228425 4289722227 4288737880 4288866048 4288866048 4288866048 4288866048 4285128704 4285128704 4289526392 4282691328 998676224 16777215 725725696 3125128960 4
289586251 4289853296 4289128704 4288080156 4288866048 4288866048 4290044672 4285128704 4285128704 4285128704 4285260032 4289526392 4282691328 16777215 2655301120 3936735531 4289852778 4289194502 4290044672 4290044672 4291877888 4285586944 4285128704 4285128704 4285128704 4285128704 4286901554 4282691328 1094955264 16777215 3662721792 4289917550 4290701860 4292009728 4288537088 4288931328 4288931328 4288931328 4288931328 4292864000 4285128704 4286901554 4282691328 1094955264 16777215 16777215 4048204032 4289983599 4292141312 4272009984 4282691328 4282691328 4282691328 4282691328 4282691328 4292075264 4286901554 4282691328 1094955264 16777215 16777215 16777215 4282691328 4290964552 4289116160 4047810304 1933946624 809873152 16777215 16777215 4282691328 4286901554 4282691328 1094955264 16777215 16777215 16777215 16777215 4282691328 4256752690 4282691328 1212395008 16777215 16777215 16777215 16777215 4282691328 4282691328 860270336 16777215 16777215 16777215 16777215 16777215 4282691328
4122863670 4265914112 16777215 16777215 16777215 16777215 16777215 4282691328 860270336 16777215 16777215 16777215 16777215 16777215 16777215 3242438144 3333936384 3466506240 1212395008 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1581559808 2253699584 2529681430 2359929600 205564416 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 541634304 1782820864 1531162112 491171840 79675136 61516288 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallRemoteOpenIcon (in category 'private - icons') -----
- smallRemoteOpenIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallRemoteOpen'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallRemoteOpenIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallRemoteOpenIconContents (in category 'private - icons') -----
- smallRemoteOpenIconContents
- "Private - Method generated with the content of the file /home/dgd/smallRemoteOpen.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAYAAABWzo5XAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAAD2klEQVQ4ja3T+0/VdRzH8efn+/18OTcOnJtc
- zhFCg+EVD56BiYU4qQw1XdocttSt6VrL1fyh1vpBN7dq9mPZlv1Wm1OsDRZqU/DSkKkFelKS
- wEsonANM1AOHw/d7Lt/TD9lWW2219f4DHnu/fnjC/3RidzkWIx+r1MkkLcxVBDcO9ZD6r5A0
- 8jiTY7XWyTzNrG9aq4TPnU/sDEXbEHwjspw81EPiX320K0T7gfbWtWORcc61tFBSWUnZwoX0
- dnTQ09k5E4/FjitZvlYNjn/WR/yfIDUUYGFDrfpMyawEoRe3YySh5cAH7HpvG2t2vq2VLapa
- kM2am8fHRvYsKcjU1BQjQ36GeqIYf4GWFuGrCC56uTjvEUz0UlBRzVRCYWqgk1JLmCJvhlBD
- Hat3vCGL5lTMM/SZlx5Eo3uW+rO1NX76f4wwCqAuC5B2eArfXFw1G0QOZE0cpTV8d/QEoWXl
- qGYCpm4jH1yixC956oXnWbl1l2pzuipvhsM7gn6zpXeECXVdhIfj7vQ79WtWaD/fy9AVjhET
- RXiLA5w6doaxsQROtxun2w3pBEzexDJ1lYrqJVh88+T17ou23ijfyn1gNg/Hr2zeN1SXVG3k
- BOZgvznKSH+E5cGNNK4OcPnCKUZb+ygpyadpQxCRTYE+wRPz5xM3RDnkeuXip7e6b9mM4Meb
- illWW8prt5p5zjXBkChjuO0TPj38Awf3b0M4Z3O96zxHDrfSvH0lCAuqlAAapOcraWVm/871
- flv9AgsXp5/kfVcb613XyAhJcMtb9EcFHae7IdLFouXLyS9dwODtSVCsKFKigAbZHMVplWub
- an1i2l7EsbtzqbRH0UhimJCjKpStWMWFn6ZAOiA+QsOWV+i5fAe0PKQqEAIVMGU6K9xfjDey
- t+AsxZ4Mtbfe5dlZD9jt78KuqkzmjjE0LDBMK5Z0EnuuxO4pQk/noKgqQkGCMJT4tNF3YsKj
- p5IKm51XMYXCptyL+Geu4IqdJXZviEKvHc2WD5oD9Bh1GzYS7hlAVSWCx1AmlTo62XZwbN2d
- 1/loaAUAg7qLG/dtNHc3cvpKjODiEhRL7u/zEPgKvDg8hSjyD0hJqg8jg5dcroIN8TsD6fvl
- q1xznLrY62sl/MtE9qtD7Y/kve5f49c6s+N3hx0zehprngdHfh4Ojw9D1+k40vIoPCq+FI9T
- sZZWNXxoc3k3qtKSa5OmLZVMDURu931+/27/CWCkrkyr8lozTXY1Wx8I+JZWVi+ZZZom506e
- /f7odeur4k/dCSCgaZovlUpJIAZE4e+Kz3dXFU5Xq6oouzGuDupp/fJvhgd0/Din8aMAAAAA
- SUVORK5CYII='!
Item was removed:
- ----- Method: MenuIcons class>>smallRightFlushIcon (in category 'accessing - icons') -----
- smallRightFlushIcon
-
- ^ Icons
- at: #smallRightFlushIcon
- ifAbsentPut: [ self smallRightFlushIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallRightFlushIconContents (in category 'private - icons') -----
- smallRightFlushIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 2862522779 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 4288257175 2862522779 16777215 16777215 4288257175 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4289638062 4289440683 4289440683 4289440683 4289440683 4289440683 4289440683 4294440950 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4294440950 4294440950 4294440950 4294440950 4294440950 4294440950 4294440950 4294572537 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 4294572537 42
94572537 4294572537 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4294572537 4294572537 4289638062 4289440683 4289440683 4289440683 4289440683 4294309365 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4294572537 4294572537 4294440950 4294440950 4294440950 4294375157 4294309365 4294440950 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4294572537 4294572537 4294572537 4294572536 4294506743 4294440950 4294375157 4294309365 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572537 4289440683 4289309097 4289309097 4289309097 4289309097 4289309097 4289309097 4294309364 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572537 4294572536 4294375157 4294309365 4294309364 4294243571 4294177778 4294111985 4294046193 4294177779 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294572536 4294506743 4294440950 4294375157 4294309365
4294309365 4294243572 4294177779 4294177778 4294111985 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294440950 4294375158 4294309365 4294309365 4294309364 4289440683 4289309097 4289309097 4289309097 4293848814 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294375157 4294309365 4294309364 4294243571 4294177779 4293980400 4293914607 4293848814 4293783021 4293980399 4294901502 4288454554 16777215 16777215 4288257175 4294967295 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294901502 4294967295 4288454554 16777215 16777215 2862522779 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 4288454554 2862522780 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallSaveAsIcon (in category 'accessing - icons') -----
- smallSaveAsIcon
-
- ^ Icons
- at: #smallSaveAsIcon
- ifAbsentPut: [ self smallSaveAsIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallSaveAsIconContents (in category 'private - icons') -----
- smallSaveAsIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 2088343690 2119535780 1866038431 2352512158 3560536991 4281957279 4165041566 3847390612 2237959310 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1581744805 2120722634 1569307355 3451508718 4292273651 4291617521 4288990696 4252212658 4249387676 461084520 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4287143846 4285694857 4283662745 4282615725 4282813362 4289252322 4291355120 4283799744 4284120721 4286677886 4286677886 4286677886 4286677886 4287796623 16777215 16777215 4287534739 4294967295 4293126109 4291944164 4286032581 4281957279 4289975786 4288464094 4284256430 4292601323 4294967295 4294967295 4294967295 4287862160 16777215 16777215 4287994512 4294046193 4294046193 4293257444 4286818752 4281957279 4286756567 4288266713 4282416802 4290234575 4294046193 4293980657 4293980657 4287862160 16777215 16777215 4287862160 4293914864 4281957279 4281957279 4281957279 4281957279 4286756567 4284195788 4281957279 4281957279 4281957279 4281957279
4293980400 4287862160 16777215 16777215 4287862160 4293783022 4292073678 4281957279 4288793573 4286230477 4286230477 4286230477 4286361550 4288661474 4281957279 4288854206 4293848558 4287862160 16777215 16777215 4287862160 4294704123 4293519849 4291810762 4281957279 4288793573 4286361550 4286361550 4290040551 4281957279 4288656827 4293519849 4294375158 4287862160 16777215 16777215 4287862160 4294046193 4294704123 4293519849 4291810762 4281957279 4290106858 4288793573 4282154659 4288656827 4293519849 4294704123 4294046193 4287862160 16777215 16777215 4287862160 4293519849 4294046193 4294704123 4294704123 4292271570 4282613922 4281957279 4289182914 4294704123 4294835709 4294046193 4293519849 4287862160 16777215 2158208927 4289901488 4289835952 4289901488 4289901488 4289901488 4289901488 4289901488 4289901488 4289901488 4289901488 4289901488 4289901488 4289901488 4289901488 2158208927 4286677886 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 42
94967295 4294967295 4294967295 4278190080 4294967295 4294967295 4286677886 4286677886 4294967295 4290625211 4294967295 4290625212 4294967295 4290625211 4294967295 4290625211 4294967295 4291085763 4294967295 4278190080 4294967295 4294967295 4286677886 4286677886 4294967295 4291085763 4294967295 4291085763 4294967295 4291085763 4294967295 4291085763 4294967295 4291085763 4294967295 4278190080 4294967295 4294967295 4286677886 4286677886 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4278190080 4294967295 4294967295 4286677886 2155971454 4286677886 4286677886 4286677886 4286677886 4286677886 4286677886 4286677886 4286677886 4286677886 4286677886 4286677886 4286677886 4286677886 4286677886 2155971454)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallSaveIcon (in category 'accessing - icons') -----
- smallSaveIcon
-
- ^ Icons
- at: #smallSaveIcon
- ifAbsentPut: [ self smallSaveIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallSaveIconContents (in category 'private - icons') -----
- smallSaveIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 2089200540 2119802550 1865322161 2351730865 3559886514 4281306802 4164849841 3847723431 2238554017 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1581749686 2120857815 1569835238 3451969523 4292602614 4292012277 4289452015 4252872386 4249392559 461679227 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4287999926 4286748316 4284126380 4282227390 4282424771 4289779178 4291749876 4283738575 4284780964 4287862160 4287862160 4287862160 4287862160 4288849568 16777215 16777215 4288587684 4294967295 4293455075 4292404714 4286495186 4281306802 4290436848 4288991207 4284654271 4292930288 4294967295 4294967295 4294967295 4288980641 16777215 16777215 4289047457 4294243572 4294243572 4293586409 4287477965 4281306802 4287218657 4288859618 4282159540 4290892761 4294243572 4294178036 4294178036 4288980641 16777215 16777215 4288980641 4294112243 4281306802 4281306802 4281306802 4281306802 4287218657 4284068825 4281306802 4281306802 4281306802 4281306802
4294177779 4288980641 16777215 16777215 4288980641 4294046193 4292534487 4281306802 4289254892 4286693081 4286693081 4286693081 4286823898 4289188586 4281306802 4289578443 4294111729 4288980641 16777215 16777215 4288980641 4294769916 4293783021 4292337107 4281306802 4289254892 4286823898 4286823898 4290567150 4281306802 4289446856 4293783021 4294506744 4288980641 16777215 16777215 4288980641 4294243572 4294769916 4293783021 4292337107 4281306802 4290567664 4289254892 4281635253 4289446856 4293783021 4294769916 4294243572 4288980641 16777215 16777215 4288980641 4293783021 4294243572 4294769916 4294769916 4292732122 4282422196 4281306802 4289907150 4294769916 4294835709 4294243572 4293783021 4288980641 16777215 16777215 4288980641 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294506744 4294506744 4294111986 4294111986 4293783021 4288980641 16777215 16777215 4288980641 4288980641 4288980641 4288980641 4288980641 4288980641 4288980641 4288980641 42889806
41 4288980641 4288980641 4288980641 4288980641 4288980641 16777215 16777215 4288980641 4291085252 4291085252 4291085252 4291085252 4291085252 4291085252 4291085252 4291085252 4291085252 4291085252 4291085252 4291085252 4288980641 16777215 16777215 4288980641 4291085252 4291085252 4291085252 4291085252 4291085252 4291085252 4291085252 4291085252 4291085252 4291085252 4291085252 4291085252 4288980641 16777215 16777215 4288980641 4291151301 4291151301 4291151301 4291151301 4291151301 4291151301 4291151301 4291151301 4291151301 4291151301 4291151301 4291151301 4288980641 16777215 16777215 4288849568 4287862160 4287862160 4287862160 4287862160 4287862160 4287862160 4287862160 4287862160 4287862160 4287862160 4287862160 4287862160 4288849568 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallSaveNewIcon (in category 'accessing - icons') -----
- smallSaveNewIcon
-
- ^ Icons
- at: #smallSaveNewIcon
- ifAbsentPut: [ self smallSaveNewIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallSaveNewIconContents (in category 'private - icons') -----
- smallSaveNewIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 2089200540 2119802550 1865322161 2351730865 3559886514 4281306802 4164849841 3847723431 2238554017 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1581749686 2120857815 1569835238 3451969523 4292602614 4292012277 4289452015 4252872386 4249392559 461679227 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4287999926 4286748316 4284126380 4282227390 4282424771 4289779178 4291749876 4283738575 4284780964 4287862160 4287862160 4287862160 4287862160 4288849568 16777215 16777215 4288587684 4294967295 4293455075 4292404714 4286495186 4281306802 4290436848 4288991207 4284654271 4292930288 4294967295 4294967295 4294967295 4288980641 16777215 16777215 4289047457 4294243572 4294243572 4293586409 4287477965 4281306802 4287218657 4288859618 4282159540 4290892761 4294243572 4294178036 4294178036 4288980641 16777215 16777215 4288980641 4294112243 4281306802 4281306802 4281306802 4281306802 4287218657 4284068825 4281306802 4281306802 4281306802 4281306802
4294177779 4288980641 16777215 16777215 4288980641 4294046193 4292534487 4281306802 4289254892 4286693081 4286693081 4286693081 4286823898 4289188586 4281306802 4289578443 4294111729 4288980641 16777215 16777215 4288980641 4294769916 4293783021 4292337107 4281306802 4289254892 4286823898 4286823898 4290567150 4281306802 4289446856 4293783021 4294506744 4288980641 16777215 16777215 4288980641 4294243572 4294769916 4293783021 4292337107 4281306802 4290567664 4289254892 4281635253 4289446856 4293717228 4294704123 4294177779 4288980641 16777215 16777215 4288980641 4293783021 4294243572 4294769916 4294769916 4292732122 4282422196 4281306802 4289907150 4294769916 4294901502 4285890304 4294638330 4288980641 16777215 16777215 4288980641 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294440951 4294835709 4285890304 4294508288 4285890304 4293190883 16777216 16777215 4288980641 4292598747 4292598747 4292598747 4292598747 4292467161 4292598747 4292598747 42942435
72 4285890304 4289311744 4294508288 4289311744 4285890304 3003121663 16777215 4288980641 4291085252 4291085252 4291085252 4291085252 4291085252 4291085252 4291085252 4285890304 4294508288 4294508288 4294508288 4294508288 4294508288 4285890304 16777215 4288980641 4291085252 4291085252 4291085252 4291085252 4291085252 4291085252 4291085252 4293783021 4285890304 4289311744 4294508288 4289311744 4285890304 3003121663 16777215 4288980641 4291151301 4291151301 4291151301 4291151301 4291151301 4291151301 4291151301 4291151301 4293783021 4285890304 4294508288 4285890304 4293190883 16777215 16777215 4288849568 4287862160 4287862160 4287862160 4287862160 4287862160 4287862160 4287862160 4287862160 4287862160 4292796381 4285890304 4292796381 4288849568 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallScreenshotIcon (in category 'accessing - icons') -----
- smallScreenshotIcon
-
- ^ Icons
- at: #smallScreenshotIcon
- ifAbsentPut: [ self smallScreenshotIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallScreenshotIconContents (in category 'private - icons') -----
- smallScreenshotIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 16777215 16777215 1982540587 4283392626 4284446346 4284446346 4284446346 4265561434 1462117926 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4282009685 4294967295 4294967295 4294967295 4294967295 4278190079 4282075478 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4282010199 4292209663 4294967295 4294967295 4294967295 4289649663 4282075478 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4281483596 4285105307 4288332514 4288859118 4289649151 4285237151 4282207836 16777215 16777215 16777215 16777215 2738567995 4283524727 4283129455 4282339422 4282471266 4282997611 4287410126 16777215 16777215 16777215 4288595688 4281088066 4282207836 4282339422 4283393141 2738567995 4284315017 4291028223 4290371327 4294967295 4294967295 4289649663 4287871704 4288793068 4289123060 4289583358 4289649151 4291553535 4289649151 4291028223 4291815679 4262992929 428
4907927 4289649663 4284578703 4289386490 4289649663 4288595688 4291422207 4292472319 4291815679 4289649663 4288464102 4288464102 4287673812 4285500581 4290633983 4262992929 4284512397 4289452028 4284578703 4285830059 4288661482 4291028223 4290043391 4288661482 4288201184 4288201184 4287805142 4289386490 4285895853 4283524727 4289649663 4262992929 4284248967 4289188854 4284578703 4286093489 4289452028 4288135134 4288595688 4284512397 4281351496 4283656571 4287673812 4286159027 4288398052 4284117381 4289649663 4262992929 4284248967 4289188854 4284578703 4286093489 4288595688 4285500581 4281614926 4280429620 4279440147 4279440147 4281483596 4285105307 4285500581 4285171101 4289452028 4262992929 4284248967 4289188854 4284578703 4286685886 4285632423 4282997611 4282405472 4294967295 4289649663 4283393141 4281219910 4284973977 4285171101 4286356407 4289452028 4262795547 4284248967 4289188854 4284578703 4287476176 4285171101 4281746770 4283393141 4289649663 4294047999 4291422207 4284248967
4286159027 4285237151 4285830059 4289386490 4262795547 4284248967 4289188854 4284644497 4286685372 4285171101 4283063661 4279440147 4285961903 4292997631 4292866559 4286817728 4287673812 4285237151 4285961903 4288661482 4262269971 4283854207 4287937498 4288332771 4288003291 4288332514 4284842133 4280693050 4283524727 4284248967 4287410126 4290239999 4288201184 4288464102 4287015107 4286357176 4198056779 2738567995 4283854207 4283392626 4283392626 4262335254 4285171101 4285434531 4283393141 4284315017 4286093489 4284512397 4284051331 4283524727 4283392626 4283392369 2738567995 16777215 16777215 16777215 16777215 1261844022 2218408506 3578481483 4250166386 4283985793 4250166386 3595324751 1849178168 858927666 16777215 16777215 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallSearchIcon (in category 'accessing - icons') -----
- smallSearchIcon
-
- ^ Icons
- at: #smallSearchIcon
- ifAbsentPut: [ self smallSearchIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallSearchIconContents (in category 'private - icons') -----
- smallSearchIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 16777215 2844298120 4118971263 4270032000 4286677886 4102062717 2542571658 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1049398408 4169171584 4275361492 4292993763 4275887841 4292468193 4292796385 4275360979 4152328574 982356365 16777215 16777215 16777215 16777215 16777215 898667920 4269966464 4292993762 4188256462 4051150803 4202607067 4286296026 4050822352 4188584911 4293190884 4253123454 832018322 16777215 16777215 16777215 16777215 4118774141 4292993505 4204180946 4269518811 3989823728 3957780472 4242861558 3736589034 4252741594 4187666386 4293059298 4085153916 16777215 16777215 16777215 1989120396 4206278581 4188782032 4269518810 3890014453 3958108664 4042257914 4243058680 3705071349 3265316323 4269453018 4189701845 4155683760 1871811470 16777215 16777215 4286348921 4292993504 4285571534 4189508073 4225821173 4226149879 4209504247 4293258742 4040549618 3616191967 3850022619 4287476438 4292927711 4286348921 16
777215 16777215 4269900670 4292862434 4286230234 3418150637 3453149937 3336103923 3235703028 3856394484 1854058716 2054926555 2340269274 4286230234 4293454056 4269900670 16777215 16777215 4202725756 4293256677 4269846745 3013262819 3049314029 2999902193 2580077294 2762853096 1517990106 1820176348 2189209564 4235700950 4293059298 4185883004 16777215 16777215 3348469650 4224700367 4237407702 3312690387 2340269274 1970974426 1585098972 1920839387 1333702363 1702801116 3211500488 4254447831 4174631890 3231094675 16777215 16777215 1654103191 3801388691 4292403431 4286296026 2558111192 2004528861 1652207325 2172366553 1434169051 2071374035 4286296026 4292468967 3933895800 2122877572 16777215 16777215 16777215 3883761531 3971463351 4291024100 4286296026 3496384451 1987685334 2742594518 3445920446 4286361562 4291811035 4272203427 4120418711 4068179065 426141286 16777215 16777215 781949846 4152328572 3819086754 4292995310 4288790749 4269977817 4286296026 4288856541 4292666346 4252860027 4291
151300 4288125334 4253518213 3917052791 813727872 16777215 16777215 781949846 3833430139 3700527759 3802177952 4073573837 4293256677 3634076827 3782703477 1668247407 4286611838 4291085506 4288322970 4258386385 4286546045 16777215 16777215 16777215 16777215 1637391254 3063520407 4118774140 4286546300 3063520407 1637391254 16777215 2256436862 4286546045 4292203988 4292796126 4286546045 16777215 16777215 16777215 16777215 33554432 67108864 83886080 100663296 100663296 117440512 100663296 100663296 1685419381 4269834365 4286546045 1451262077 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallSelectIcon (in category 'accessing - icons') -----
- smallSelectIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallSelect'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallSelectIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallSelectIconContents (in category 'private - icons') -----
- smallSelectIconContents
- "Private - Method generated with the content of the file /home/dgd/smallSelect.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAABK0lEQVR4nKXOO0oEQRAG4L+6q2cfjojgBmJi
- YmroEQwNBBPxFF7AzBt4DMHcyFwUE2MRPIDruuxMd9VvsKCbrOJOQVNNPT5KcHK7gTjdA2UH
- MQzgnoCQIJ6AEAE3QFqQBSFk0DMcBaot1uxOobPjm/ODy/WhxrqvWvei1r35v1+FUIzM5mwz
- PZt7a2Qx98eX9/Hp1cOFJpV0uD8aYUmkKJJixLBCXKxv1qmCSz/0VKtly79FEJlnjdBVgG+o
- CljpgoVLJP499guQVFInIDtKJ6DJ3nQCPps86wTkgoYAVwYAycXYARAW8/8DKQZBgCgczdPr
- x3h3azBwEtmc5qQZWZx0gsXJUpzFOe85+fw2mQCIgrPrbVg6AtFAQgHpAOznyTzTHRCDLNRt
- ev8FfDedurn+q90AAAAASUVORK5CYII='!
Item was removed:
- ----- Method: MenuIcons class>>smallSqueakIcon (in category 'accessing - icons') -----
- smallSqueakIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallSqueak'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallSqueakIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallSqueakIconContents (in category 'private - icons') -----
- smallSqueakIconContents
- "Private - Method generated with the content of the file /home/dgd/smallSqueak.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAACWklEQVQ4jcWSW0hTARzGv52zeXY25ub0eEFd
- BBsztbYcC8PWhZEsctm6jFlEWkQRBT4U0ioiirSHMAgzijDqLeqlop60jGhGiEoaydKtXXWX
- pmdubpN5eukhTKM3v8f/x//38v2A1Q75j05UpVNfy5NLbdFwzANgCgCZV5h3qLiMaZ2JsjSA
- sZUA5Jb62uFae3Mju1FZM+cLH6eynENdvfbe4dPWMw1NJj3KGWPSG6KXBejqNHeNF47uejo1
- zWP7R5AqZ0hJcr7x7PlmlUgioi6fuA6/qpQWpRfy+csBKtUbjoiHEqj7HoCsQIVMGYEhZ0Cq
- 3WNAgUCAm/YupL66QcokxQQAHgkcLAH/EgAZAFRVa4TvevvQcqAJ2dgcnHMp7LfVo292Ft1+
- PwiSACWikQzFUoQExK1OMHceg7m6GULHTsv2jkg0QnBiGi6XC8FgEJkgiwabCYowi8EbT+Af
- /wG5VsnFIzND/CoI1+8DU7QIHixEVilpaWwrUinw6dE0KIqCx+MBXVOCjJdEca4YW5UK8E9a
- 4B33JOIT/nYiBzn5I+AjCAoDQoLU1WkgpQRob7XhQ+Ab1pmNsO7ehp+RBE7Z7CHn6EQ0PDYZ
- i/YPdwIY4FMQHOuAp4uleSrVOaucTWfIZDyB9HwabRetWOA4OD5OYtTnRTKZvvK858XD3/6k
- AID3pziMVvlerKuoUGyqFNDy3Jzc0kL0vv3M7fAtcu5w8OXgs9d7ly7GW3owm82v9Hq9UV6Q
- H7/dc/+Ly+3uzoZn3wBIrCDd3xYaDAa7yWR6AGDN/z6tXn4B2ljYZPClNw8AAAAASUVORK5C
- YII='!
Item was removed:
- ----- Method: MenuIcons class>>smallTimerIcon (in category 'accessing - icons') -----
- smallTimerIcon
-
- ^ Icons
- at: #smallTimerIcon
- ifAbsentPut: [ self smallTimerIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallTimerIconContents (in category 'private - icons') -----
- smallTimerIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 4288526525 4116212343 4116212343 4288526525 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4284515726 4284515726 4284515726 4284515726 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4284515726 4284515726 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 2639020888 4116212343 4284449675 4284515726 4284909712 3377418592 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1414084431 4149767289 4288526525 4291550689 4292208362 4292274155 4291419360 4288525497 4284515981 1414084431 16777215 16777215 16777215 16777215 16777215 1414084431 4267474568 4291090909 4291286488 4291875796 4284534498 4284534498 4293322728 4291877082 4291090909 4284450703 1414084431 16777215 16777215 16777215 16777215 4099434870 4291090909 4
290693837 4292798956 4284534498 4284534498 4284534498 4294046451 4293849072 4290693837 4291090909 4099434870 16777215 16777215 16777215 2639020888 4288526525 4291089366 4292730334 4278190080 4284534498 4284534498 4284534498 4294178037 4293914865 4292730334 4291089366 4288526525 2639020888 16777215 16777215 3931463791 4291550689 4290561222 4294046451 4293522164 4278190080 4285054413 4284534498 4294178037 4293980401 4294046451 4290561222 4291550689 4285369491 75530240 16777215 4284450446 4292208362 4291415245 4293980401 4294243573 4294310137 4278190080 4280778896 4293190885 4293914865 4293914608 4294440951 4292076519 4284582032 16777215 16777215 3931463791 4291550689 4290363586 4294243573 4293717229 4293783279 4284966759 4278190080 4293651693 4293454314 4294506745 4294046194 4291550689 4284842635 16777215 16777215 2639020888 4288526525 4290497486 4293651436 4294046193 4293717229 4294506745 4293585900 4293454057 4294111987 4294506744 4292272611 4288526525 4066077045 16777215 16777215 1
6777215 4116146551 4291090909 4289838785 4293980401 4294309365 4293717229 4293191142 4293783279 4294309366 4293323499 4291090909 4284712333 890442520 16777215 16777215 16777215 1731932739 4284251783 4291090909 4290562765 4291678674 4294309366 4294177780 4294375159 4292600805 4291090909 4284581518 3493280325 1325400064 67108864 16777215 16777215 385875968 2385323570 4216680057 4288526525 4291550689 4292208362 4292274155 4291550689 4288526525 4284514697 3593219383 2147483648 1090519040 16777215 16777215 16777215 16777215 520093696 1509949440 3493476934 4233325429 4284383883 4284450703 4284185988 4064366169 2650800128 2097152000 939524096 33554432 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallTrafficIcon (in category 'accessing - icons') -----
- smallTrafficIcon
-
- ^ Icons
- at: #smallTrafficIcon
- ifAbsentPut: [ self smallTrafficIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallTrafficIconContents (in category 'private - icons') -----
- smallTrafficIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 422804152 4281694648 4281694648 4281694648 4281694648 4281694648 4281694648 422804152 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4281694648 4289448421 4292255918 4293546071 4293546071 4292255918 4289448421 4281694648 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4281694648 4291288047 4293546071 4294836738 4294836738 4293546071 4291288047 4281694648 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4281694648 4291288047 4293546071 4294836738 4294836738 4293546071 4291288047 4281694648 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4281694648 4291288047 4292255918 4293546071 4293546071 4292255918 4291288047 4281694648 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 428
1694648 4291288047 4292265390 4293569111 4293569111 4292265390 4291288047 4281694648 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4281694648 4291288047 4293569111 4294872578 4294872578 4293569111 4291288047 4281694648 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4281694648 4291288047 4293569111 4294872578 4294872578 4293569111 4291288047 4281694648 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4281694648 4291288047 4292265390 4293569111 4293569111 4292265390 4291288047 4281694648 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4281694648 4291288047 4287747246 4282960727 4282960727 4287747246 4291288047 4281694648 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4281694648 4291288047 4282960727 4278370818 4278370818 4282960727 4291288047 4281694648 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4281694648 4291288047 4282960727 4278370
818 4278370818 4282960727 4291288047 4281694648 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 4281694648 4289448421 4287747246 4282960727 4282960727 4287747246 4289448421 4281694648 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 808811194 4281694648 4281694648 4281694648 4281694648 4281694648 4281694648 808811194 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallUndoIcon (in category 'accessing - icons') -----
- smallUndoIcon
-
- ^ Icons
- at: #smallUndoIcon
- ifAbsentPut: [ self smallUndoIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallUndoIconContents (in category 'private - icons') -----
- smallUndoIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 4292129024 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 348959488 4292129024 4292129024 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 295077632 4292129024 4294834103 4292129024 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 295077632 4292129024 4294834103 4294962176 4292129024 4292129024 3889082880 3486232576 2764878080 193694464 16777215 16777215 16777215 16777215 16777215 295077632 4292129024 4294834103 4294633738 4294896384 4294832763 4294832503 4294635126 4177194867 3570184704 3587224576 479367680 16777215 16777215 16777215 177838336 4292129024 4294834103 4294633472 4294699535 4294370304 4294633472 4294370304 4293646336 4294107683 4294635120 4276869437 3838882816 848269056 16777215 16777215 4292129024 4294834103 4294633472 4294
765071 4294699535 4294699535 4294633472 4294370304 4293909760 4293909760 4293909760 4294107683 4293515323 3402478080 177838336 16777215 295077632 4292129024 4294832770 4294765071 4294567680 4292988160 4292988160 4292988160 4293909760 4293909760 4293909760 4293448704 4294438002 4174625536 3419123968 16777215 16777215 295077632 4292129024 4294832766 4293185536 4294832766 4294766704 4294766704 4294766704 4294766704 4294764032 4293448704 4293054208 4294042744 4107187200 16777215 16777215 16777215 295077632 4292129024 4294832766 4294832766 4292129024 4292129024 4292129024 4292129024 4292000000 4294175095 4293448960 4294372208 4174361600 16777215 16777215 16777215 16777215 295077632 4292129024 4294832766 4292129024 16777215 16777215 819310336 1355393280 3386159616 4294569333 4294240640 4291867648 16777215 16777215 16777215 16777215 16777215 16777215 4292129024 4292129024 16777215 16777215 16777215 16777215 449753344 4292262912 4277595539 4291932928 16777215 16777215 16777215 16777215 1677
7215 16777215 16777215 4292129024 16777215 16777215 16777215 16777215 16777215 4275681792 4277134179 4023367168 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 584233984 4242919490 4276277570 2144319232 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1574154752 3002197102 2933044736 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1775351296 1775482368 416658688 16777215 16777215)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>smallUpdateIcon (in category 'accessing - icons') -----
- smallUpdateIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallUpdate'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallUpdateIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallUpdateIconContents (in category 'private - icons') -----
- smallUpdateIconContents
- "Private - Method generated with the content of the file /home/dgd/smallUpdate.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAACz0lEQVR4nI3SW2hTBwDG8f85iSdpEnIxR+01
- 0TlmbawOWy8PdXZYFRXLVHwYLt5ARMUXH0Rh0DxIq1jQl3irw6KCSMecKDiYVZEZ6+jEFsrs
- apektsY2tWnNSU/S0+T45IMgxO/5+35Pn8CXRyqysRmROoOIVReJSDl+MeZbOcx85XaYL2/Z
- tnV1bd16saKyGovVgZJ8z/ZNNQvzAYt27tja/dOe3UJfLEXwfhjloQqiAX+1i5JS75J8gDh/
- /jzhbqifJxNejHIFVWUzmcxo9IR7sNrs5nzAlDqp6mFVEYQCAZ9nJovnyuR0nbe9r3n+Ovom
- HzCazkzp5aUOwW1zM8tupvvvByhDL1lTs5Shwcg1sbzUsq92xcK++rqVI99VL+gvdnLLbWHZ
- R6C9/VFkTbWXRF+IcPtF0rF/WVtTyc0r5yfC72gRdmypGzjbcrPsRU8vnuLZSKLGrbartN24
- 8bb/VeRoMsd/P9av+8vhchlNZhMDkQGms9ncLM/immAw+FS0O53uI40XOPnnMAdau/Cf/oNh
- oZizF84VHjy0r1VVGej8p6szq88gqYgsqKhiND7aVVRUdALAKCLqU7qRVb5isjmdjl4DnUkd
- 57OX2O02Ach0vxpe2xe97isw4RlTuAcotRtzjwHEWGww7il0kZvWMBkNfF3oACClTDIxkcwC
- aUBRNZ6NKbQBSiAQcEqSpAIYX3SGWv0HjwXu3G7BOnseGYsXr7uQ5XPLaAn+PgJMAjQ1NS0T
- BEFOp9OqLMtHotHoJQABkDasXvLcv3evr6M7yrSWwfNNJb45Art37W86fDTwsyzLv42Pj49o
- mpaSJMmUSCTuNTc33/kIUAUW/6njqY5QCKvNSmwwRkpNx1d+X7+npKTkQCKRaG9oaDjzuaMY
- AGKgxYf+r9hU/0O5JBWIY2PvctGheOjbquWueDz+a2NjY2uew30SJ2D70vIHGPAd/9jj14AA
- AAAASUVORK5CYII='!
Item was removed:
- ----- Method: MenuIcons class>>smallUserQuestionIcon (in category 'accessing - icons') -----
- smallUserQuestionIcon
-
- ^ self fugueUserSilhouetteQuestionIcon!
Item was removed:
- ----- Method: MenuIcons class>>smallVolumeIcon (in category 'accessing - icons') -----
- smallVolumeIcon
- "Private - Generated method"
- ^ Icons
- at: #'smallVolume'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self smallVolumeIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>smallVolumeIconContents (in category 'private - icons') -----
- smallVolumeIconContents
- "Private - Method generated with the content of the file /home/dgd/smallVolume.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAQAAAC1+jfqAAAAAmJLR0QA/4ePzL8AAAE3SURB
- VHjajdE/SJRxHMfxF/f8Hp/n7vLhlAKhyKRCOpccA6EbFEW0BsciyKWphiBoCRuiQXEJnIyG
- ampyEppydy8wBOFEyPzHA0X1wNGggV0Ivbbv8h3eH44rKWkT/XUNqdhxgrjz5kBTA90SiVlD
- h0+PdI6PvZhKwDmPVL13G4KaOqcuTL+6k3z8iis+Sd0175pxy0H91ss066g+SKo+Q68uq4Zd
- 9M5DyyUdE6dHzg7XIrmdM7XHPriq8NoNaxJdgRypA7/Ezo8e9NjDpgzfhMC+kp92FXZb++u+
- KKPbd5S1Ak2xVJ+WH3nzqQE5Jq3IpPJgY2GOrDe+NxhCYUvZkkGXvHHfkuJPhkr/4pNiZlsD
- dbPq+ryVHS9Zqc1c39JAJhF5Zqw9dsXzw7yIXBb/u0fUNt7/+A0ZzEdfNHX2/wAAAABJRU5E
- rkJggg=='!
Item was removed:
- ----- Method: MenuIcons class>>smallWindowIcon (in category 'accessing - icons') -----
- smallWindowIcon
-
- ^ Icons
- at: #smallWindowIcon
- ifAbsentPut: [ self smallWindowIconContents ]!
Item was removed:
- ----- Method: MenuIcons class>>smallWindowIconContents (in category 'private - icons') -----
- smallWindowIconContents
- ^ (Form
- extent: 16 at 16
- depth: 32
- fromArray: #( 1556466370 4291217859 4291217859 4291217859 4291217859 4291217859 4291217859 4291217859 4291217859 4291217859 4291217859 1556466370 16777215 16777215 16777215 16777215 4291217859 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4291217859 16777215 16777215 16777215 16777215 4291217859 4294901502 4279720860 4279720860 4279720860 4279720860 4279720860 4279720860 4279720860 4279720860 4294835709 4291217859 16777215 16777215 16777215 16777215 4291217859 4294835708 4281563063 4281563063 4281563063 4281563063 4281563063 4281563063 4281563063 4281563063 4294769916 4291217859 16777215 16777215 16777215 16777215 4291217859 4294704379 4294638330 4294638330 4293388774 4291217859 4291217859 4291217859 4291217859 4291217859 4291217859 4291217859 4291217859 4291217859 4291217859 1556466370 4291217859 4294572537 4294506744 4294441208 4291217859 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4
294967295 4294967295 4294967295 4291217859 4291217859 4294572537 4294374901 4294309365 4291217859 4294901502 4279720860 4279720860 4279720860 4279720860 4279720860 4279720860 4279720860 4279720860 4294835709 4291217859 4291217859 4294309365 4294046193 4294111986 4291217859 4294835708 4281563063 4281563063 4281563063 4281563063 4281563063 4281563063 4281563063 4281563063 4294769916 4291217859 4291217859 4294111987 4293914350 4293848814 4291217859 4294704379 4294638330 4294638330 4294638330 4294572793 4294572537 4294572537 4294572537 4294572537 4294572793 4291217859 4291217859 4294046449 4293585643 4293585642 4291217859 4294572537 4294506744 4294441208 4294506488 4294506744 4294506487 4294440951 4294506487 4294506487 4294572537 4291217859 4291217859 4294374901 4294112242 4294177522 4291217859 4294572537 4294374901 4294309365 4294309365 4294309365 4294243829 4294309365 4294309365 4294374901 4294506744 4291217859 1589888702 4291217859 4291217859 4291217859 4291217859 4294309365 42940461
93 4294111986 4294111986 4294111986 4294111986 4294111986 4294111986 4294046193 4294243828 4291217859 16777215 16777215 16777215 16777215 4291217859 4294111987 4293914350 4293848814 4293848814 4293848814 4293783021 4293848814 4293848557 4293848558 4294111986 4291217859 16777215 16777215 16777215 16777215 4291217859 4294046449 4293585643 4293585642 4293585898 4293585642 4293585642 4293585642 4293585642 4293585642 4294046193 4291217859 16777215 16777215 16777215 16777215 4291217859 4294374901 4294112242 4294177522 4294111986 4294112243 4294111986 4294111986 4294177522 4294111986 4294111986 4291217859 16777215 16777215 16777215 16777215 1589888702 4291217859 4291217859 4291217859 4291217859 4291217859 4291217859 4291217859 4291217859 4291217859 4291217859 1556466370)
- offset: 0 at 0)!
Item was removed:
- ----- Method: MenuIcons class>>squeakIcon (in category 'accessing - icons') -----
- squeakIcon
- "Private - Generated method"
- ^ Icons
- at: #'squeak'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self squeakIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>squeakIconContents (in category 'private - icons') -----
- squeakIconContents
- "Private - Method generated with the content of the file /home/dgd/squeak.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABwAAAAcCAYAAAByDd+UAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAAFoklEQVRIie2VbXBU1RnHf/fu3ddsNrtsdmGT
- QN5gk2wQsiFWYpMgWE2DLaVqU5sPpEVq0VZn0k+ttaVjKwQcmLF+YIoNji/pkKYyrYQWMYIE
- quhEA+ElWRuTkLqbCNld9m6yy97N3tsPDLbTzmjkmzP+Pp455/mdeeb/nANf8kVHdxNnbi2v
- 8m63Zmc9Il+NuzVNOw8o/7On0Ol2/MjpdjwxIyeqNE2TgBEA4XOIxPzi/D/mL1l0R8PGNQs/
- SCY5deBoZiZ0ZU6vZDbOyrNHAJ07z9UxI89+984NDXqHy6ELjoVi7554X0kkEl2ZdObReQuL
- vIWvtDx8/73OTY08NzlJQlVBVYl1HEY9cHwmfiW6wrbA+pi/duVD7fu3WRa4F5CYTRJJp9l3
- LkBv8xPx8FS4QZyn7xs+f1n94u838btgkISqkgnLpAZHydl8D6am1VlZDtvBHId9y479v7bo
- DXqe/MkuGvKb+GbxtzgeGGVpa5MEbJTmYytctuTx5f7lrt1Pv0RuaR4fPvUCXFNQVZVYOoNx
- w+1Cvn/ZigdbN4hOtwMlpZDJZIjHZgDQHRtg5jtrzSazoXE+PrF+Xd1MMBjUuru7Nbe/TNu9
- Z4+2d+9erezer2kvv7VfW1JeqBX6SrTD57u0d9OntYDWr51Jva25PLkaoJlqyrWC489ouR7X
- h/Npqanav8rQ399PIBBg0/r7+GlbG5s3b6alqp6uaJTOY7/HbsuipKKYE7EYAAevRslxZANg
- yDajxhMg6eZuCPXAVhH+IMFOoPa/hKniolKpo6ODrq4uVvurOXnyJBUVFaSupXjtyD+wL3Li
- XV6KKIq8Mj3NoXCYU1emCV6aul7cmYM6Febq5ciIBGTr4LXbMXs2YS2IoQrPEtsqoz4VRd0F
- iJejV9R0Oq2zWq3U1dXR3t6O3W5ncHAQpwOCqRS/2fcLAJySxJFIBOG5wyRnkwBYbvORGRhJ
- zqWUPhH4+XqyrG/gKWolW3qMHN2b5NtsiI97K0t6Vn6l8lJgeFhsbm7GarViNBqZmJigpaUF
- t9uNUW8gMDBKPHo9IHUnL9Jf+zBvPNMFQG6eC92aKuS/nY4CJ3QCbPsLC312JEMCCQGwIzAp
- qMaC1ru8e/7Unu2vrxRePXKakekpli7MI5lM0tnZiaqqDCw282BJDaF/higoX0RFVRlKSuGd
- 4/1Ysi1Ubt+KcnEsM3Wwbwh4UhIRDDI24wXMaDdSQgazIAvuskIAFrgd/HDbfXjluxjsvEBr
- ayuBQIBFHg9n1now63TYbIv52cuHeGBpMT/+5RZubfBz4FqCM+NBIu2dMU3TfgVoUinmcDey
- 9ADmT1Iyi8jf9Wna71hFcDz0yfpah40ui8zY+DhtbW207N/NQ6ub+Pj1ECWLl3G055R2bvCF
- i5U1Pl9BUZ4gjwX5uLs3PZdK7wJeB5DuxrntVcJ3p0FqIAeZDM8ziX9dDUtKC1BVlVQyRTw2
- y/RUmB+0fp3u/vP0BMb43vYtbHK5mMgXGZ4YRRwNXRsZGq8vLC+6rfevJx6dvDQpz6XSHUDv
- jUsLAN8m1ztEYk8KbUXcIlotDSvtu/+8Q7jFYiEWkVFSCiazEVOWBZ1ORKf7z/j2HX2PcouP
- nvdP8/yLHQOX3xuu/rSh/v/Hu9i9UK+J54R11bkNj9wvrDMYKTeZyJH0uDy5GE0GkqrKcCJB
- XyyG8dhHrPEs5bdP7wj3H33TA6Q/n/A6ea4Sz7OynLgn685V6my116i/pVjMynOhZDLIsVky
- Z0fIfntIq01b1JH45UOjve80f5bs04QA1NTU9NbW1n41FAqlLv1rQhQknRqORMSP5EhAyahv
- EZ3pQ1F6gNRnieaL3efzXdi5c2fi7NmzmizLWmNj4weA/WYLzusD9nq9651O51ZFUYShoaF9
- iUTi0M0Kv+SLz78BjzNWmYcZV74AAAAASUVORK5CYII='!
Item was removed:
- ----- Method: MenuIcons class>>squeakLogoIcon (in category 'accessing - icons') -----
- squeakLogoIcon
- ^ Icons
- at: #squeakLogoIcon ifAbsentPut: [(Form
- extent: 24 at 16
- depth: 32
- fromArray: #( 0 0 67108865 2063597569 1778384897 889192449 0 0 0 0 0 0 0 0 0 0 0 0 1610612737 1811939329 1610612737 0 0 0 0 0 905969665 889192449 0 1442840577 788529153 0 0 0 0 0 0 0 0 0 0 1711276033 469762049 0 1728053249 0 0 0 0 0 1006632961 704643073 0 0 1895825409 234881025 0 0 0 0 0 0 0 0 1207959553 838860801 0 0 1728053249 0 0 0 0 0 738197505 989855745 0 0 167772161 1862270977 0 0 0 0 0 0 0 83886081 1879048193 0 0 0 1744830465 0 0 0 0 0 469762049 1258291201 0 0 0 1543503873 520093697 0 0 0 0 0 0 1543503873 335544321 0 0 0 1761607681 0 0 0 0 0 16777217 1644167169 0 0 0 33554433 67108865 0 0 0 0 0 0 33554433 0 0 0 0 1795162113 0 0 0 0 0 0 1711276033 0 0 0 0 0 117440513 0 0 0 0 0 0 0 0 0 100663297 1677721601 0 0 0 0 0 0 1744830465 0 0 0 0 3019898881 4009754625 1056964609 0 0 1090519041 3204448257 1325400065 0 0 0 889192449 889192449 0 0 0 0 0 0 1392508929 352321537 0 0 637534209 4278190081 4278190081 2650800129 0 0 3372220417 4278190081 3758096385 0 0 0 1560281089 117440513 0 0
0 0 0 0 0 0 0 0 134217729 4060086273 4278190081 1929379841 0 0 3187671041 4278190081 3590324225 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 704643073 1577058305 83886081 0 0 771751937 2667577345 956301313 0 0 0 0 0 0 0 0 0 0 369098753 973078529 1577058305 1728053249 1711276033 1325400065 805306369 218103809 0 855638017 922746881 16777217 0 268435457 788529153 1308622849 1593835521 1056964609 436207617 16777217 0 0 1442840577 1761607681 1409286145 788529153 301989889 872415233 1124073473 1627389953 1929379841 973078529 2030043137 4278190081 4278190081 2164260865 1040187393 1946157057 1577058305 939524097 452984833 687865857 1325400065 1778384897 1795162113 1392508929 0 0 855638017 1795162113 1677721601 855638017 620756993 436207617 486539265 285212673 2030043137 4278190081 4278190081 2164260865 486539265 1023410177 922746881 1157627905 1392508929 1845493761 1744830465 486539265 0 0 201326593 2013265921 1006632961 0 553648129 1694498817 1778384897 1694498817 1728053249 738197505 0 855638017 9227
46881 16777217 738197505 1728053249 1744830465 1778384897 1476395009 251658241 117440513 1476395009 1879048193 150994945 0 16777217 0 486539265 1426063361 16777217 0 0 0 0 0 0 0 0 0 0 0 0 234881025 1728053249 486539265 0 167772161 50331649)
- offset: 0 at 0)]!
Item was removed:
- ----- Method: MenuIcons class>>startUp: (in category 'class initialization') -----
- startUp: resuming
- resuming ifFalse: [^self].
- TranslationLocale = LocaleID current ifTrue:
- [^self].
- self initializeTranslations!
Item was removed:
- ----- Method: MenuIcons class>>subMenuMarker (in category 'accessing - icons') -----
- subMenuMarker
-
- ^ Icons
- at: #'subMenuMarker'
- ifAbsentPut:[ (Form
- extent: 5 at 9
- depth: 32
- fromArray: #( 4294967295 0 0 0 0 4294967295 4294967295 0 0 0 4294967295 4294967295 4294967295 0 0 4294967295 4294967295 4294967295 4294967295 0 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 0 4294967295 4294967295 4294967295 0 0 4294967295 4294967295 0 0 0 4294967295 0 0 0 0)
- offset: 0 at 0)].!
Item was removed:
- ----- Method: MenuIcons class>>volumeIcon (in category 'accessing - icons') -----
- volumeIcon
- "Private - Generated method"
- ^ Icons
- at: #'volume'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self volumeIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>volumeIconContents (in category 'private - icons') -----
- volumeIconContents
- "Private - Method generated with the content of the file /home/dgd/volume.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAQAAABKfvVzAAAABGdBTUEAALGOfPtRkwAAACBj
- SFJNAAB6JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAAAmJLR0QA/4ePzL8A
- AAAJcEhZcwAACxMAAAsTAQCanBgAAAHrSURBVDjLldTLahRBFMbx/xu02hEvm1mZIC4qovaA
- LhoE142+QIMvILoRgjASdKEilSBxO5CFIhKbmUAQNWmD6KCQxCAMEi+JGGKISuETfC665uIM
- DqRqd6hfn9Nd5zRidxsBV/jOH5rc5QhjJBDwnyUQ43xmix9ssMo8GRiygaBBg0dMM887FsCE
- jvyfUwEZaRdY5CrDnOUyt8GE7pbaIKEEgEGYNnjpowmYIXdfeQfErJMAUCliArFMAJwEM+Sm
- 9V5r6iopIC+eXdDiK1lycux+90Qb2tavAlQxFxgBwwoAl8haIH+sTKN6oZ/6rW1ttjJYzEMO
- QZUEKPnTgnxHmzqjHW3pm77ooxApEFC9QwoxVV+U8eCTmirrq9bU1KqWVNZBEewDe55JwGfM
- iT1Y0hud0gct661ea1HndEzEQOUiUxzoBwt6quNq6JVyPdOcTuuwCE6AtUywpx/Mqq5RPdec
- ZlVTTTjSBxBgp7gGCRYA136HG7qpYU2qrppqqou8VtxAcI8RyDBACddzD6GzbTAOFYIxjkLs
- C6pQbYHWMqGbUF11kcNeH2OdEhDgiHsBmNBZzXRaI2XFN4YtWr4LREREYEJ3vQNKfpRSXNGh
- PaBMBIb+ebA+Tz/wZPDE0ZMjgiAaBHb919jd/gvLk2YJrn7DBgAAAABJRU5ErkJggg=='!
Item was removed:
- ----- Method: MenuIcons class>>windowIcon (in category 'accessing - icons') -----
- windowIcon
- "Private - Generated method"
- ^ Icons
- at: #'window'
- ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self windowIconContents readStream) ].!
Item was removed:
- ----- Method: MenuIcons class>>windowIconContents (in category 'private - icons') -----
- windowIconContents
- "Private - Method generated with the content of the file /home/dgd/window.png"
- ^ 'iVBORw0KGgoAAAANSUhEUgAAABwAAAAcCAYAAAByDd+UAAAABHNCSVQICAgIfAhkiAAAABF0
- RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAAB5UlEQVR4nO2WP2gTURzHP/fuEqMpZ1vUKBqq
- FHFTB/+0XVSKRSxCBUVHQXHoUHeh4thFVwcnFwWdNFBErWgVVBIXBRGs1pZEjamtucvl7nKX
- O4fkoPXPkHqCw32m977vz4f3ePB7EBEyUtDoGzrbLRDpMDeX63XjceZqDvCDTAHoP3HuwsHd
- uy5uVNukuXQXruSR8ORlSaqyS6IuYwqX79MFfKG8mLx9pWeJcNv2HSOnx69Lq18+Z+zRJHmj
- xNEt+5Al0ZJs3tZ4kM/SrW7ivZant7+Xzx9n9n79NHDkbfbeXcBRAN69eq3cHzzJ+sPHWGsn
- SMopSvlCy6fz8NmqpOiwYgglxdybaWanpjArCzuBBeCpAmCZVZ4Uiwzs30NXpdRcXm5ZCLAO
- AJ2U6/Iwl8N1nGCoA5pXGospjI0Oo7YllyX5E4cO9HD8zHlmF2UCYE1nuwhbBhCPx9ic3rAk
- a+1VhEAkjISR8D8RGlXT9zzvnwjKuvGrsKxXStdujmPZtdBEtZrDrTsTfJgpUDMqepBLAH2D
- p4aFiF+WJGlFaMYGvmVoz7ITNy4BDpAJvhirVibVoaTaqYZps23L1ue/BHXOATJKs2OahvbN
- NDQrTOFPFGHRJwqQaRRJ6bfT/w6XRsWPCJ8feQeiSATBXJcAAAAASUVORK5CYII='!
Item was removed:
- StringMorph subclass: #MenuItemMorph
- instanceVariableNames: 'isEnabled subMenu isSelected target selector arguments icon'
- classVariableNames: 'SubMenuMarker'
- poolDictionaries: ''
- category: 'Morphic-Menus'!
-
- !MenuItemMorph commentStamp: '<historical>' prior: 0!
- I represent an item in a menu.
-
- Instance variables:
- isEnabled <Boolean> True if the menu item can be executed.
- subMenu <MenuMorph | nil> The submenu to activate automatically when the user mouses over the item.
- isSelected <Boolean> True if the item is currently selected.
- target <Object> The target of the associated action.
- selector <Symbol> The associated action.
- arguments <Array> The arguments for the associated action.
- icon <Form | nil> An optional icon form to be displayed to my left.
-
- If I have a dynamic marker, created by strings like <yes> or <no> in my contents, it will be installed as a submorph.!
Item was removed:
- ----- Method: MenuItemMorph class>>applyUserInterfaceTheme (in category 'preferences') -----
- applyUserInterfaceTheme
-
- SubMenuMarker := self defaultSubMenuMarker scaleIconToDisplay.!
Item was removed:
- ----- Method: MenuItemMorph class>>defaultSubMenuMarker (in category 'defaults') -----
- defaultSubMenuMarker
-
- ^ MenuIcons subMenuMarker dyed: ((UserInterfaceTheme current get: #textColor for: self) ifNil: [Color black]).!
Item was removed:
- ----- Method: MenuItemMorph class>>initialize (in category 'class initialization') -----
- initialize
- "MenuItemMorph initialize"
-
- SubMenuMarker := self defaultSubMenuMarker.
- !
Item was removed:
- ----- Method: MenuItemMorph class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ super themeProperties, {
- { #font. 'Fonts'. 'Font for menu items.' }.
- { #textColor. 'Colors'. 'Color for the menu item''s labels.' }.
- { #disabledTextColor. 'Colors'. 'Color to use for disabled menu item labels.' }.
- { #selectionColor. 'Colors'. 'Color used for items when hovering or selecting them.' }.
- { #selectionTextColor. 'Colors'. 'Color used for label when hovering or selecting them.' }.
- }!
Item was removed:
- ----- Method: MenuItemMorph>>aboutToBeGrabbedBy: (in category 'grabbing') -----
- aboutToBeGrabbedBy: aHand
- "Don't allow the receiver to act outside a Menu"
- | menu box |
- (owner notNil and:[owner submorphs size = 1]) ifTrue:[
- "I am a lonely menuitem already; just grab my owner"
- owner stayUp: true.
- ^owner aboutToBeGrabbedBy: aHand].
- box := self bounds.
- menu := MenuMorph new defaultTarget: nil.
- menu addMorphFront: self.
- menu bounds: box.
- menu stayUp: true.
- self isSelected: false.
- ^menu!
Item was removed:
- ----- Method: MenuItemMorph>>action: (in category 'accessing') -----
- action: aBlock
-
- self
- target: aBlock;
- selector: #value!
Item was removed:
- ----- Method: MenuItemMorph>>activateOwnerMenu: (in category 'events') -----
- activateOwnerMenu: evt
- "Activate our owner menu; e.g., pass control to it"
- owner ifNil:[^false]. "not applicable"
- (owner fullContainsPoint: evt position) ifFalse:[^false].
- owner activate: evt.
- ^true!
Item was removed:
- ----- Method: MenuItemMorph>>activateSubmenu: (in category 'events') -----
- activateSubmenu: evt
- "Activate our submenu; e.g., pass control to it"
- subMenu ifNil:[^false]. "not applicable"
- (subMenu fullContainsPoint: evt position) ifFalse:[^false].
- subMenu activate: evt.
- ^true!
Item was removed:
- ----- Method: MenuItemMorph>>adaptToWorld: (in category 'accessing') -----
- adaptToWorld: aWorld
-
- super adaptToWorld: aWorld.
- target := target adaptedToWorld: aWorld.!
Item was removed:
- ----- Method: MenuItemMorph>>addSubMenu: (in category 'accessing') -----
- addSubMenu: aBlock
-
- subMenu := self createSubmenu.
- aBlock value: subMenu.
- self changed.
- !
Item was removed:
- ----- Method: MenuItemMorph>>addUpdatingSubMenu: (in category 'accessing') -----
- addUpdatingSubMenu: aBlock
-
- subMenu := UpdatingMenuMorph new.
- subMenu updater: aBlock updateSelector: #value:.
- self changed.
- !
Item was removed:
- ----- Method: MenuItemMorph>>adjacentTo (in category 'selecting') -----
- adjacentTo
-
- ^{ self outerBounds topRight. self bounds topLeft }!
Item was removed:
- ----- Method: MenuItemMorph>>allWordingsNotInSubMenus: (in category 'accessing') -----
- allWordingsNotInSubMenus: verbotenSubmenuContentsList
- "Answer a collection of the wordings of all items and subitems, but omit the stay-up item, and also any items in any submenu whose tag is in verbotenSubmenuContentsList"
-
- self isStayUpItem ifTrue:[^ #()].
- subMenu ifNotNil:
- [^ (verbotenSubmenuContentsList includes: self contents asString)
- ifTrue:
- [#()]
- ifFalse:
- [subMenu allWordingsNotInSubMenus: verbotenSubmenuContentsList]].
-
- ^ Array with: self contents asString!
Item was removed:
- ----- Method: MenuItemMorph>>applyUserInterfaceTheme (in category 'updating') -----
- applyUserInterfaceTheme
-
- super applyUserInterfaceTheme.
-
- self
- color: (self userInterfaceTheme textColor ifNil: [Color black]);
- font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]).
- !
Item was removed:
- ----- Method: MenuItemMorph>>arguments (in category 'accessing') -----
- arguments
-
- ^ arguments
- !
Item was removed:
- ----- Method: MenuItemMorph>>arguments: (in category 'accessing') -----
- arguments: aCollection
-
- arguments := aCollection.
- !
Item was removed:
- ----- Method: MenuItemMorph>>bottomArrow (in category 'private') -----
- bottomArrow
- ^ ColorForm
- mappingWhiteToTransparentFrom: ((SubMenuMarker rotateBy: 90) asFormOfDepth:8)!
Item was removed:
- ----- Method: MenuItemMorph>>browseImplementationOfActionSelector (in category 'browse') -----
- browseImplementationOfActionSelector
-
- | method |
- method := self effectiveActionTarget class lookupSelector: self effectiveActionSelector.
- ToolSet browse: method methodClass selector: method selector.!
Item was removed:
- ----- Method: MenuItemMorph>>buildDebugMenu: (in category 'browse') -----
- buildDebugMenu: aHandMorph
- | aMenu |
- aMenu := super buildDebugMenu: aHandMorph.
- aMenu addLine.
- aMenu add: 'browse action code' translated target: self action: #browseImplementationOfActionSelector.
- aMenu add: 'debug action invocation' translated target: self action: #debugAction.
- ^ aMenu!
Item was removed:
- ----- Method: MenuItemMorph>>colorToUse (in category 'accessing') -----
- colorToUse
-
- ^ isSelected & isEnabled
- ifTrue: [ self userInterfaceTheme selectionTextColor ifNil: [Color white] ]
- ifFalse: [ color ]!
Item was removed:
- ----- Method: MenuItemMorph>>contentString (in category 'accessing') -----
- contentString
- ^self valueOfProperty: #contentString!
Item was removed:
- ----- Method: MenuItemMorph>>contentString: (in category 'accessing') -----
- contentString: aString
- aString
- ifNil: [self removeProperty: #contentString]
- ifNotNil: [self setProperty: #contentString toValue: aString]!
Item was removed:
- ----- Method: MenuItemMorph>>contents: (in category 'accessing') -----
- contents: aString
- ^self contents: aString withMarkers: true!
Item was removed:
- ----- Method: MenuItemMorph>>contents:withMarkers: (in category 'accessing') -----
- contents: aString withMarkers: aBool
- ^self contents: aString withMarkers: aBool inverse: false!
Item was removed:
- ----- Method: MenuItemMorph>>contents:withMarkers:inverse: (in category 'accessing') -----
- contents: aString withMarkers: aBool inverse: inverse
- "Set the menu item entry. If aBool is true, parse aString for embedded markers."
-
- | markerIndex marker |
- self contentString: nil. "get rid of old"
- aBool ifFalse: [^super contents: aString].
- self removeAllMorphs. "get rid of old markers if updating"
- self hasIcon ifTrue: [ self icon: nil ].
- (aString notEmpty and: [aString first = $<])
- ifFalse: [^super contents: aString].
- markerIndex := aString indexOf: $>.
- markerIndex = 0 ifTrue: [^super contents: aString].
- marker := (aString copyFrom: 1 to: markerIndex) asLowercase.
- (#('<on>' '<off>' '<yes>' '<no>') includes: marker)
- ifFalse: [^super contents: aString].
- self contentString: aString. "remember actual string"
- marker := (marker = '<on>' or: [marker = '<yes>']) ~= inverse
- ifTrue: [self onImage]
- ifFalse: [self offImage].
- super contents: (aString copyFrom: markerIndex + 1 to: aString size).
- "And set the marker"
- marker := ImageMorph new image: marker scaleIconToDisplay.
- marker position: self left @ (self top + 2).
- self addMorphFront: marker!
Item was removed:
- ----- Method: MenuItemMorph>>createSubmenu (in category 'private') -----
- createSubmenu
-
- ^MenuMorph new!
Item was removed:
- ----- Method: MenuItemMorph>>createUpdatingSubmenu (in category 'private') -----
- createUpdatingSubmenu
-
- ^UpdatingMenuMorph new!
Item was removed:
- ----- Method: MenuItemMorph>>debugAction (in category 'browse') -----
- debugAction
-
- (Process
- forBlock: [self doButtonAction]
- runUntil: [:context | context selector = self effectiveActionSelector])
- debugWithTitle: ('Debug menu action "{1}" in model "{2}"' translated format: {self contents. self target printString}).!
Item was removed:
- ----- Method: MenuItemMorph>>defaultBounds (in category 'initialization') -----
- defaultBounds
- "answer the default bounds for the receiver"
- ^ 0 @ 0 extent: 10 @ 10!
Item was removed:
- ----- Method: MenuItemMorph>>deleteIfPopUp: (in category 'initialization') -----
- deleteIfPopUp: evt
- "Recurse up for nested pop ups"
- owner ifNotNil:[owner deleteIfPopUp: evt].!
Item was removed:
- ----- Method: MenuItemMorph>>deselect: (in category 'selecting') -----
- deselect: evt
-
- self isSelected: false.
- subMenu ifNotNil: [
- owner ifNotNil: [ owner activeSubmenu: nil ] ].!
Item was removed:
- ----- Method: MenuItemMorph>>deselectItem (in category 'private') -----
- deselectItem
- | item |
- self isSelected: false.
- subMenu ifNotNil: [subMenu deleteIfPopUp].
- (owner isKindOf: MenuMorph) ifTrue:
- [item := owner popUpOwner.
- (item isKindOf: MenuItemMorph) ifTrue: [item deselectItem]].
- !
Item was removed:
- ----- Method: MenuItemMorph>>doButtonAction (in category 'events') -----
- doButtonAction
- "Called programattically, this should trigger the action for which the receiver is programmed"
-
- self invokeWithEvent: nil!
Item was removed:
- ----- Method: MenuItemMorph>>doLayoutIn: (in category 'layout') -----
- doLayoutIn: layoutBounds
- "Since we have no layout policy, make sure to compute the fullBounds right manually. Maybe we could also override #submorphBoundsForShrinkWrap, but since we have no submorphs, #adjustLayoutBounds is never called..."
-
- self hResizing = #shrinkWrap
- ifTrue: [self width: self minWidth].
- self vResizing = #shrinkWrap
- ifTrue: [self height: self minHeight].
-
- super doLayoutIn: layoutBounds.!
Item was removed:
- ----- Method: MenuItemMorph>>drawBackgroundOn: (in category 'drawing') -----
- drawBackgroundOn: aCanvas
-
- isSelected & isEnabled
- ifTrue: [aCanvas fillRectangle: self bounds fillStyle: self selectionFillStyle].!
Item was removed:
- ----- Method: MenuItemMorph>>drawIconOn: (in category 'drawing') -----
- drawIconOn: aCanvas
-
- self hasIcon ifTrue: [
- | iconForm |
- iconForm := self iconForm.
- aCanvas
- translucentImage: iconForm
- at: self bounds left @ (self top + (self height - iconForm height // 2)).].!
Item was removed:
- ----- Method: MenuItemMorph>>drawLabelOn: (in category 'drawing') -----
- drawLabelOn: aCanvas
-
- | stringBounds |
- stringBounds := self bounds.
-
- self hasIcon ifTrue: [
- stringBounds := stringBounds left: stringBounds left + self iconForm width + 2 ].
- self hasMarker ifTrue: [
- stringBounds := stringBounds left: stringBounds left + self submorphBounds width + 8 ].
-
- aCanvas
- drawString: self contents
- at: stringBounds left @ (stringBounds center y - (self fontToUse height // 2))
- font: self fontToUse
- color: self colorToUse.!
Item was removed:
- ----- Method: MenuItemMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- self
- drawBackgroundOn: aCanvas;
- drawIconOn: aCanvas;
- drawLabelOn: aCanvas;
- drawSubMenuMarkerOn: aCanvas.!
Item was removed:
- ----- Method: MenuItemMorph>>drawSubMenuMarkerOn: (in category 'drawing') -----
- drawSubMenuMarkerOn: aCanvas
-
- self hasSubMenu ifTrue: [
- | subMenuMarker subMenuMarkerPosition |
- subMenuMarker := self subMenuMarker.
- subMenuMarkerPosition := self right - subMenuMarker width @ (self top + self bottom - subMenuMarker height // 2).
- aCanvas paintImage: subMenuMarker at: subMenuMarkerPosition ]!
Item was removed:
- ----- Method: MenuItemMorph>>duplicateMorph: (in category 'grabbing') -----
- duplicateMorph: evt
- "Make and return a duplicate of the receiver's argument"
- | dup menu |
- dup := self duplicate isSelected: false.
- menu := MenuMorph new defaultTarget: nil.
- menu addMorphFront: dup.
- menu bounds: self bounds.
- menu stayUp: true.
- evt hand grabMorph: menu from: owner. "duplicate was ownerless so use #grabMorph:from: here"
- ^menu!
Item was removed:
- ----- Method: MenuItemMorph>>effectiveActionSelector (in category 'browse') -----
- effectiveActionSelector
-
- ^ self selector = #perform:orSendTo:
- ifTrue: [self arguments first]
- ifFalse: [self selector]!
Item was removed:
- ----- Method: MenuItemMorph>>effectiveActionTarget (in category 'browse') -----
- effectiveActionTarget
-
- ^ (self selector = #perform:orSendTo:
- and: [(self target respondsTo: self effectiveActionSelector) not])
- ifTrue: [self arguments second]
- ifFalse: [self target]!
Item was removed:
- ----- Method: MenuItemMorph>>handleMouseUp: (in category 'events') -----
- handleMouseUp: anEvent
- "The handling of control between menu item requires them to act on mouse up even if not the current focus. This is different from the default behavior which really only wants to handle mouse ups when they got mouse downs before"
- anEvent wasHandled ifTrue:[^self]. "not interested"
- anEvent hand releaseMouseFocus: self.
- anEvent wasHandled: true.
- self mouseUp: anEvent.!
Item was removed:
- ----- Method: MenuItemMorph>>handlesMouseDown: (in category 'events') -----
- handlesMouseDown: evt
-
- ^ true
- !
Item was removed:
- ----- Method: MenuItemMorph>>handlesMouseOver: (in category 'events') -----
- handlesMouseOver: anEvent
- ^true!
Item was removed:
- ----- Method: MenuItemMorph>>handlesMouseOverDragging: (in category 'events') -----
- handlesMouseOverDragging: evt
- ^true!
Item was removed:
- ----- Method: MenuItemMorph>>hasIcon (in category 'accessing') -----
- hasIcon
- "Answer whether the receiver has an icon. If menues without icons are
- requested, pretend to not bear one unless we have not content."
- ^ self icon notNil and: [
- Preferences menuWithIcons or: [self contents isEmptyOrNil]].!
Item was removed:
- ----- Method: MenuItemMorph>>hasIconOrMarker (in category 'accessing') -----
- hasIconOrMarker
- "Answer whether the receiver has an icon or a marker."
- ^ self hasIcon or: [ submorphs isEmpty not ]!
Item was removed:
- ----- Method: MenuItemMorph>>hasMarker (in category 'accessing') -----
- hasMarker
- "Answer whether the receiver has a marker morph."
- ^ submorphs isEmpty not!
Item was removed:
- ----- Method: MenuItemMorph>>hasSubMenu (in category 'accessing') -----
- hasSubMenu
- "Return true if the receiver has a submenu"
- ^subMenu notNil!
Item was removed:
- ----- Method: MenuItemMorph>>hasSubMenu: (in category 'accessing') -----
- hasSubMenu: aMenuMorph
- subMenu ifNil:[^false].
- subMenu == aMenuMorph ifTrue:[^true].
- ^subMenu hasSubMenu: aMenuMorph!
Item was removed:
- ----- Method: MenuItemMorph>>help: (in category 'accessing') -----
- help: aString
-
- self setBalloonText: aString!
Item was removed:
- ----- Method: MenuItemMorph>>icon (in category 'accessing') -----
- icon
- "answer the receiver's icon"
- ^ icon!
Item was removed:
- ----- Method: MenuItemMorph>>icon: (in category 'accessing') -----
- icon: aFormOrNil
-
- icon := aFormOrNil
- ifNotNil: [:form | form scaleIconToDisplay].
- self height: self minHeight.
- self width: self minWidth.!
Item was removed:
- ----- Method: MenuItemMorph>>iconForm (in category 'private') -----
- iconForm
- "private - answer the form to be used as the icon"
- ^ isEnabled
- ifTrue: [self icon]
- ifFalse: [self icon asGrayScale]!
Item was removed:
- ----- Method: MenuItemMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
-
- contents := ''.
- hasFocus := false.
- isEnabled := true.
- subMenu := nil.
- isSelected := false.
- target := nil.
- selector := nil.
- arguments := nil.
- font := self userInterfaceTheme font ifNil: [TextStyle defaultFont].
- self
- color: (self userInterfaceTheme textColor ifNil: [Color black]);
- hResizing: #spaceFill;
- vResizing: #shrinkWrap!
Item was removed:
- ----- Method: MenuItemMorph>>invokeWithEvent: (in category 'events') -----
- invokeWithEvent: evt
- "Perform the action associated with the given menu item."
-
- self isEnabled ifFalse: [^ self].
-
- (owner notNil and: [self isStayUpItem not]) ifTrue: [
- self flag: #workAround. "The tile system invokes menus straightforwardly so the menu might not be in the world."
- self world ifNotNil: [:world |
- owner deleteIfPopUp: evt.
- "Repair damage before invoking the action for better feedback"
- world displayWorldSafely]].
-
- selector ifNil: [^ self].
-
- Cursor normal showWhile: [
- "show cursor in case item opens a new MVC window"
- selector numArgs isZero
- ifTrue: [target perform: selector]
- ifFalse: [target perform: selector withArguments: (
- selector numArgs = arguments size
- ifTrue: [arguments]
- ifFalse: [arguments copyWith: evt] )] ].!
Item was removed:
- ----- Method: MenuItemMorph>>isEnabled (in category 'accessing') -----
- isEnabled
-
- ^ isEnabled
- !
Item was removed:
- ----- Method: MenuItemMorph>>isEnabled: (in category 'accessing') -----
- isEnabled: aBoolean
-
- | colorToUse |
- isEnabled = aBoolean ifTrue: [^ self].
- isEnabled := aBoolean.
-
- colorToUse := isEnabled
- ifTrue: [self userInterfaceTheme textColor ifNil: [Color black]]
- ifFalse: [self userInterfaceTheme disabledTextColor ifNil: [Color gray]].
-
- self color: colorToUse.!
Item was removed:
- ----- Method: MenuItemMorph>>isMenuItemMorph (in category 'testing') -----
- isMenuItemMorph
- ^true!
Item was removed:
- ----- Method: MenuItemMorph>>isSelected (in category 'selecting') -----
- isSelected
- ^ isSelected !
Item was removed:
- ----- Method: MenuItemMorph>>isSelected: (in category 'selecting') -----
- isSelected: aBoolean
-
- isSelected := aBoolean.
- self changed.
- !
Item was removed:
- ----- Method: MenuItemMorph>>isStayUpItem (in category 'accessing') -----
- isStayUpItem
-
- ^selector == #toggleStayUp: or: [selector == #toggleStayUpIgnore:evt:]!
Item was removed:
- ----- Method: MenuItemMorph>>itemWithWording: (in category 'accessing') -----
- itemWithWording: wording
- "If any of the receiver's items or submenu items have the given wording (case-blind comparison done), then return it, else return nil."
- (self contents asString sameAs: wording) ifTrue:[^self].
- subMenu ifNotNil:[^subMenu itemWithWording: wording].
- ^nil!
Item was removed:
- ----- Method: MenuItemMorph>>leftArrow (in category 'private') -----
- leftArrow
- ^ ColorForm
- mappingWhiteToTransparentFrom: ((SubMenuMarker rotateBy: 180)asFormOfDepth: 8)!
Item was removed:
- ----- Method: MenuItemMorph>>minHeight (in category 'layout') -----
- minHeight
- | iconHeight |
- iconHeight := self hasIcon
- ifTrue: [self icon height + 2]
- ifFalse: [0].
- ^ self fontToUse lineGridForMorphs max: iconHeight!
Item was removed:
- ----- Method: MenuItemMorph>>minWidth (in category 'layout') -----
- minWidth
-
- | subMenuWidth iconWidth markerWidth |
- subMenuWidth := self hasSubMenu
- ifTrue: [ 10 ]
- ifFalse: [ 0 ].
- iconWidth := self hasIcon
- ifTrue: [ self icon width + 2 ]
- ifFalse: [ 0 ].
- markerWidth := self hasMarker
- ifTrue: [ self submorphBounds width + 8 ]
- ifFalse: [ 0 ].
- ^(self fontToUse widthOfString: contents)
- + subMenuWidth + iconWidth + markerWidth + self stringMargin!
Item was removed:
- ----- Method: MenuItemMorph>>mouseDown: (in category 'events') -----
- mouseDown: evt
- "Handle a mouse down event. Menu items get activated when the mouse is over them."
-
- evt shiftPressed ifTrue: [ ^super mouseDown: evt ]. "enable label editing"
- evt hand newMouseFocus: owner. "Redirect to menu for valid transitions"
- owner selectItem: self event: evt!
Item was removed:
- ----- Method: MenuItemMorph>>mouseEnter: (in category 'events') -----
- mouseEnter: evt
- "The mouse entered the receiver"
-
- owner ifNotNil: [ owner selectItem: self event: evt ]!
Item was removed:
- ----- Method: MenuItemMorph>>mouseEnterDragging: (in category 'events') -----
- mouseEnterDragging: evt
-
- self mouseEnter: evt.!
Item was removed:
- ----- Method: MenuItemMorph>>mouseUp: (in category 'events') -----
- mouseUp: evt
- "Handle a mouse up event. Menu items get activated when the mouse is over them. Do nothing if we're not in a 'valid menu transition', meaning that the current hand focus must be aimed at the owning menu."
-
- evt hand mouseFocus == owner ifFalse: [ ^self ].
- self contentString ifNotNil: [
- self contents: self contentString withMarkers: true inverse: true.
- self refreshWorld.
- (Delay forMilliseconds: 200) wait ].
- self deselect: evt.
- self invokeWithEvent: evt.
- !
Item was removed:
- ----- Method: MenuItemMorph>>offImage (in category 'private') -----
- offImage
- "Return the form to be used for indicating an '<off>' marker"
-
- ^ MenuIcons checkBoxOff dyed: (self userInterfaceTheme textColor ifNil: [Color black])!
Item was removed:
- ----- Method: MenuItemMorph>>onImage (in category 'private') -----
- onImage
- "Return the form to be used for indicating an '<on>' marker"
-
- ^ MenuIcons checkBoxOn dyed: (self userInterfaceTheme textColor ifNil: [Color black])!
Item was removed:
- ----- Method: MenuItemMorph>>rightArrow (in category 'private') -----
- rightArrow
-
- ^ SubMenuMarker!
Item was removed:
- ----- Method: MenuItemMorph>>select: (in category 'selecting') -----
- select: evt
- self isSelected: true.
- owner activeSubmenu: subMenu.
- subMenu ifNotNil: [
- subMenu delete.
- subMenu
- popUpAdjacentTo: self adjacentTo
- forHand: evt hand
- from: self.
- subMenu selectItem: nil event: evt].!
Item was removed:
- ----- Method: MenuItemMorph>>selectionFillStyle (in category 'private') -----
- selectionFillStyle
- " Answer the fill style to use with the receiver is the selected element "
-
- | fill baseColor |
- baseColor := self userInterfaceTheme selectionColor ifNil: [Color r: 0.4 g: 0.5 b: 0.7].
- MenuMorph gradientMenu ifFalse: [ ^baseColor ].
-
- fill := GradientFillStyle ramp: {
- 0.0 -> baseColor thriceLighter.
- 1 -> baseColor thriceDarker }.
- fill origin: self topLeft.
- fill direction: 0 @ self height.
- ^ fill!
Item was removed:
- ----- Method: MenuItemMorph>>selector (in category 'accessing') -----
- selector
-
- ^ selector
- !
Item was removed:
- ----- Method: MenuItemMorph>>selector: (in category 'accessing') -----
- selector: aSymbol
-
- selector := aSymbol.
- !
Item was removed:
- ----- Method: MenuItemMorph>>stringMargin (in category 'layout') -----
- stringMargin
-
- ^ Preferences tinyDisplay
- ifTrue: [ 0 "Rely on other measures"]
- ifFalse: [ ((self fontToUse widthOf: Character space) * 1.5) truncated " 100% = 6px "]
- !
Item was removed:
- ----- Method: MenuItemMorph>>subMenu (in category 'accessing') -----
- subMenu
-
- ^ subMenu
- !
Item was removed:
- ----- Method: MenuItemMorph>>subMenu: (in category 'accessing') -----
- subMenu: aMenuMorph
-
- subMenu := aMenuMorph.
- self changed.
- !
Item was removed:
- ----- Method: MenuItemMorph>>subMenuMarker (in category 'private') -----
- subMenuMarker
- "private - answer the form to be used as submenu marker"
-
- ^self rightArrow!
Item was removed:
- ----- Method: MenuItemMorph>>subMenuUpdater:selector: (in category 'accessing') -----
- subMenuUpdater: updater selector: selector
-
- subMenu := self createUpdatingSubmenu.
- subMenu updater: updater updateSelector: selector.
- self changed.
- !
Item was removed:
- ----- Method: MenuItemMorph>>subMenuUpdater:selector:arguments: (in category 'accessing') -----
- subMenuUpdater: updater selector: selector arguments: arguments
-
- subMenu := self createUpdatingSubmenu.
- subMenu updater: updater updateSelector: selector arguments: arguments.
- self changed.
- !
Item was removed:
- ----- Method: MenuItemMorph>>target (in category 'accessing') -----
- target
-
- ^ target!
Item was removed:
- ----- Method: MenuItemMorph>>target: (in category 'accessing') -----
- target: anObject
-
- target := anObject.
- !
Item was removed:
- ----- Method: MenuItemMorph>>upArrow (in category 'private') -----
- upArrow
- ^ ColorForm
- mappingWhiteToTransparentFrom: ((SubMenuMarker rotateBy: 270)asFormOfDepth: 8)!
Item was removed:
- ----- Method: MenuItemMorph>>updateLayoutInDockingBar (in category 'private') -----
- updateLayoutInDockingBar!
Item was removed:
- ----- Method: MenuItemMorph>>veryDeepFixupWith: (in category 'copying') -----
- veryDeepFixupWith: deepCopier
- "If target and arguments fields were weakly copied, fix them here. If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"
-
- super veryDeepFixupWith: deepCopier.
- target := deepCopier references at: target ifAbsent: [target].
- arguments notNil ifTrue:
- [arguments := arguments collect: [:each |
- deepCopier references at: each ifAbsent: [each]]]!
Item was removed:
- ----- Method: MenuItemMorph>>veryDeepInner: (in category 'copying') -----
- veryDeepInner: deepCopier
- "Copy all of my instance variables. Some need to be not copied
- at all, but shared. Warning!!!! Every instance variable defined in
- this class must be handled. We must also implement
- veryDeepFixupWith:. See DeepCopier class comment."
- super veryDeepInner: deepCopier.
- isEnabled := isEnabled veryDeepCopyWith: deepCopier.
- subMenu := subMenu veryDeepCopyWith: deepCopier.
- isSelected := isSelected veryDeepCopyWith: deepCopier.
- icon := icon veryDeepCopyWith: deepCopier.
- "target := target. Weakly copied"
- "selector := selector. a Symbol"
- arguments := arguments.!
Item was removed:
- Morph subclass: #MenuMorph
- instanceVariableNames: 'defaultTarget selectedItem stayUp popUpOwner activeSubMenu originalFocusHolder'
- classVariableNames: 'CloseBoxImage CloseBoxImageFlat CloseBoxImageGradient GradientMenu MenuBorderColor MenuBorderWidth MenuColor MenuLineColor MenuSelectionColor MenuTitleBorderColor MenuTitleBorderWidth MenuTitleColor PushPinImage RoundedMenuCorners'
- poolDictionaries: ''
- category: 'Morphic-Menus'!
-
- !MenuMorph commentStamp: '<historical>' prior: 0!
- Instance variables:
- defaultTarget <Object> The default target for creating menu items
- selectedItem <MenuItemMorph> The currently selected item in the receiver
- stayUp <Boolean> True if the receiver should stay up after clicks
- popUpOwner <MenuItemMorph> The menu item that automatically invoked the receiver, if any.
- activeSubMenu <MenuMorph> The currently active submenu.!
Item was removed:
- ----- Method: MenuMorph class>>chooseFrom:lines:title: (in category 'utilities') -----
- chooseFrom: aList lines: linesArray title: queryString
- "Choose an item from the given list. Answer the index of the selected item."
-
- | menu aBlock result |
- aBlock := [:v | result := v].
- menu := self new.
- menu addTitle: queryString.
- 1 to: aList size do: [:i|
- menu add: (aList at: i) asString target: aBlock selector: #value: argument: i.
- (linesArray includes: i) ifTrue:[menu addLine]].
- MenuIcons decorateMenu: menu.
- result := 0.
- menu
- invokeAt: self currentHand position
- in: self currentWorld
- allowKeyboard: true.
- ^ result!
Item was removed:
- ----- Method: MenuMorph class>>chooseFrom:values:lines:title: (in category 'utilities') -----
- chooseFrom: aList values: valueList lines: linesArray title: queryString
- "Choose an item from the given list. Answer the index of the selected item."
- | index |
- index := self chooseFrom: aList lines: linesArray title: queryString.
- ^ valueList at: index ifAbsent: [nil]!
Item was removed:
- ----- Method: MenuMorph class>>closeBoxImage (in category 'images') -----
- closeBoxImage
-
- ^ self gradientMenu
- ifTrue: [self closeBoxImageGradient]
- ifFalse: [self closeBoxImageFlat]!
Item was removed:
- ----- Method: MenuMorph class>>closeBoxImageFlat (in category 'images') -----
- closeBoxImageFlat
-
- ^ CloseBoxImageFlat ifNil: [CloseBoxImageFlat := SystemWindow closeBoxImageFlat]!
Item was removed:
- ----- Method: MenuMorph class>>closeBoxImageGradient (in category 'images') -----
- closeBoxImageGradient
-
- ^ CloseBoxImageGradient ifNil: [CloseBoxImageGradient := SystemWindow closeBoxImageGradient]!
Item was removed:
- ----- Method: MenuMorph class>>confirm: (in category 'utilities') -----
- confirm: queryString
- "Put up a yes/no menu with caption queryString. Answer true if the
- response is yes, false if no. This is a modal question--the user must
- respond yes or no."
-
- "MenuMorph confirm: 'Are you hungry?'"
-
- ^ self confirm: queryString trueChoice: 'Yes' translated falseChoice: 'No' translated!
Item was removed:
- ----- Method: MenuMorph class>>confirm:orCancel: (in category 'utilities') -----
- confirm: queryString orCancel: cancelBlock
- "Put up a yes/no/cancel menu with caption aString. Answer true if the response is yes, false if no. If cancel is chosen, evaluate cancelBlock. This is a modal question--the user must respond yes or no."
- "MenuMorph confirm: 'Reboot universe' orCancel:[^'Nevermind'] "
- | choice |
- choice := self chooseFrom: {'Yes' translated. 'No' translated. 'Cancel' translated}
- lines: #()
- title: queryString.
- choice = 1 ifTrue: [^ true].
- choice = 2 ifTrue: [^ false].
- ^ cancelBlock value!
Item was removed:
- ----- Method: MenuMorph class>>confirm:trueChoice:falseChoice: (in category 'utilities') -----
- confirm: queryString trueChoice: trueChoice falseChoice: falseChoice
- "Put up a yes/no menu with caption queryString. The actual wording for the two choices will be as provided in the trueChoice and falseChoice parameters. Answer true if the response is the true-choice, false if it's the false-choice. This is a modal question -- the user must respond one way or the other."
- "MenuMorph
- confirm: 'Are you hungry?'
- trueChoice: 'yes, I''m famished'
- falseChoice: 'no, I just ate'"
-
- | menu aBlock result |
- aBlock := [:v | result := v].
- menu := self new.
- menu addTitle: queryString icon: MenuIcons confirmIcon.
- menu add: trueChoice target: aBlock selector: #value: argument: true.
- menu add: falseChoice target: aBlock selector: #value: argument: false.
- MenuIcons decorateMenu: menu.
- [menu
- invokeAt: self currentHand position
- in: self currentWorld
- allowKeyboard: true.
- result == nil] whileTrue.
- ^ result!
Item was removed:
- ----- Method: MenuMorph class>>entitled: (in category 'instance creation') -----
- entitled: aString
- "Answer a new instance of me with the given title."
-
- ^ self new addTitle: aString
- !
Item was removed:
- ----- Method: MenuMorph class>>example (in category 'example') -----
- example
- "MenuMorph example popUpInWorld"
-
- | menu |
- menu := MenuMorph new.
- menu addTitle: 'Fruit' translated.
- menu addStayUpItem.
- menu add: 'apples' action: #apples.
- menu add: 'oranges' action: #oranges.
- menu addLine.
- menu addLine. "extra lines ignored"
- menu add: 'peaches' action: #peaches.
- menu addLine.
- menu add: 'pears' action: #pears.
- menu addLine.
- menu add: 'test' subMenu: (MenuMorph new
- defaultTarget: #peaches;
- add: 'foo' action: #inspect;
- yourself) target: 42 selector: #inform: argumentList: #('hello').
- ^ menu!
Item was removed:
- ----- Method: MenuMorph class>>fromArray: (in category 'instance creation') -----
- fromArray: anArray
- "Construct a menu from anArray. The elements of anArray
- must be either:
- * A pair of the form: <label> <selector>
- or * The 'dash' (or 'minus sign') symbol
-
- Refer to the example at the bottom of the method"
- | menu |
-
- menu := self new.
-
- anArray
- do: [:anElement |
- anElement size = 1
- ifTrue: [
- anElement == #- ifFalse: [^ self error: 'badly-formed menu constructor'].
- menu addLine.
- ]
- ifFalse: [
- anElement size = 2 ifFalse: [^ self error: 'badly-formed menu constructor'].
- menu add: anElement first action: anElement second.
- ]
- ].
-
- ^ menu!
Item was removed:
- ----- Method: MenuMorph class>>gradientMenu (in category 'preferences') -----
- gradientMenu
-
- <preference: 'gradientMenu'
- category: #menus
- description: 'If true, the menus will have a gradient look.'
- type: #Boolean>
- ^ GradientMenu ifNil: [true]!
Item was removed:
- ----- Method: MenuMorph class>>gradientMenu: (in category 'preferences') -----
- gradientMenu: aBoolean
-
- GradientMenu = aBoolean ifTrue: [^ self].
- GradientMenu := aBoolean.
-
- self flag: #refactor. "mt: Heavy use of the gradient-menu property..."
-
- SystemProgressMorph reset.
- PluggableTextMorph flushAdornmentCache.
-
- MenuMorph allSubInstancesDo: [:ea | ea setDefaultParameters; setTitleParameters; updateColor].
- DockingBarMorph allSubInstancesDo: [:ea | ea setDefaultParameters; updateColor].
-
- TheWorldMainDockingBar updateInstances.
- PluggableListMorph allSubInstancesDo: [:ea | ea setListParameters].
- SimpleHierarchicalListMorph allSubInstancesDo: [:ea | ea setDefaultParameters].
- !
Item was removed:
- ----- Method: MenuMorph class>>inform: (in category 'utilities') -----
- inform: queryString
- "MenuMorph inform: 'I like Squeak'"
-
- | menu |
- menu := self new.
- menu addTitle: queryString icon: MenuIcons confirmIcon.
- menu add: 'OK' translated target: self selector: #yourself.
- MenuIcons decorateMenu: menu.
- menu
- invokeAt: self currentHand position
- in: self currentWorld
- allowKeyboard: true.!
Item was removed:
- ----- Method: MenuMorph class>>initialize (in category 'instance creation') -----
- initialize
-
- "MenuMorph initialize"
- CloseBoxImage := nil.
- PushPinImage := nil.
-
- !
Item was removed:
- ----- Method: MenuMorph class>>pushPinImage (in category 'images') -----
- pushPinImage
- "Answer the push-pin image, creating and caching it at this time if it is absent"
-
- ^ MenuIcons smallPinIcon!
Item was removed:
- ----- Method: MenuMorph class>>roundedMenuCorners (in category 'preferences') -----
- roundedMenuCorners
-
- <preference: 'roundedMenuCorners'
- category: #menus
- description: 'Whether morphic menus should have rounded corners.'
- type: #Boolean>
- ^ RoundedMenuCorners ifNil: [true]!
Item was removed:
- ----- Method: MenuMorph class>>roundedMenuCorners: (in category 'preferences') -----
- roundedMenuCorners: aBoolean
-
- RoundedMenuCorners := aBoolean.
- SystemProgressMorph reset.
- TheWorldMainDockingBar updateInstances.!
Item was removed:
- ----- Method: MenuMorph class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ super themeProperties, {
- { #borderColor. 'Colors'. 'Color of the menu''s border.' }.
- { #borderWidth. 'Borders'. 'Width of the menu''s border.' }.
- { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }.
- { #color. 'Colors'. 'Background color of the menu.' }.
-
- { #titleBorderColor. 'Colors'. 'Color of the menu title border.' }.
- { #titleBorderWidth. 'Geometry'. 'Width of the menu title border.' }.
- { #titleBorderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset for the title.' }.
- { #titleColor. 'Colors'. 'Background color of the menu'' title.' }.
- { #titleFont. 'Fonts'. 'Font for menu title.' }.
- { #titleTextColor. 'Colors'. 'Color for the menu title label.' }.
-
- { #lineColor. 'Colors'. 'Color of the separators between menu items.' }.
- { #lineStyle. 'Colors'. 'Use border-style to change appearance.' }.
- { #lineWidth. 'Geometry'. 'How big the separators should be.' }.
- }!
Item was removed:
- ----- Method: MenuMorph>>activate: (in category 'events') -----
- activate: evt
- "Receiver should be activated; e.g., so that control passes correctly."
- evt hand
- newMouseFocus: self;
- newKeyboardFocus: self!
Item was removed:
- ----- Method: MenuMorph>>activeSubmenu: (in category 'control') -----
- activeSubmenu: aSubmenu
- activeSubMenu ifNotNil: [
- activeSubMenu delete ].
- activeSubMenu := aSubmenu.
- activeSubMenu ifNotNil: [
- activeSubMenu updateMenu ]!
Item was removed:
- ----- Method: MenuMorph>>add:action: (in category 'construction') -----
- add: aString action: aSymbolOrValuable
- "Append a menu item with the given label. If the item is selected, it will send the given selector to the default target object."
- "Details: Note that the menu item added captures the default target object at the time the item is added; the default target can later be changed before added additional items without affecting the targets of previously added entries. The model is that each entry is like a button that knows everything it needs to perform its action."
- aSymbolOrValuable isSymbol
- ifTrue:
- [ self
- add: aString
- target: defaultTarget
- selector: aSymbolOrValuable
- argumentList: Array empty ]
- ifFalse:
- [ self
- add: aString
- target: aSymbolOrValuable
- selector: #value
- argumentList: Array empty ]!
Item was removed:
- ----- Method: MenuMorph>>add:help:action: (in category 'construction') -----
- add: wordingString help: helpString action: aSymbol
- "Append a menu item with the given label. If the item is
- selected, it will send the given selector to the default target
- object."
- "Details: Note that the menu item added captures the default
- target object at the time the item is added; the default target
- can later be changed before added additional items without
- affecting the targets of previously added entries. The model is
- that each entry is like a button that knows everything it needs
- to perform its action."
- self
- add: wordingString
- target: defaultTarget
- selector: aSymbol
- argumentList: Array empty.
- self balloonTextForLastItem:helpString!
Item was removed:
- ----- Method: MenuMorph>>add:icon:help:subMenu: (in category 'construction') -----
- add: wordingString icon: aForm help: helpString subMenu: aMenuMorph
- "Append the given submenu with the given label."
- | item |
- item := MenuItemMorph new.
-
- item contents: wordingString.
- item subMenu: aMenuMorph.
- item icon: aForm.
- helpString isNil
- ifFalse: [item setBalloonText: helpString].
- self addMorphBack: item!
Item was removed:
- ----- Method: MenuMorph>>add:icon:subMenu: (in category 'construction') -----
- add: wordingString icon: aForm subMenu: aMenuMorph
- "Append the given submenu with the given label."
- ^ self
- add: wordingString
- icon: aForm
- help: nil
- subMenu: aMenuMorph!
Item was removed:
- ----- Method: MenuMorph>>add:selector:argument: (in category 'construction') -----
- add: aString selector: aSymbol argument: arg
-
- self add: aString
- target: defaultTarget
- selector: aSymbol
- argumentList: (Array with: arg)
- !
Item was removed:
- ----- Method: MenuMorph>>add:subMenu: (in category 'construction') -----
- add: aString subMenu: aMenuMorph
- "Append the given submenu with the given label."
- self
- add: aString
- icon: nil
- subMenu: aMenuMorph!
Item was removed:
- ----- Method: MenuMorph>>add:subMenu:target:selector:argumentList: (in category 'construction') -----
- add: aString subMenu: aMenuMorph target: target selector: aSymbol argumentList: argList
- "Append the given submenu with the given label."
-
- | item |
- item := MenuItemMorph new.
- item
- contents: aString;
- target: target;
- selector: aSymbol;
- arguments: argList asArray;
- subMenu: aMenuMorph.
- self addMorphBack: item.
- ^item!
Item was removed:
- ----- Method: MenuMorph>>add:target:action: (in category 'construction') -----
- add: aString target: aTarget action: aSymbol
- self
- add: aString
- target: aTarget
- selector: aSymbol
- argumentList: Array empty!
Item was removed:
- ----- Method: MenuMorph>>add:target:selector: (in category 'construction') -----
- add: aString target: anObject selector: aSymbol
- "Append a menu item with the given label. If the item is selected, it will send the given selector to the target object."
- self
- add: aString
- target: anObject
- selector: aSymbol
- argumentList: Array empty!
Item was removed:
- ----- Method: MenuMorph>>add:target:selector:argument: (in category 'construction') -----
- add: aString target: target selector: aSymbol argument: arg
- "Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given argument."
-
- self add: aString
- target: target
- selector: aSymbol
- argumentList: (Array with: arg)
- !
Item was removed:
- ----- Method: MenuMorph>>add:target:selector:argumentList: (in category 'construction') -----
- add: aString target: target selector: aSymbol argumentList: argList
- "Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given arguments. If the selector takes one more argument than the number of arguments in the given list, then the triggering event is supplied as as the last argument."
-
- | item |
- item := MenuItemMorph new
- contents: aString;
- target: target;
- selector: aSymbol;
- arguments: argList asArray.
- self addMorphBack: item.
- !
Item was removed:
- ----- Method: MenuMorph>>addAllFrom: (in category 'construction') -----
- addAllFrom: aMenuMorph
- aMenuMorph submorphs
- do: [:each |
- (each isKindOf: MenuItemMorph)
- ifTrue: [self
- add: each contents
- target: each target
- selector: each selector
- argumentList: each arguments].
- (each knownName = #line)
- ifTrue: [self addLine]] !
Item was removed:
- ----- Method: MenuMorph>>addBlankIconsIfNecessary: (in category 'accessing') -----
- addBlankIconsIfNecessary: anIcon
- "If any of my items have an icon, ensure that all do by using
- anIcon for those that don't"
- self items
- reject: [:each | each hasIconOrMarker]
- thenDo: [:each | each icon: anIcon]!
Item was removed:
- ----- Method: MenuMorph>>addCustomMenuItems:hand: (in category 'menu') -----
- addCustomMenuItems: aCustomMenu hand: aHandMorph
-
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- aCustomMenu addLine.
- aCustomMenu add: 'add title...' translated action: #addTitle.
- aCustomMenu add: 'set target...' translated action: #setTarget:.
- defaultTarget ifNotNil: [
- aCustomMenu add: 'add item...' translated action: #addItem].
- aCustomMenu add: 'add line' translated action: #addLine.
- (self items count:[:any| any hasSubMenu]) > 0
- ifTrue:[aCustomMenu add: 'detach submenu' translated action: #detachSubMenu:].!
Item was removed:
- ----- Method: MenuMorph>>addItem (in category 'menu') -----
- addItem
-
- | string sel |
- string := Project uiManager request: 'Label for new item?' translated.
- string isEmpty ifTrue: [^ self].
- sel := Project uiManager request: 'Selector?' translated.
- sel isEmpty ifFalse: [sel := sel asSymbol].
- self add: string action: sel.
- !
Item was removed:
- ----- Method: MenuMorph>>addItem: (in category 'construction') -----
- addItem: aBlock
- | item |
- item := MenuItemMorph new.
- aBlock value: item.
- self addMenuItem: item!
Item was removed:
- ----- Method: MenuMorph>>addLine (in category 'construction') -----
- addLine
- "Append a divider line to this menu. Suppress duplicate lines."
-
- | colorToUse |
- self hasItems ifFalse: [^ self].
- self lastSubmorph knownName = #line ifTrue: [^ self].
-
- colorToUse := self userInterfaceTheme lineColor ifNil: [Color gray: 0.9].
- self addMorphBack: (Morph new
- color: colorToUse;
- hResizing: #spaceFill;
- height: ((self userInterfaceTheme lineWidth ifNil: [2]) * RealEstateAgent scaleFactor) truncated;
- borderStyle: (self userInterfaceTheme lineStyle ifNil: [BorderStyle inset]);
- borderColor: colorToUse;
- borderWidth: "1 *" RealEstateAgent scaleFactor truncated;
- name: #line; "see above"
- yourself).!
Item was removed:
- ----- Method: MenuMorph>>addList: (in category 'construction') -----
- addList: aList
- "Add the given items to this menu, where each item is a pair (<string> <actionSelector>).. If an element of the list is simply the symobl $-, add a line to the receiver. The optional third element of each entry, if present, provides balloon help."
-
- aList do: [:tuple |
- (tuple == #-)
- ifTrue: [self addLine]
- ifFalse:
- [self add: tuple first action: tuple second.
- tuple size > 2 ifTrue:
- [self balloonTextForLastItem: tuple third]]]!
Item was removed:
- ----- Method: MenuMorph>>addMenuItem: (in category 'construction') -----
- addMenuItem: aMenuItemMorph
- self addMorphBack: aMenuItemMorph!
Item was removed:
- ----- Method: MenuMorph>>addService:for: (in category 'construction') -----
- addService: aService for: serviceUser
- "Append a menu item with the given service. If the item is selected, it will perform the given service."
-
- aService addServiceFor: serviceUser toMenu: self.!
Item was removed:
- ----- Method: MenuMorph>>addServices2:for:extraLines: (in category 'construction') -----
- addServices2: services for: served extraLines: linesArray
-
- services withIndexDo: [:service :i |
- service addServiceFor: served toMenu: self.
- self lastItem setBalloonText: service description.
- (linesArray includes: i) ifTrue: [self addLine] ]
- !
Item was removed:
- ----- Method: MenuMorph>>addServices:for:extraLines: (in category 'construction') -----
- addServices: services for: served extraLines: linesArray
-
- services withIndexDo: [:service :i |
- self addService: service for: served.
- submorphs last setBalloonText: service description.
- (linesArray includes: i) | service useLineAfter
- ifTrue: [self addLine]].
- !
Item was removed:
- ----- Method: MenuMorph>>addStayUpIcons (in category 'construction') -----
- addStayUpIcons
- | title closeBox pinBox |
- title := submorphs
- detect: [:ea | ea hasProperty: #titleString]
- ifNone: [
- "Called too soon. Will add stay-up icons when title is added."
- self setProperty: #needsTitlebarWidgets toValue: true.
- ^ self].
- closeBox := SystemWindowButton new target: self;
- actionSelector: #delete;
- color: Color transparent;
- setBalloonText: 'close this menu' translated;
- borderWidth: 0.
- self class closeBoxImage scaleIconToDisplay in: [:icon |
- closeBox labelGraphic: icon; extent: icon extent].
- pinBox := SystemWindowButton new target: self;
- actionSelector: #stayUp:;
- arguments: {true};
- color: Color transparent;
- setBalloonText: 'keep this menu up' translated;
- borderWidth: 0.
- self class pushPinImage scaleIconToDisplay in: [:icon |
- pinBox labelGraphic: icon; extent: icon extent].
-
- title
- addMorphFront: closeBox;
- addMorphBack: pinBox.
-
- self setProperty: #hasTitlebarWidgets toValue: true.
- self removeProperty: #needsTitlebarWidgets.
- self removeStayUpItems!
Item was removed:
- ----- Method: MenuMorph>>addStayUpItem (in category 'construction') -----
- addStayUpItem
- "Append a menu item that can be used to toggle this menu's persistence."
-
- (self valueOfProperty: #hasTitlebarWidgets ifAbsent: [ false ])
- ifTrue: [ ^self ].
- self addStayUpIcons.!
Item was removed:
- ----- Method: MenuMorph>>addStayUpItemSpecial (in category 'construction') -----
- addStayUpItemSpecial
- "Append a menu item that can be used to toggle this menu's persistent."
-
- "This variant is resistant to the MVC compatibility in #setInvokingView:"
-
- (self valueOfProperty: #hasTitlebarWidgets ifAbsent: [ false ])
- ifTrue: [ ^self ].
- self addStayUpIcons.!
Item was removed:
- ----- Method: MenuMorph>>addTitle (in category 'menu') -----
- addTitle
-
- | string |
- string := Project uiManager request: 'Title for this menu?' translated.
- string isEmpty ifTrue: [^ self].
- self addTitle: string.
- !
Item was removed:
- ----- Method: MenuMorph>>addTitle: (in category 'construction') -----
- addTitle: aString
- "Add a title line at the top of this menu."
-
- self addTitle: aString updatingSelector: nil updateTarget: nil!
Item was removed:
- ----- Method: MenuMorph>>addTitle:icon: (in category 'construction') -----
- addTitle: aString icon: aForm
- "Add a title line at the top of this menu."
- self
- addTitle: aString
- icon: aForm
- updatingSelector: nil
- updateTarget: nil !
Item was removed:
- ----- Method: MenuMorph>>addTitle:icon:updatingSelector:updateTarget: (in category 'construction') -----
- addTitle: aString icon: aForm updatingSelector: aSelector updateTarget: aTarget
- "Add a title line at the top of this menu Make aString its initial contents. If aSelector is not nil, then periodically obtain fresh values for its contents by sending aSelector to aTarget."
-
- | container fontToUse colorToUse labelArea |
-
- container := AlignmentMorph newRow.
- self setTitleParametersFor: container.
-
- aForm ifNotNil: [:form | container addMorphBack: form asMorph].
-
- fontToUse := self userInterfaceTheme titleFont ifNil: [TextStyle defaultFont].
- colorToUse := self userInterfaceTheme titleTextColor ifNil: [Color black].
-
- "Build the label."
- aSelector
- ifNil: [
- labelArea := AlignmentMorph newColumn
- color: Color transparent;
- vResizing: #shrinkWrap;
- wrapCentering: #center;
- cellPositioning: #topCenter.
- aString asString linesDo: [:line | labelArea
- addMorphBack: ((StringMorph contents: line
- font: fontToUse)
- color: colorToUse;
- yourself)]]
- ifNotNil: [
- labelArea := UpdatingStringMorph on: aTarget selector: aSelector.
- labelArea font: fontToUse.
- labelArea color: colorToUse.
- labelArea useStringFormat.
- labelArea lock].
-
- container addMorphBack: labelArea.
- ""
- container setProperty: #titleString toValue: aString.
- self addMorphFront: container.
- ""
- (self hasProperty: #needsTitlebarWidgets)
- ifTrue: [self addStayUpIcons]!
Item was removed:
- ----- Method: MenuMorph>>addTitle:updatingSelector:updateTarget: (in category 'construction') -----
- addTitle: aString updatingSelector: aSelector updateTarget: aTarget
- "Add a title line at the top of this menu Make aString its initial
- contents.
- If aSelector is not nil, then periodically obtain fresh values for
- its contents by sending aSelector to aTarget.."
- ^ self
- addTitle: aString
- icon: nil
- updatingSelector: aSelector
- updateTarget: aTarget!
Item was removed:
- ----- Method: MenuMorph>>addTranslatedList: (in category 'construction') -----
- addTranslatedList: aList
- "Add the given items to this menu, where each item is a pair (<string> <actionSelector>).. If an element of the list is simply the symobl $-, add a line to the receiver. The optional third element of each entry, if present, provides balloon help.
- The first and third items will be translated."
-
- aList do: [:tuple |
- (tuple == #-)
- ifTrue: [self addLine]
- ifFalse:
- [self add: tuple first translated action: tuple second.
- tuple size > 2 ifTrue:
- [self balloonTextForLastItem: tuple third translated ]]]!
Item was removed:
- ----- Method: MenuMorph>>addUpdating:action: (in category 'construction') -----
- addUpdating: aWordingSelector action: aSymbol
- self
- addUpdating: aWordingSelector
- target: defaultTarget
- selector: aSymbol
- argumentList: Array empty!
Item was removed:
- ----- Method: MenuMorph>>addUpdating:enablement:action: (in category 'construction') -----
- addUpdating: aWordingSelector enablement: anEnablementSelector action: aSymbol
- self
- addUpdating: aWordingSelector
- enablementSelector: anEnablementSelector
- target: defaultTarget
- selector: aSymbol
- argumentList: Array empty!
Item was removed:
- ----- Method: MenuMorph>>addUpdating:enablementSelector:target:selector:argumentList: (in category 'construction') -----
- addUpdating: wordingSelector enablementSelector: enablementSelector target: target selector: aSymbol argumentList: argList
- "Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given arguments. If the selector takes one more argument than the number of arguments in the given list, then the triggering event is supplied as as the last argument. In this variant, the wording of the menu item is obtained by sending the wordingSelector to the target, and the optional enablementSelector determines whether or not the item should be enabled. Answer the item itself."
-
- | item |
- item := UpdatingMenuItemMorph new
- target: target;
- selector: aSymbol;
- wordingProvider: target wordingSelector: wordingSelector;
- enablementSelector: enablementSelector;
- arguments: argList asArray.
- self addMorphBack: item.
- ^ item
- !
Item was removed:
- ----- Method: MenuMorph>>addUpdating:target:action: (in category 'construction') -----
- addUpdating: aWordingSelector target: aTarget action: aSymbol
- self
- addUpdating: aWordingSelector
- target: aTarget
- selector: aSymbol
- argumentList: Array empty!
Item was removed:
- ----- Method: MenuMorph>>addUpdating:target:selector:argumentList: (in category 'construction') -----
- addUpdating: wordingSelector target: target selector: aSymbol argumentList: argList
- "Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given arguments. If the selector takes one more argument than the number of arguments in the given list, then the triggering event is supplied as as the last argument. In this variant, the wording of the menu item is obtained by sending the wordingSelector to the target, Answer the item added."
-
- | item |
- item := UpdatingMenuItemMorph new
- target: target;
- selector: aSymbol;
- wordingProvider: target wordingSelector: wordingSelector;
- arguments: argList asArray.
- self addMorphBack: item.
- ^ item
- !
Item was removed:
- ----- Method: MenuMorph>>addUpdatingItem: (in category 'construction') -----
- addUpdatingItem: aBlock
- | item |
- item := UpdatingMenuItemMorph new.
- aBlock value: item.
- self addMenuItem: item!
Item was removed:
- ----- Method: MenuMorph>>addWithLabel:enablement:action: (in category 'construction') -----
- addWithLabel: aLabel enablement: anEnablementSelector action: aSymbol
- self
- addWithLabel: aLabel
- enablementSelector: anEnablementSelector
- target: defaultTarget
- selector: aSymbol
- argumentList: Array empty!
Item was removed:
- ----- Method: MenuMorph>>addWithLabel:enablementSelector:target:selector:argumentList: (in category 'construction') -----
- addWithLabel: aLabel enablementSelector: enablementSelector target: target selector: aSymbol argumentList: argList
- "Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given arguments. If the selector takes one more argument than the number of arguments in the given list, then the triggering event is supplied as as the last argument. In this variant, the wording of the menu item is constant, and the optional enablementSelector determines whether or not the item should be enabled."
-
- | item |
- item := UpdatingMenuItemMorph new
- target: target;
- selector: aSymbol;
- contents: aLabel;
- wordingProvider: target wordingSelector: nil;
- enablementSelector: enablementSelector;
- arguments: argList asArray.
- self addMorphBack: item.
- !
Item was removed:
- ----- Method: MenuMorph>>applyUserInterfaceTheme (in category 'update') -----
- applyUserInterfaceTheme
-
- | colorToUse |
- super applyUserInterfaceTheme.
-
- self setDefaultParameters.
-
- "Update properties of separating lines."
- colorToUse := self userInterfaceTheme lineColor ifNil: [Color gray: 0.9].
- self submorphs
- select: [:ea | ea knownName = #line]
- thenDo: [:line |
- line
- color: colorToUse;
- height: (self userInterfaceTheme lineWidth ifNil: [2]);
- borderStyle: (self userInterfaceTheme lineStyle ifNil: [BorderStyle inset]) copy;
- borderColor: colorToUse].!
Item was removed:
- ----- Method: MenuMorph>>balloonTextForLastItem: (in category 'construction') -----
- balloonTextForLastItem: balloonText
- submorphs last balloonText: balloonText!
Item was removed:
- ----- Method: MenuMorph>>commandKeyHandler (in category 'accessing') -----
- commandKeyHandler
- "Answer the receiver's commandKeyHandler"
-
- ^ self valueOfProperty: #commandKeyHandler ifAbsent: [nil]!
Item was removed:
- ----- Method: MenuMorph>>commandKeyHandler: (in category 'accessing') -----
- commandKeyHandler: anObject
- "Set the receiver's commandKeyHandler. Whatever you set here needs to be prepared to respond to the message #commandKeyTypedIntoMenu: "
-
- self setProperty: #commandKeyHandler toValue: anObject!
Item was removed:
- ----- Method: MenuMorph>>deactivate: (in category 'events') -----
- deactivate: evt
-
- "If a stand-alone menu, just delete it"
- popUpOwner ifNil: [
- self deleteIfPopUp: evt.
- ^true ].
- "If a sub-menu, then deselect, and return focus to outer menu"
- self selectItem: nil event: evt.
- evt hand newMouseFocus: popUpOwner owner.
- evt hand newKeyboardFocus: popUpOwner owner!
Item was removed:
- ----- Method: MenuMorph>>defaultTarget (in category 'accessing') -----
- defaultTarget
- ^defaultTarget!
Item was removed:
- ----- Method: MenuMorph>>defaultTarget: (in category 'construction') -----
- defaultTarget: anObject
- "Set the default target for adding menu items."
-
- defaultTarget := anObject.
- !
Item was removed:
- ----- Method: MenuMorph>>delete (in category 'initialization') -----
- delete
- "Delete the receiver."
-
- self hideKeyboardHelp.
- activeSubMenu ifNotNil: [activeSubMenu stayUp ifFalse: [activeSubMenu delete]].
- self isFlexed ifTrue: [^ owner delete].
- ^ super delete!
Item was removed:
- ----- Method: MenuMorph>>deleteIfPopUp (in category 'control') -----
- deleteIfPopUp
- "Remove this menu from the screen if stayUp is not true. If it is a submenu, also remove its owning menu."
-
- stayUp ifFalse: [self topRendererOrSelf delete].
- (popUpOwner notNil and: [popUpOwner isKindOf: MenuItemMorph]) ifTrue: [
- popUpOwner isSelected: false.
- (popUpOwner owner isKindOf: MenuMorph)
- ifTrue: [popUpOwner owner deleteIfPopUp]].
- self hideKeyboardHelp.
- !
Item was removed:
- ----- Method: MenuMorph>>deleteIfPopUp: (in category 'control') -----
- deleteIfPopUp: evt
- "Remove this menu from the screen if stayUp is not true. If it is a submenu, also remove its owning menu."
-
- stayUp ifFalse: [self topRendererOrSelf delete].
- (popUpOwner notNil) ifTrue: [
- popUpOwner isSelected: false.
- popUpOwner deleteIfPopUp: evt].
- evt ifNotNil: [
- evt hand releaseMouseFocus: self.
- originalFocusHolder ifNotNil: [
- self hideKeyboardHelp.
- evt hand newKeyboardFocus: originalFocusHolder.
- originalFocusHolder := nil]].!
Item was removed:
- ----- Method: MenuMorph>>detachSubMenu: (in category 'menu') -----
- detachSubMenu: evt
- | possibleTargets item subMenu index |
- possibleTargets := self items select:[:any| any hasSubMenu].
- possibleTargets size > 0 ifTrue:[
- index := Project uiManager
- chooseFrom: (possibleTargets collect:[:t| t contents asString])
- title: 'Which menu?' translated.
- index = 0 ifTrue:[^self]].
- item := possibleTargets at: index.
- subMenu := item subMenu.
- subMenu ifNotNil: [
- item subMenu: nil.
- item delete.
- subMenu stayUp: true.
- subMenu popUpOwner: nil.
- subMenu addTitle: item contents.
- evt hand attachMorph: subMenu].
- !
Item was removed:
- ----- Method: MenuMorph>>displayFiltered: (in category 'keyboard control') -----
- displayFiltered: evt
- | matchStr allItems matches feedbackMorph |
- matchStr := self matchString.
- allItems := self submorphs select: [:m | m isKindOf: MenuItemMorph].
- matches := allItems select: [:m | | isMatch |
- isMatch :=
- matchStr isNil or: [
- m contents includesSubstring: matchStr caseSensitive: false].
- m isEnabled: isMatch.
- isMatch].
- feedbackMorph := self valueOfProperty: #feedbackMorph.
- feedbackMorph ifNil: [
- feedbackMorph := TextMorph new
- color: Color darkGray;
- yourself.
- self
- addLine;
- addMorphBack: feedbackMorph lock.
- self setProperty: #feedbackMorph toValue: feedbackMorph.
- self fullBounds. "Lay out for submorph adjacency"].
- feedbackMorph contents: '<', matchStr, '>'.
- matchStr ifNil: [
- feedbackMorph delete.
- self submorphs last delete.
- self removeProperty: #feedbackMorph].
- " This method is invoked with evt = nil from MenuMorph >> removeMatchString.
- The current implementation can't select an item without an event. "
- (evt notNil and: [ matches size >= 1 ]) ifTrue: [
- self selectItem: matches first event: evt]!
Item was removed:
- ----- Method: MenuMorph>>doButtonAction (in category 'menu') -----
- doButtonAction
- "Do the receiver's inherent button action. Makes sense for the kind of MenuMorph that is a wrapper for a single menu-item -- pass it on the the item"
-
- (self findA: MenuItemMorph) ifNotNil: [:aMenuItem | aMenuItem doButtonAction]!
Item was removed:
- ----- Method: MenuMorph>>handleCRStroke: (in category 'keystroke helpers') -----
- handleCRStroke: evt
-
- | selectable |
- evt keyValue = 13 ifFalse: [ ^false ].
- selectedItem ifNotNil: [
- selectedItem hasSubMenu
- ifTrue: [
- evt hand
- newMouseFocus: selectedItem subMenu;
- newKeyboardFocus: selectedItem subMenu ]
- ifFalse: [
- selectedItem invokeWithEvent: evt ].
- ^true ].
- (selectable := self items) size = 1 ifTrue: [
- selectable first invokeWithEvent: evt ].
- ^true!
Item was removed:
- ----- Method: MenuMorph>>handleCommandKeyPress: (in category 'keystroke helpers') -----
- handleCommandKeyPress: evt
-
- (evt commandKeyPressed and: [
- self commandKeyHandler notNil ]) ifTrue: [
- self commandKeyHandler commandKeyTypedIntoMenu: evt.
- self deleteIfPopUp: evt.
- ^true ].
- ^false!
Item was removed:
- ----- Method: MenuMorph>>handleDelStroke: (in category 'keystroke helpers') -----
- handleDelStroke: evt
-
- evt keyCharacter = Character delete ifFalse: [^ false].
- self matchString ifNotNil: [
- self removeMatchString].
- ^ true!
Item was removed:
- ----- Method: MenuMorph>>handleDownStroke: (in category 'keystroke helpers') -----
- handleDownStroke: evt
-
- evt keyValue = 31 ifFalse: [ ^false ].
- self moveSelectionDown: 1 event: evt.
- ^true!
Item was removed:
- ----- Method: MenuMorph>>handleEscStroke: (in category 'keystroke helpers') -----
- handleEscStroke: evt
-
- evt keyValue = 27 ifFalse: [ ^false ].
- self matchString ifNotNil: [
- self removeMatchString.
- ^true].
- self deactivate: evt.
- ^true!
Item was removed:
- ----- Method: MenuMorph>>handleFiltering: (in category 'keystroke helpers') -----
- handleFiltering: evt
-
- | matchString |
- matchString := self matchString.
- matchString := true
- caseOf: {
- [ evt keyCharacter = Character backspace ] ->
- [matchString ifNotNil: [ matchString allButLast ] ].
- [ evt keyValue >= 32 ] ->
- [ (matchString ifNil: ['']) , evt keyCharacter ] }
- otherwise: [ matchString ].
- self matchString: matchString event: evt.!
Item was removed:
- ----- Method: MenuMorph>>handleLeftStroke: (in category 'keystroke helpers') -----
- handleLeftStroke: evt
-
- 28 = evt keyValue ifFalse: [ ^false ].
- self stepIntoSubmenu: evt.
- ^true!
Item was removed:
- ----- Method: MenuMorph>>handlePageDownStroke: (in category 'keystroke helpers') -----
- handlePageDownStroke: evt
-
- evt keyValue = 12 ifFalse: [ ^false ].
- self moveSelectionDown: 5 event: evt.
- ^true!
Item was removed:
- ----- Method: MenuMorph>>handlePageUpStroke: (in category 'keystroke helpers') -----
- handlePageUpStroke: evt
-
- evt keyValue = 11 ifFalse: [ ^false ].
- self moveSelectionDown: -5 event: evt.
- ^true!
Item was removed:
- ----- Method: MenuMorph>>handleRightStroke: (in category 'keystroke helpers') -----
- handleRightStroke: evt
-
- 29 = evt keyValue ifFalse: [ ^false ].
- self stepIntoSubmenu: evt.
- ^true!
Item was removed:
- ----- Method: MenuMorph>>handleUpStroke: (in category 'keystroke helpers') -----
- handleUpStroke: evt
-
- evt keyValue = 30 ifFalse: [ ^false ].
- self moveSelectionDown: -1 event: evt.
- ^true!
Item was removed:
- ----- Method: MenuMorph>>handlesKeyboard: (in category 'keyboard control') -----
- handlesKeyboard: evt
- "Answer whether the receiver handles the keystroke represented by the event"
-
- ^ evt anyModifierKeyPressed not or: [evt commandKeyPressed and: [self commandKeyHandler notNil]]!
Item was removed:
- ----- Method: MenuMorph>>handlesMouseDown: (in category 'events') -----
- handlesMouseDown: evt
- ^true!
Item was removed:
- ----- Method: MenuMorph>>handlesMouseOver: (in category 'events') -----
- handlesMouseOver: evt
- ^ true!
Item was removed:
- ----- Method: MenuMorph>>hasItems (in category 'accessing') -----
- hasItems
- "Answer if the receiver has menu items"
- ^ submorphs
- anySatisfy: [:each | each isKindOf: MenuItemMorph] !
Item was removed:
- ----- Method: MenuMorph>>hasSubMenu: (in category 'accessing') -----
- hasSubMenu: aMenuMorph
- self items do: [:each | (each hasSubMenu: aMenuMorph) ifTrue:[^true]].
- ^ false
- !
Item was removed:
- ----- Method: MenuMorph>>hideKeyboardHelp (in category 'keystroke helpers') -----
- hideKeyboardHelp
- self deleteBalloon!
Item was removed:
- ----- Method: MenuMorph>>indicateKeyboardFocus (in category 'testing') -----
- indicateKeyboardFocus
-
- ^ self rootMenu hasProperty: #hasUsedKeyboard!
Item was removed:
- ----- Method: MenuMorph>>informUserAt:during: (in category 'modal control') -----
- informUserAt: aPoint during: aBlock
- "Add this menu to the Morphic world during the execution of the given block."
-
- | title world |
- title := self allMorphs detect: [ :ea | ea hasProperty: #titleString ].
- title := title submorphs first.
- self visible: false.
- world := self currentWorld.
- aBlock value: [:string|
- self visible ifFalse:[
- world addMorph: self centeredNear: aPoint.
- self visible: true].
- title contents: string.
- self setConstrainedPosition: self currentHand cursorPoint hangOut: false.
- self changed.
- world displayWorld "show myself"].
- self delete.
- world displayWorld.!
Item was removed:
- ----- Method: MenuMorph>>initialize (in category 'initialization') -----
- initialize
- super initialize.
-
- self setDefaultParameters.
-
- self changeTableLayout.
- self listDirection: #topToBottom.
- self hResizing: #shrinkWrap.
- self vResizing: #shrinkWrap.
- self rubberBandCells: true.
- self disableLayout: true.
- self morphicLayerNumber: self class menuLayer.
- defaultTarget := nil.
- selectedItem := nil.
- stayUp := false.
- popUpOwner := nil.!
Item was removed:
- ----- Method: MenuMorph>>invokeAt:in:allowKeyboard: (in category 'modal control') -----
- invokeAt: aPoint in: aWorld allowKeyboard: aBoolean
- "Add this menu to the given world centered at the given point. Wait for the user to make a selection and answer it. The selection value returned is an integer in keeping with PopUpMenu, if the menu is converted from an MVC-style menu."
- "Details: This is invoked synchronously from the caller. In order to keep processing inputs and updating the screen while waiting for the user to respond, this method has its own version of the World's event loop."
- | w originalFocusHolder |
- originalFocusHolder := aWorld primaryHand keyboardFocus.
- self popUpAt: aPoint forHand: aWorld primaryHand in: aWorld allowKeyboard: aBoolean.
- w := aWorld outermostWorldMorph. "containing hand"
- [self isInWorld] whileTrue: [w doOneSubCycle].
- self delete.
- originalFocusHolder ifNotNil: [aWorld primaryHand newKeyboardFocus: originalFocusHolder].
- !
Item was removed:
- ----- Method: MenuMorph>>invokeMetaMenu: (in category 'private') -----
- invokeMetaMenu: evt
- stayUp ifFalse:[^self]. "Don't allow this"
- ^super invokeMetaMenu: evt!
Item was removed:
- ----- Method: MenuMorph>>invokeModal (in category 'modal control') -----
- invokeModal
- "Invoke this menu and don't return until the user has chosen a value.
- See example below on how to use modal menu morphs."
- ^ self invokeModal: Preferences menuKeyboardControl
-
- "Example:
- | menu sub entry |
- menu := MenuMorph new.
- 1 to: 3 do: [:i |
- entry := 'Line', i printString.
- sub := MenuMorph new.
- menu add: entry subMenu: sub.
- #('Item A' 'Item B' 'Item C') do:[:subEntry|
- sub add: subEntry target: menu
- selector: #modalSelection: argument: {entry. subEntry}]].
- menu invokeModal.
- "
-
- !
Item was removed:
- ----- Method: MenuMorph>>invokeModal: (in category 'modal control') -----
- invokeModal: allowKeyboardControl
- "Invoke this menu and don't return until the user has chosen a value. If the allowKeyboarControl boolean is true, permit keyboard control of the menu"
-
- ^ self
- invokeModalAt: self currentHand position
- in: self currentWorld
- allowKeyboard: allowKeyboardControl!
Item was removed:
- ----- Method: MenuMorph>>invokeModalAt:in: (in category 'modal control') -----
- invokeModalAt: aPoint in: aWorld
- "Add this menu to the given world centered at the given point. Wait for the user to make a selection and answer it. The selection value returned is an integer in keeping with PopUpMenu, if the menu is converted from an MVC-style menu."
- "Details: This is invoked synchronously from the caller. In order to keep processing inputs and updating the screen while waiting for the user to respond, this method has its own version of the World's event loop."
-
- ^ self invokeModalAt: aPoint in: aWorld allowKeyboard: Preferences menuKeyboardControl!
Item was removed:
- ----- Method: MenuMorph>>invokeModalAt:in:allowKeyboard: (in category 'modal control') -----
- invokeModalAt: aPoint in: aWorld allowKeyboard: aBoolean
- "Invoke this menu and don't return until the user has chosen a value.
- See senders of this method for finding out how to use modal menu morphs."
- | w originalFocusHolder |
- originalFocusHolder := aWorld primaryHand keyboardFocus.
- self popUpAt: aPoint forHand: aWorld primaryHand in: aWorld allowKeyboard: aBoolean.
- self isModalInvokationDone: false.
- w := aWorld outermostWorldMorph. "containing hand"
- [self isInWorld & self isModalInvokationDone not] whileTrue: [w doOneSubCycle].
- self delete.
- originalFocusHolder ifNotNil: [aWorld primaryHand newKeyboardFocus: originalFocusHolder].
- ^ self modalSelection!
Item was removed:
- ----- Method: MenuMorph>>isModalInvokationDone (in category 'modal control') -----
- isModalInvokationDone
- ^self valueOfProperty: #isModalInvokationDone ifAbsent:[false]!
Item was removed:
- ----- Method: MenuMorph>>isModalInvokationDone: (in category 'modal control') -----
- isModalInvokationDone: aBool
- self setProperty: #isModalInvokationDone toValue: aBool
- !
Item was removed:
- ----- Method: MenuMorph>>itemWithWording: (in category 'accessing') -----
- itemWithWording: wording
- "If any of the receiver's items or submenu items have the given wording (case-blind comparison done), then return it, else return nil."
-
- self items do:[:anItem | | found |
- found := anItem itemWithWording: wording.
- found ifNotNil:[^found]].
- ^ nil!
Item was removed:
- ----- Method: MenuMorph>>items (in category 'accessing') -----
- items
-
- ^ submorphs select: [:m | m isKindOf: MenuItemMorph]
- !
Item was removed:
- ----- Method: MenuMorph>>justDroppedInto:event: (in category 'dropping/grabbing') -----
- justDroppedInto: aMorph event: evt
- | halo |
- super justDroppedInto: aMorph event: evt.
- halo := evt hand halo.
- (halo notNil and:[halo target hasOwner: self]) ifTrue:[
- "Grabbed single menu item"
- self addHalo: evt.
- ].
- stayUp ifFalse:[evt hand newMouseFocus: self].
- self hasDropShadow: Preferences menuAppearance3d.!
Item was removed:
- ----- Method: MenuMorph>>keyStroke: (in category 'keyboard control') -----
- keyStroke: evt
- self hideKeyboardHelp; noteRootMenuHasUsedKeyboard.
- self keyStrokeHandlers
- detect: [:each | self perform: each with: evt]
- ifNone: [self handleFiltering: evt]!
Item was removed:
- ----- Method: MenuMorph>>keyStrokeHandlers (in category 'keystroke helpers') -----
- keyStrokeHandlers
-
- ^#(
- handleCommandKeyPress:
- handleCRStroke:
- handleDelStroke:
- handleEscStroke:
- handleLeftStroke:
- handleRightStroke:
- handleUpStroke:
- handleDownStroke:
- handlePageUpStroke:
- handlePageDownStroke:)!
Item was removed:
- ----- Method: MenuMorph>>labels:lines:selections: (in category 'construction') -----
- labels: labelList lines: linesArray selections: selectionsArray
- "This method allows the receiver to accept old-style SelectionMenu creation messages. It should be used only for backward compatibility during the MVC-to-Morphic transition. New code should be written using the other menu construction protocol such as addList:."
-
- "Labels can be either a sting with embedded crs, or a collection of strings."
-
- | labelArray |
- labelArray := (labelList isString)
- ifTrue: [labelList lines]
- ifFalse: [labelList].
- 1 to: labelArray size
- do:
- [:i |
- self add: (labelArray at: i) action: (selectionsArray at: i).
- (linesArray includes: i) ifTrue: [self addLine]]!
Item was removed:
- ----- Method: MenuMorph>>lastItem (in category 'accessing') -----
- lastItem
-
- submorphs reverseDo: [ :each |
- (each isKindOf: MenuItemMorph) ifTrue: [ ^each ] ].
- ^submorphs last!
Item was removed:
- ----- Method: MenuMorph>>lastSelection (in category 'accessing') -----
- lastSelection
- "Return the label of the last selected item or nil."
-
- ^selectedItem ifNotNil: [selectedItem selector]!
Item was removed:
- ----- Method: MenuMorph>>matchString (in category 'accessing') -----
- matchString
- "Answer the current match string for filtering the menu, or nil if no filter is active. The matchString will never be an empty string."
-
- ^ self valueOfProperty: #matchString!
Item was removed:
- ----- Method: MenuMorph>>matchString: (in category 'accessing') -----
- matchString: aString
-
- ^ self matchString: aString event: nil!
Item was removed:
- ----- Method: MenuMorph>>matchString:event: (in category 'keyboard control') -----
- matchString: aString event: anEvent
- "Set the current match string and display the filtered the menu items."
-
- aString ifNotNil: [aString ifEmpty: [^ self matchString: nil event: anEvent]].
-
- self setProperty: #matchString toValue: aString.
- self displayFiltered: anEvent.!
Item was removed:
- ----- Method: MenuMorph>>modalSelection (in category 'modal control') -----
- modalSelection
- ^self valueOfProperty: #modalSelection ifAbsent:[nil]!
Item was removed:
- ----- Method: MenuMorph>>modalSelection: (in category 'modal control') -----
- modalSelection: anObject
- self setProperty: #modalSelection toValue: anObject.
- self isModalInvokationDone: true!
Item was removed:
- ----- Method: MenuMorph>>mouseDown: (in category 'events') -----
- mouseDown: evt
- "Handle a mouse down event."
- (stayUp or:[self fullContainsPoint: evt position])
- ifFalse:[^self deleteIfPopUp: evt]. "click outside"
- self isSticky ifTrue: [^self].
-
- "Grab the menu and drag it to some other place"
- self hasDropShadow: false.
- evt hand grabMorph: self.!
Item was removed:
- ----- Method: MenuMorph>>mouseLeave: (in category 'events') -----
- mouseLeave: evt
- self selectItem: nil event: evt.!
Item was removed:
- ----- Method: MenuMorph>>mouseMove: (in category 'events') -----
- mouseMove: evt
- " If the mouse moves over an item not selected, we try to set it as selected.
- If this happens depends on that the current selected item wants to release
- its selection. "
-
- self selectedItem ifNil: [
- self
- selectItem: (
- self items
- detect: [ :each | each containsPoint: evt position ]
- ifNone: [ nil ])
- event: evt].
-
- "Transfer control to *either* the currently active submenu or the pop up owner, if any. Since the active sub menu is always displayed upfront check it first."
- self selectedItem ifNotNil: [
- (self selectedItem activateSubmenu: evt)
- ifTrue: [ ^self ]
- ifFalse: [
- (self containsPoint: evt position) ifFalse: [
- self selectItem: nil event: evt ] ] ].
-
- "Note: The following does not traverse upwards but it's the best I can do for now"
- popUpOwner ifNotNil:[(popUpOwner activateOwnerMenu: evt) ifTrue: [^ self]].
- !
Item was removed:
- ----- Method: MenuMorph>>mouseUp: (in category 'events') -----
- mouseUp: evt
- "Handle a mouse up event.
- Note: This might be sent from a modal shell."
- (self fullContainsPoint: evt position) ifFalse:[
- ^ self deleteIfPopUp: evt].
- stayUp ifFalse:[
- "Still in pop-up transition; keep focus"
- evt hand newMouseFocus: self].!
Item was removed:
- ----- Method: MenuMorph>>moveSelectionDown:event: (in category 'keyboard control') -----
- moveSelectionDown: direction event: evt
- "Move the current selection up or down by one, presumably under keyboard control.
- direction = +/-1"
-
- | index |
- index := (submorphs
- indexOf: selectedItem
- ifAbsent: [direction positive ifTrue: [0] ifFalse: [1]]
- ) + direction.
- submorphs do: "Ensure finite"
- [:unused | | m |
- m := submorphs atWrap: index.
- ((m isKindOf: MenuItemMorph) and: [m isEnabled]) ifTrue:
- [^ self selectItem: m event: evt].
- "Keep looking for an enabled item"
- index := index + direction sign].
- ^ self selectItem: nil event: evt!
Item was removed:
- ----- Method: MenuMorph>>noteRootMenuHasUsedKeyboard (in category 'keystroke helpers') -----
- noteRootMenuHasUsedKeyboard
-
- (self rootMenu hasProperty: #hasUsedKeyboard) ifFalse: [
- self setProperty: #hasUsedKeyboard toValue: true.
- self changed ].!
Item was removed:
- ----- Method: MenuMorph>>popUpAdjacentTo:forHand:from: (in category 'control') -----
- popUpAdjacentTo: rightOrLeftPoint forHand: hand from: sourceItem
- "Present this menu at the given point under control of the given hand."
-
- | tryToPlace selectedOffset rightPoint leftPoint |
- hand world startSteppingSubmorphsOf: self.
- popUpOwner := sourceItem.
-
- self fullBounds.
- self updateColor.
-
- "ensure layout is current"
- selectedOffset := (selectedItem
- ifNil: [self items first]) position - self position.
- tryToPlace := [:where :mustFit | | delta |
- self position: where - selectedOffset.
- delta := self innerBounds amountToTranslateWithin: sourceItem world visibleClearArea.
- (delta x = 0
- or: [mustFit])
- ifTrue: [delta = (0 @ 0)
- ifFalse: [self position: self position + delta].
- sourceItem world addMorphFront: self.
- ^ self]].
- rightPoint := rightOrLeftPoint first + ((self layoutInset + self borderWidth) @ 0).
- leftPoint := rightOrLeftPoint last + ((self layoutInset + self borderWidth - self width) @ 0).
- tryToPlace
- value: rightPoint value: false;
- value: leftPoint value: false;
- value: rightPoint value: true.!
Item was removed:
- ----- Method: MenuMorph>>popUpAt:forHand:in: (in category 'control') -----
- popUpAt: aPoint forHand: hand in: aWorld
- "Present this menu at the given point under control of the given hand. Allow keyboard input into the menu."
-
- ^ self popUpAt: aPoint forHand: hand in: aWorld allowKeyboard: Preferences menuKeyboardControl!
Item was removed:
- ----- Method: MenuMorph>>popUpAt:forHand:in:allowKeyboard: (in category 'control') -----
- popUpAt: aPoint forHand: hand in: aWorld allowKeyboard: aBoolean
- "Present this menu at the given point under control of the given
- hand."
- | evt |
- aWorld submorphs
- select: [:each | (each isKindOf: MenuMorph)
- and: [each stayUp not]]
- thenCollect: [:menu | menu delete].
- self items isEmpty
- ifTrue: [^ self].
- MenuIcons decorateMenu: self.
- (self submorphs
- select: [:m | m isKindOf: UpdatingMenuItemMorph])
- do: [:m | m updateContents].
- "precompute width"
- self
- positionAt: aPoint
- relativeTo: (selectedItem
- ifNil: [self items first])
- inWorld: aWorld.
- aWorld addMorphFront: self.
- "Acquire focus for valid pop up behavior"
- hand
- newMouseFocus: self;
- showTemporaryCursor: nil.
- aBoolean
- ifTrue: [
- originalFocusHolder := hand keyboardFocus.
- hand newKeyboardFocus: self.
- self showKeyboardHelp].
- evt := hand lastEvent.
- (evt isKeyboard
- or: [evt isMouse
- and: [evt anyButtonPressed not]])
- ifTrue: ["Select first item if button not down"
- self moveSelectionDown: 1 event: evt
- "Select first item if button not down"].
- self updateColor.
- self changed!
Item was removed:
- ----- Method: MenuMorph>>popUpEvent:in: (in category 'control') -----
- popUpEvent: evt in: aWorld
- "Present this menu in response to the given event."
-
- | aHand aPosition |
- aHand := evt ifNotNil: [evt hand] ifNil: [self currentHand].
- aPosition := aHand position truncated.
- ^ self popUpAt: aPosition forHand: aHand in: aWorld!
Item was removed:
- ----- Method: MenuMorph>>popUpForHand:in: (in category 'control') -----
- popUpForHand: hand in: aWorld
- | p |
- "Present this menu under control of the given hand."
-
- p := hand position truncated.
- ^self popUpAt: p forHand: hand in: aWorld
- !
Item was removed:
- ----- Method: MenuMorph>>popUpInWorld (in category 'control') -----
- popUpInWorld
- "Present this menu in the current World"
-
- ^ self popUpInWorld: self currentWorld!
Item was removed:
- ----- Method: MenuMorph>>popUpInWorld: (in category 'control') -----
- popUpInWorld: aWorld
- "Present this menu under control of the given hand."
- ^self popUpAt: aWorld primaryHand position forHand: aWorld primaryHand in: aWorld
- !
Item was removed:
- ----- Method: MenuMorph>>popUpNoKeyboard (in category 'control') -----
- popUpNoKeyboard
- "Present this menu in the current World, *not* allowing keyboard input into the menu"
-
- ^ self
- popUpAt: self currentHand position
- forHand: self currentHand
- in: self currentWorld
- allowKeyboard: false!
Item was removed:
- ----- Method: MenuMorph>>popUpOwner (in category 'accessing') -----
- popUpOwner
- "Return the current pop-up owner that is the menu item that automatically initiated the receiver."
- ^ popUpOwner
- !
Item was removed:
- ----- Method: MenuMorph>>popUpOwner: (in category 'accessing') -----
- popUpOwner: aMenuItemMorph
- "Set the current pop-up owner"
- popUpOwner := aMenuItemMorph.
- !
Item was removed:
- ----- Method: MenuMorph>>positionAt:relativeTo:inWorld: (in category 'private') -----
- positionAt: aPoint relativeTo: aMenuItem inWorld: aWorld
- "Note: items may not be laid out yet (I found them all to be at 0 at 0),
- so we have to add up heights of items above the selected item."
-
- | i yOffset sub delta |
- self fullBounds. "force layout"
- i := 0.
- yOffset := 0.
- [(sub := self submorphs at: (i := i + 1)) == aMenuItem]
- whileFalse: [yOffset := yOffset + sub height].
-
- self position: aPoint - (2 @ (yOffset + 8)).
-
- "If it doesn't fit, show it to the left, not to the right of the hand."
- self right > aWorld worldBounds right
- ifTrue:
- [self right: aPoint x + 1].
-
- "Make sure that the menu fits in the world."
- delta := self bounds amountToTranslateWithin:
- (aWorld worldBounds withHeight: ((aWorld worldBounds height - 18) max: (self currentHand position y) + 1)).
- delta isZero ifFalse: [self position: self position + delta].!
Item was removed:
- ----- Method: MenuMorph>>processFocusEvent:using: (in category 'events') -----
- processFocusEvent: evt using: dispatcher
-
- ^ dispatcher dispatchFocusEventFully: evt with: self!
Item was removed:
- ----- Method: MenuMorph>>removeMatchString (in category 'keyboard control') -----
- removeMatchString
-
- ^ self removeMatchString: self currentEvent!
Item was removed:
- ----- Method: MenuMorph>>removeMatchString: (in category 'keyboard control') -----
- removeMatchString: anEvent
- "Remove the matchString, if any."
-
- self selectItem: nil event: anEvent.
- self matchString: nil event: anEvent.!
Item was removed:
- ----- Method: MenuMorph>>removeStayUpBox (in category 'menu') -----
- removeStayUpBox
- | box |
- submorphs isEmpty ifTrue: [^self].
- (submorphs first isAlignmentMorph) ifFalse: [^self].
- box := submorphs first submorphs last.
- (box isKindOf: IconicButton)
- ifTrue:
- [box
- labelGraphic: (Form extent: box extent depth: 8);
- shedSelvedge;
- borderWidth: 0;
- lock]!
Item was removed:
- ----- Method: MenuMorph>>removeStayUpItems (in category 'menu') -----
- removeStayUpItems
- | stayUpItems |
- stayUpItems := self items select: [ :item | item isStayUpItem ].
- stayUpItems do: [ :ea | ea delete ].
- !
Item was removed:
- ----- Method: MenuMorph>>rootMenu (in category 'accessing') -----
- rootMenu
- popUpOwner ifNil: [^ self].
- popUpOwner owner ifNil: [^ self].
- ^ popUpOwner owner rootMenu!
Item was removed:
- ----- Method: MenuMorph>>selectCurrentItem: (in category 'keyboard control') -----
- selectCurrentItem: evt
- | selectable |
- selectedItem ifNotNil:
- [selectedItem hasSubMenu
- ifTrue: [self selectSubMenu: evt]
- ifFalse: [selectedItem invokeWithEvent: evt]].
- (selectable := self items) size = 1
- ifTrue: [selectable first invokeWithEvent: evt]!
Item was removed:
- ----- Method: MenuMorph>>selectItem:event: (in category 'control') -----
- selectItem: aMenuItem event: anEvent
- "Change the selected item."
-
- selectedItem ifNotNil:[selectedItem deselect: anEvent].
- selectedItem := aMenuItem.
- selectedItem ifNotNil:[selectedItem select: anEvent].!
Item was removed:
- ----- Method: MenuMorph>>selectMoreItem: (in category 'keyboard control') -----
- selectMoreItem: evt
- | allItems more |
- allItems := self submorphs select: [:m | m isKindOf: MenuItemMorph].
- more := allItems detect: [:m | (m contents size >= 4) and: [(m contents first: 4) asString = 'more'.]] ifNone: [^ self flash].
- self selectItem: more event: evt.
- selectedItem invokeWithEvent: evt!
Item was removed:
- ----- Method: MenuMorph>>selectedItem (in category 'private') -----
- selectedItem
- ^selectedItem!
Item was removed:
- ----- Method: MenuMorph>>setDefaultParameters (in category 'initialization') -----
- setDefaultParameters
- "change the receiver's appareance parameters"
-
- self
- color: (self userInterfaceTheme color ifNil: [Color r: 0.9 g: 0.9 b: 0.9]);
- borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle simple]) copy;
- borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]);
- borderWidth: ((self userInterfaceTheme borderWidth ifNil: [1]) * RealEstateAgent scaleFactor) truncated.
-
- Preferences menuAppearance3d ifTrue: [self addDropShadow].
-
- self layoutInset: (3 * RealEstateAgent scaleFactor) truncated.
- !
Item was removed:
- ----- Method: MenuMorph>>setInvokingView: (in category 'menu') -----
- setInvokingView: invokingView
- "Re-work every menu item of the form
- <target> perform: <selector>
- to the form
- <target> perform: <selector> orSendTo: <invokingView>.
- This supports MVC's vectoring of non-model messages to the editPane."
- self items do:
- [:item |
- item hasSubMenu
- ifTrue: [ item subMenu setInvokingView: invokingView]
- ifFalse: [ item arguments isEmpty ifTrue: "only the simple messages"
- [item arguments: (Array with: item selector with: invokingView).
- item selector: #perform:orSendTo:]]]!
Item was removed:
- ----- Method: MenuMorph>>setTarget: (in category 'menu') -----
- setTarget: evt
- "Set the default target object to be used for add item commands, and re-target all existing items to the new target or the the invoking hand."
-
- | oldDefaultTarget |
- oldDefaultTarget := defaultTarget .
- self sightTargets: evt.
- oldDefaultTarget ~~ defaultTarget
- ifTrue: [self updateItemsWithTarget: defaultTarget orWithHand: evt hand ].
- !
Item was removed:
- ----- Method: MenuMorph>>setTitleParameters (in category 'initialization') -----
- setTitleParameters
-
- self setTitleParametersFor: (self allMorphs
- detect: [:each | each hasProperty: #titleString]
- ifNone: [^ self]).!
Item was removed:
- ----- Method: MenuMorph>>setTitleParametersFor: (in category 'initialization') -----
- setTitleParametersFor: aMenuTitle
-
- aMenuTitle
- color: (self userInterfaceTheme titleColor ifNil: [Color transparent]);
- borderStyle: (self userInterfaceTheme titleBorderStyle ifNil: [BorderStyle simple]) copy;
- borderColor: (self userInterfaceTheme titleBorderColor ifNil: [Color r: 0.6 g: 0.7 b: 1]);
- borderWidth: (self userInterfaceTheme titleBorderWidth ifNil: [0]);
- cornerStyle: (self wantsRoundedCorners ifTrue: [#rounded] ifFalse: [#square]);
- vResizing: #shrinkWrap;
- wrapCentering: #center;
- cellPositioning: #center;
- cellGap: 5;
- layoutInset: (5 at 0 corner: 5 at 0).!
Item was removed:
- ----- Method: MenuMorph>>showKeyboardHelp (in category 'keystroke helpers') -----
- showKeyboardHelp
-
- | help |
-
- Preferences balloonHelpEnabled ifFalse: [^ self].
-
- help := self balloonMorphClass
- string: 'Enter text to narrow selection\down to matching items' translated withCRs
- for: self
- corner: #topLeft.
- help popUpAt: self topCenter forHand: self activeHand!
Item was removed:
- ----- Method: MenuMorph>>stayUp (in category 'accessing') -----
- stayUp
-
- ^ stayUp
- !
Item was removed:
- ----- Method: MenuMorph>>stayUp: (in category 'accessing') -----
- stayUp: aBoolean
-
- stayUp := aBoolean.
- aBoolean ifTrue: [ self removeStayUpBox ].
- self morphicLayerNumber: (aBoolean ifTrue: [ self class windowLayer ] ifFalse: [ self class menuLayer ]).
- originalFocusHolder := nil. "Not needed anymore."!
Item was removed:
- ----- Method: MenuMorph>>stepIntoSubmenu: (in category 'keystroke helpers') -----
- stepIntoSubmenu: evt
-
- (selectedItem notNil and: [ selectedItem hasSubMenu ]) ifTrue: [
- evt hand newMouseFocus: selectedItem subMenu.
- evt hand newKeyboardFocus: selectedItem subMenu.
- selectedItem subMenu moveSelectionDown: 1 event: evt.
- ^true ].
- ^false!
Item was removed:
- ----- Method: MenuMorph>>target: (in category 'menu') -----
- target: aMorph
- "Set defaultTarget since thats what we got.
- For the sake of targetSighting which assumes #target is a word we know."
-
- defaultTarget := aMorph!
Item was removed:
- ----- Method: MenuMorph>>title: (in category 'construction') -----
- title: aString
- "Add a title line at the top of this menu."
-
- self addTitle: aString!
Item was removed:
- ----- Method: MenuMorph>>toggleStayUp: (in category 'menu') -----
- toggleStayUp: evt
- "Toggle my 'stayUp' flag and adjust the menu item to reflect its new state."
-
- self items do: [:item |
- item isStayUpItem ifTrue:
- [self stayUp: stayUp not.
- stayUp
- ifTrue: [item contents: 'dismiss this menu' translated]
- ifFalse: [item contents: 'keep this menu up' translated]]].
- evt hand releaseMouseFocus: self.
- stayUp ifFalse: [self topRendererOrSelf delete].!
Item was removed:
- ----- Method: MenuMorph>>toggleStayUpIgnore:evt: (in category 'menu') -----
- toggleStayUpIgnore: ignored evt: evt
-
- "This variant is resistant to the MVC compatibility in #setInvokingView:"
-
- self toggleStayUp: evt.
- !
Item was removed:
- ----- Method: MenuMorph>>undoGrabCommand (in category 'dropping/grabbing') -----
- undoGrabCommand
- ^nil!
Item was removed:
- ----- Method: MenuMorph>>updateColor (in category 'control') -----
- updateColor
- | fill title cc |
- self class gradientMenu
- ifFalse: [^ self].
- (self fillStyle == self color) not
- ifTrue: [^ self]. "Don't apply the gradient more than once"
- ""
- title := self allMorphs
- detect: [:each | each hasProperty: #titleString]
- ifNone: [].
-
- cc := self color adjustSaturation: -0.08 brightness: 0.4.
- fill := GradientFillStyle ramp: {
- 0.0 -> (title ifNil: [cc] ifNotNil: [cc muchLighter]).
- 0.25 -> (self color mixed: 0.5 with: cc).
- 1.0 -> self color}.
- ""
- fill
- radial: false;
- origin: self topLeft;
- direction: 0 @ self height.
- ""
- "
- update the title color"
-
- title ifNotNil: [fill direction: 0@ title height].
- self fillStyle: fill.
- title ifNil: [^ self].
- ""
- fill := GradientFillStyle ramp: {
- 0.0 -> title color twiceLighter.
- 1 -> title color twiceDarker}.
- ""
- fill
- origin: title topLeft;
- direction: title width @ 0.
- ""
- title fillStyle: fill!
Item was removed:
- ----- Method: MenuMorph>>updateItemsWithTarget:orWithHand: (in category 'menu') -----
- updateItemsWithTarget: aTarget orWithHand: aHand
- "re-target all existing items"
- self items do:
- [:item | item target ifNotNil: [
- item target isHandMorph
- ifTrue: [item target: aHand]
- ifFalse: [item target: aTarget] ] ]!
Item was removed:
- ----- Method: MenuMorph>>updateMenu (in category 'update') -----
- updateMenu
- " Do nothing "!
Item was removed:
- ----- Method: MenuMorph>>veryDeepFixupWith: (in category 'copying') -----
- veryDeepFixupWith: deepCopier
- "If fields were weakly copied, fix them here. If they were in the tree being copied, fix them up, otherwise point to the originals."
-
- super veryDeepFixupWith: deepCopier.
- defaultTarget := deepCopier references at: defaultTarget ifAbsent: [defaultTarget].
- popUpOwner := deepCopier references at: popUpOwner ifAbsent: [popUpOwner].
- activeSubMenu := deepCopier references at: activeSubMenu ifAbsent:[activeSubMenu].!
Item was removed:
- ----- Method: MenuMorph>>veryDeepInner: (in category 'copying') -----
- veryDeepInner: deepCopier
- "Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment."
-
- super veryDeepInner: deepCopier.
- "defaultTarget := defaultTarget. Weakly copied"
- selectedItem := selectedItem veryDeepCopyWith: deepCopier.
- stayUp := stayUp veryDeepCopyWith: deepCopier.
- popUpOwner := popUpOwner. "Weakly copied"
- activeSubMenu := activeSubMenu. "Weakly copied"
- !
Item was removed:
- ----- Method: MenuMorph>>wantsEveryMouseMove (in category 'events') -----
- wantsEveryMouseMove
- ^ true!
Item was removed:
- ----- Method: MenuMorph>>wantsRoundedCorners (in category 'rounding') -----
- wantsRoundedCorners
-
- ^ self class roundedMenuCorners or: [super wantsRoundedCorners]!
Item was removed:
- ----- Method: MenuMorph>>wantsToBeDroppedInto: (in category 'control') -----
- wantsToBeDroppedInto: aMorph
- "Return true if it's okay to drop the receiver into aMorph. A single-item MenuMorph is in effect a button rather than a menu, and as such should not be reluctant to be dropped into another object."
-
- ^ (aMorph isWorldMorph or: [submorphs size = 1]) or:
- [Preferences systemWindowEmbedOK]!
Item was removed:
- Object subclass: #MenuUpdater
- instanceVariableNames: 'updater updateSelector arguments'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Menus'!
Item was removed:
- ----- Method: MenuUpdater>>update: (in category 'updating') -----
- update: aMenuMorph
- "Reconstitute the menu by first removing the contents and then building it afresh"
-
- aMenuMorph removeAllMorphs.
- arguments
- ifNil: [ updater perform: updateSelector with: aMenuMorph ]
- ifNotNil: [
- updater
- perform: updateSelector
- withArguments: (arguments copyWith: aMenuMorph) ].
- aMenuMorph changed!
Item was removed:
- ----- Method: MenuUpdater>>updater:updateSelector: (in category 'initialization') -----
- updater: anObject updateSelector: aSelector
-
- self updater: anObject updateSelector: aSelector arguments: nil!
Item was removed:
- ----- Method: MenuUpdater>>updater:updateSelector:arguments: (in category 'initialization') -----
- updater: anObject updateSelector: aSelector arguments: anArray
-
- updater := anObject.
- updateSelector := aSelector.
- arguments := anArray!
Item was removed:
- PolygonMorph subclass: #MixedCurveMorph
- instanceVariableNames: 'slopeClamps'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Basic-NewCurve'!
-
- !MixedCurveMorph commentStamp: '<historical>' prior: 0!
- A MixedCurveMorph is Curve that can be broken up into separately curved segments. It allows for the creation of matching edges( e. g. for jigsaw puzzle pieces).
-
- Instance Variables
- slopeClamps: <Array>
-
- slopeClamps
- - elements of array are either 0 or nil. Indicating whether slope for the corresponding vertex is 0 at 0 or unknown and therefore to be calculated. There is one element for each vertex.
-
-
- !
Item was removed:
- ----- Method: MixedCurveMorph class>>descriptionForPartsBin (in category 'parts bin') -----
- descriptionForPartsBin
- ^ self partName: 'Mixed'
- categories: #('Graphics' 'Basic')
- documentation: 'A Curve with optional bends and segments. Shift click to get handles.
- Click handles to change bends. Move handles to move the points.'!
Item was removed:
- ----- Method: MixedCurveMorph>>clamps (in category 'access') -----
- clamps
- " Return a collection of clamps the same size as vertices.
- If necessary default to unclamped slopes.
- "
-
- slopeClamps
- ifNil: [ ^ slopeClamps := Array new: vertices size ] .
- slopeClamps size = vertices size
- ifFalse: [ ^ slopeClamps := Array new: vertices size ] .
- ^ slopeClamps !
Item was removed:
- ----- Method: MixedCurveMorph>>clickVertex:event:fromHandle: (in category 'editing') -----
- clickVertex: ix event: evt fromHandle: handle
- " Toggle the state of the clamp. "
- "Note: self clamps assures slopeClamps will be same size as vertices"
-
- (self clamps at: ix)
- ifNil: [ slopeClamps at: ix put: 0 ]
- ifNotNil: [ slopeClamps at: ix put: nil ] .
- self setVertices: vertices .
-
- !
Item was removed:
- ----- Method: MixedCurveMorph>>deleteVertexAt: (in category 'editing') -----
- deleteVertexAt: anIndex
- (slopeClamps :=
- slopeClamps
- copyReplaceFrom: anIndex
- to: anIndex
- with: Array new) .
- self
- setVertices: (vertices
- copyReplaceFrom: anIndex
- to: anIndex
- with: Array new).
- !
Item was removed:
- ----- Method: MixedCurveMorph>>handleColorAt: (in category 'access') -----
- handleColorAt: vertIndex
- " clamped handles are cyan and
- unclamped handles are yellow."
-
- (self clamps at: vertIndex ) ifNil: [ ^ Color yellow ] .
- ^ Color cyan
- !
Item was removed:
- ----- Method: MixedCurveMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- self extent: 32 at 20 .
-
- self rectOval.
- self clamps . "This initializes slopeClamps."
- slopeClamps at: 1 put: 0 .
- slopeClamps at: 4 put: 0 .
-
- closed := true.
- smoothCurve := true.
- arrows := #none.
- self computeBounds!
Item was removed:
- ----- Method: MixedCurveMorph>>insertVertexAt:put: (in category 'editing') -----
- insertVertexAt: anIndex put: aValue
- "New vertexs are unclamped."
- "Note: order is important.
- The clamps array must match vertex size before setVertices: is performed."
- slopeClamps := slopeClamps
- copyReplaceFrom: anIndex + 1 to: anIndex with: (Array with: nil).
- self setVertices: (vertices copyReplaceFrom: anIndex + 1 to: anIndex
- with: (Array with: aValue)).!
Item was removed:
- ----- Method: MixedCurveMorph>>slopes: (in category 'smoothing') -----
- slopes: knots
- "Choose slopes according to state of polygon and preferences"
- self isCurvy
- ifFalse: [^ knots segmentedSlopes].
- ^ (closed
- and: [self isCurvier])
- ifTrue: [ knots closedCubicSlopes: self clamps ]
- ifFalse: [knots naturalCubicSlopes: self clamps ]!
Item was removed:
- ----- Method: Model>>step (in category '*morphic') -----
- step
- "Default for morphic models is no-op"!
Item was removed:
- Object subclass: #Morph
- instanceVariableNames: 'bounds owner submorphs fullBounds color extension'
- classVariableNames: 'HaloForAll IndicateKeyboardFocus MetaMenuForAll PreferredCornerRadius UseSoftDropShadow'
- poolDictionaries: ''
- category: 'Morphic-Kernel'!
-
- !Morph commentStamp: 'klc 3/14/2017 11:30' prior: 0!
- A Morph (from the Greek "shape" or "form") is an interactive graphical object. General information on the Morphic system can be found at http://wiki.squeak.org/squeak/30.
-
- Morphs exist in a tree, rooted at a World (generally a PasteUpMorph). The morphs owned by a morph are its submorphs. Morphs are drawn recursively; if a Morph has no owner it never gets drawn. To hide a Morph and its submorphs, set its #visible property to false using the #visible: method.
-
- The World (screen) coordinate system is used for most coordinates, but can be changed if there is a TransformMorph somewhere in the owner chain.
-
- My instance variables have accessor methods (e.g., #bounds, #bounds:). Most users should use the accessor methods instead of using the instance variables directly.
-
- Structure:
- instance var Type Description
- bounds Rectangle A Rectangle indicating my position and a size that will enclose me.
- owner Morph My parent Morph, or nil for the top-level Morph, which is a
- or nil world, typically a PasteUpMorph.
- submorphs Array My child Morphs.
- fullBounds Rectangle A Rectangle minimally enclosing me and my submorphs.
- color Color My primary color. Subclasses can use this in different ways.
- extension MorphExtension Allows extra properties to be stored without adding a
- or nil storage burden to all morphs.
-
- By default, Morphs do not position their submorphs. Morphs may position their submorphs directly or use a LayoutPolicy to automatically control their submorph positioning.
-
- Although Morph has some support for BorderStyle, most users should use BorderedMorph if they want borders.!
Item was removed:
- ----- Method: Morph class>>allSketchMorphClasses (in category 'testing') -----
- allSketchMorphClasses
- "Morph allSketchMorphClasses"
- ^ Array
- streamContents: [:s | self
- withAllSubclassesDo: [:cls | cls isSketchMorphClass
- ifTrue: [s nextPut: cls ]]]
- !
Item was removed:
- ----- Method: Morph class>>allSketchMorphForms (in category 'testing') -----
- allSketchMorphForms
- "Answer a Set of forms of SketchMorph (sub) instances, except those
- used as button images, ones being edited, and those with 0 extent."
-
- | reasonableForms |
- reasonableForms := Set new.
- Morph allSketchMorphClasses do:
- [:cls | cls allInstances do:
- [:m | | form |
- (m owner isKindOf: SketchEditorMorph orOf: IconicButton)
- ifFalse:
- [form := m form.
- ((form width > 0) and: [form height > 0]) ifTrue: [reasonableForms add: form]]]].
- ^ reasonableForms!
Item was removed:
- ----- Method: Morph class>>authoringPrototype (in category 'scripting') -----
- authoringPrototype
- "Answer an instance of the receiver suitable for placing in a parts bin for authors"
-
- ^ self new markAsPartsDonor!
Item was removed:
- ----- Method: Morph class>>backmostLayer (in category 'layer names') -----
- backmostLayer
-
- ^ 999!
Item was removed:
- ----- Method: Morph class>>balloonLayer (in category 'layer names') -----
- balloonLayer
- "Balloons and other tooltip-like morphs."
-
- ^ 5!
Item was removed:
- ----- Method: Morph class>>defaultLayer (in category 'layer names') -----
- defaultLayer
-
- ^ 100!
Item was removed:
- ----- Method: Morph class>>dialogLayer (in category 'layer names') -----
- dialogLayer
- "For morphs that request user input."
-
- ^ self progressLayer + (2 * self menuLayer) // 3
- !
Item was removed:
- ----- Method: Morph class>>fileReaderServicesForFile:suffix: (in category 'fileIn/Out') -----
- fileReaderServicesForFile: fullName suffix: suffix
-
- ^({ 'morph'. 'morphs'. 'sp'. '*' } includes: suffix)
- ifTrue: [
- {SimpleServiceEntry
- provider: self
- label: 'load as morph'
- selector: #fromFileName:
- description: 'load as morph'}]
- ifFalse: [#()]!
Item was removed:
- ----- Method: Morph class>>fromFileName: (in category 'fileIn/Out') -----
- fromFileName: fullName
- "Reconstitute a Morph from the file, presumed to be represent a Morph saved
- via the SmartRefStream mechanism, and open it in an appropriate Morphic world"
-
- | aFileStream morphOrList |
- aFileStream := (MultiByteBinaryOrTextStream with: ((FileStream readOnlyFileNamed: fullName) binary contentsOfEntireFile)) binary reset.
- morphOrList := aFileStream fileInObjectAndCode.
- (morphOrList isKindOf: SqueakPage) ifTrue: [morphOrList := morphOrList contentsMorph].
- Smalltalk isMorphic
- ifTrue: [Project current world addMorphsAndModel: morphOrList]
- ifFalse:
- [morphOrList isMorph ifFalse: [self inform: 'Can only load a single morph
- into an mvc project via this mechanism.' translated].
- morphOrList openInWorld]!
Item was removed:
- ----- Method: Morph class>>frontmostLayer (in category 'layer names') -----
- frontmostLayer
-
- ^ -999!
Item was removed:
- ----- Method: Morph class>>haloForAll (in category 'preferences') -----
- haloForAll
-
- <preference: 'Offer Halo for All Morphs'
- categoryList: #(Morphic)
- description: 'If enabled, there will be a halo provided for any morph after a certain input gesture is detected, which is usually a BLUE (middle) mouse click.'
- type: #Boolean>
- ^ HaloForAll ifNil: [true]!
Item was removed:
- ----- Method: Morph class>>haloForAll: (in category 'preferences') -----
- haloForAll: aBoolean
-
- HaloForAll := aBoolean.!
Item was removed:
- ----- Method: Morph class>>haloLayer (in category 'layer names') -----
- haloLayer
- "A morph's halo is like a meta menu with a tooltip-like information overlay."
-
- ^ self menuLayer + self balloonLayer // 2!
Item was removed:
- ----- Method: Morph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
- includeInNewMorphMenu
- "Return true for all classes that can be instantiated from the menu"
- ^ true!
Item was removed:
- ----- Method: Morph class>>indicateKeyboardFocus (in category 'preferences') -----
- indicateKeyboardFocus
-
- <preference: 'Indicate Keyboard Focus'
- categoryList: #(keyboard Morphic general)
- description: 'If enabled, there will be a visual highlight drawn onto the morph to help the user find out about the current keyboard focus. This is especially useful when the keyboard focus does not match the mouse position.'
- type: #Boolean>
- ^ IndicateKeyboardFocus ifNil: [false]!
Item was removed:
- ----- Method: Morph class>>indicateKeyboardFocus: (in category 'preferences') -----
- indicateKeyboardFocus: aBoolean
-
- IndicateKeyboardFocus := aBoolean.!
Item was removed:
- ----- Method: Morph class>>initialize (in category 'class initialization') -----
- initialize
- "Morph initialize"
- FileServices registerFileReader: self!
Item was removed:
- ----- Method: Morph class>>initializedInstance (in category 'instance creation') -----
- initializedInstance
- "Answer an instance of the receiver which in some sense is initialized. In the case of Morphs, this will yield an instance that can be attached to the Hand after having received the same kind of basic initialization that would be obtained from an instance chosen from the 'new morph' menu.
- Return nil if the receiver is reluctant for some reason to return such a thing"
-
- ^ (self class includesSelector: #descriptionForPartsBin)
- ifTrue:
- [self newStandAlone]
- ifFalse:
- [self new]!
Item was removed:
- ----- Method: Morph class>>isSketchMorphClass (in category 'testing') -----
- isSketchMorphClass
- ^false!
Item was removed:
- ----- Method: Morph class>>menuLayer (in category 'layer names') -----
- menuLayer
- "Pop-up menu-like morphs."
-
- ^ 10!
Item was removed:
- ----- Method: Morph class>>metaMenuForAll (in category 'preferences') -----
- metaMenuForAll
-
- <preference: 'Offer Meta Menu for All Morphs'
- categoryList: #(Morphic)
- description: 'If enabled, there will be a meta menu provided for any morph after a certain input gesture is detected, which is usually a CTRL+Any mouse click.'
- type: #Boolean>
- ^ MetaMenuForAll ifNil: [true]!
Item was removed:
- ----- Method: Morph class>>metaMenuForAll: (in category 'preferences') -----
- metaMenuForAll: aBoolean
-
- MetaMenuForAll := aBoolean.!
Item was removed:
- ----- Method: Morph class>>morphsUnknownToTheirOwners (in category 'misc') -----
- morphsUnknownToTheirOwners
- "Return a list of all morphs (other than HandMorphs) whose owners do not contain them in their submorph lists"
- "Morph morphsUnknownToTheirOwners"
- | problemMorphs |
- problemMorphs := OrderedCollection new.
- self allSubInstances do:
- [:m | | itsOwner |
- (m isHandMorph not and: [((itsOwner := m owner) ~~ nil and: [(itsOwner submorphs includes: m) not])])
- ifTrue:
- [problemMorphs add: m]].
- ^ problemMorphs!
Item was removed:
- ----- Method: Morph class>>navigatorLayer (in category 'layer names') -----
- navigatorLayer
- "For morphs that float above all (tool) windows and provide quick access to other tools. Examples include docking bars and flaps."
-
- ^ self progressLayer + self windowLayer // 2!
Item was removed:
- ----- Method: Morph class>>newBounds: (in category 'instance creation') -----
- newBounds: bounds
-
- ^ self new privateBounds: bounds!
Item was removed:
- ----- Method: Morph class>>newBounds:color: (in category 'instance creation') -----
- newBounds: bounds color: color
-
- ^ (self new privateBounds: bounds) privateColor: color
- !
Item was removed:
- ----- Method: Morph class>>newStandAlone (in category 'new-morph participation') -----
- newStandAlone
- "Answer an instance capable of standing by itself as a usable morph."
-
- ^ self basicNew initializeToStandAlone!
Item was removed:
- ----- Method: Morph class>>newSticky (in category 'instance creation') -----
- newSticky
-
- ^ self new beSticky!
Item was removed:
- ----- Method: Morph class>>partName:categories:documentation: (in category 'new-morph participation') -----
- partName: aName categories: aList documentation: aDoc
- "Answer a DescriptionForPartsBin which will represent a launch of a new instance of my class via the #newStandAlone protocol sent to my class. Use the category-list and documentation provided"
-
-
- ^ DescriptionForPartsBin new
- formalName: aName
- categoryList: aList
- documentation: aDoc
- globalReceiverSymbol: self name
- nativitySelector: #newStandAlone!
Item was removed:
- ----- Method: Morph class>>partName:categories:documentation:sampleImageForm: (in category 'new-morph participation') -----
- partName: aName categories: aList documentation: aDoc sampleImageForm: aForm
- "Answer a DescriptionForPartsBin which will represent a launch of a new instance of my class via the #newStandAlone protocol sent to my class. Use the category-list and documentation provided. This variant allows an overriding image form to be provided, useful in cases where we don't want to launch a sample instance just to get the form"
-
- | descr |
- descr := DescriptionForPartsBin new
- formalName: aName
- categoryList: aList
- documentation: aDoc
- globalReceiverSymbol: self name
- nativitySelector: #newStandAlone.
- descr sampleImageForm: aForm.
- ^ descr
- !
Item was removed:
- ----- Method: Morph class>>preferredCornerRadius (in category 'preferences') -----
- preferredCornerRadius
-
- <preference: 'Preferred Corner Radius'
- categoryList: #(Morphic windows menus)
- description: 'If a morph wants rounded corners, use this radius. May be overwritten in subclasses.'
- type: #Number>
- ^ ((PreferredCornerRadius ifNil: [8]) * RealEstateAgent scaleFactor) rounded!
Item was removed:
- ----- Method: Morph class>>preferredCornerRadius: (in category 'preferences') -----
- preferredCornerRadius: anInteger
-
- PreferredCornerRadius := anInteger ifNotNil: [(anInteger / RealEstateAgent scaleFactor) rounded].!
Item was removed:
- ----- Method: Morph class>>progressLayer (in category 'layer names') -----
- progressLayer
- "For morphs that help the user understand why a certain operation has not finished yet."
-
- ^ self windowLayer + self menuLayer // 2!
Item was removed:
- ----- Method: Morph class>>selectionBackground (in category 'defaults') -----
- selectionBackground
- "The background for selected items in lists and tree-list thingies."
- ^ self subduedHilites ifTrue: [
- TranslucentColor r: 0.0 g: 0.0 b: 0.8 alpha: 0.2
- ] ifFalse: [
- "This is tuned so the red-foreground used for list texts stays somewhat legible."
- Color r: 0.8 g:0.8 b: 0.81 alpha: 0.85
- ].
- !
Item was removed:
- ----- Method: Morph class>>serviceLoadMorphFromFile (in category 'fileIn/Out') -----
- serviceLoadMorphFromFile
- "Answer a service for loading a .morph file"
-
- ^ SimpleServiceEntry
- provider: self
- label: 'load as morph' translatedNoop
- selector: #fromFileName:
- description: 'load as morph' translatedNoop
- buttonLabel: 'load' translatedNoop!
Item was removed:
- ----- Method: Morph class>>services (in category 'fileIn/Out') -----
- services
-
- ^ Array with: self serviceLoadMorphFromFile!
Item was removed:
- ----- Method: Morph class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- | catName |
- catName := 'Other'.
-
- ^{
- { #hardShadowColor. catName. 'The color of shadows. An alpha about 0.5 is recommended.' }.
- { #hardShadowOffset. catName. 'The offset of the shadows behind the morph.' } .
- { #softShadowColor. catName. 'The color of soft shadows. An alpha less than 0.05 is recommended.' }.
- { #softShadowOffset. catName. 'The offset of soft shadows behind the morph.' } .
- { #keyboardFocusColor. catName. 'The color of the keyboard focus indication.' }.
- { #keyboardFocusWidth. catName. 'The width of the keyboard focus indication.' }.
- }!
Item was removed:
- ----- Method: Morph class>>unload (in category 'initialize-release') -----
- unload
-
- FileServices unregisterFileReader: self !
Item was removed:
- ----- Method: Morph class>>useSoftDropShadow (in category 'preferences') -----
- useSoftDropShadow
-
- <preference: 'Use Soft Drop Shadow'
- categoryList: #(Morphic windows menus performance)
- description: 'If drop shadows are enabled, this preference will switch between hard and soft shadows. Soft shadows are more expensive.'
- type: #Boolean>
- ^ UseSoftDropShadow ifNil: [ false ]!
Item was removed:
- ----- Method: Morph class>>useSoftDropShadow: (in category 'preferences') -----
- useSoftDropShadow: aBoolean
-
- UseSoftDropShadow = aBoolean ifTrue: [^ self].
- UseSoftDropShadow := aBoolean.
-
- SystemWindow refreshAllWindows.
- DialogWindow refreshAllDialogs.
- SystemProgressMorph reset.
- TheWorldMainDockingBar updateInstances.!
Item was removed:
- ----- Method: Morph class>>windowLayer (in category 'layer names') -----
- windowLayer
- "For morphs that represent windows and other tool-like containers."
-
- ^ 100!
Item was removed:
- ----- Method: Morph>>abandon (in category 'submorphs - add/remove') -----
- abandon
- "Like delete, but we really intend not to use this morph again. Clean up a few things."
-
- self delete!
Item was removed:
- ----- Method: Morph>>aboutToBeDraggedViaHalo (in category 'halo notification') -----
- aboutToBeDraggedViaHalo
- "The receiver is about to be dragged via the halo."!
Item was removed:
- ----- Method: Morph>>aboutToBeGrabbedBy: (in category 'dropping/grabbing') -----
- aboutToBeGrabbedBy: aHand
- "The receiver is being grabbed by a hand.
- Perform necessary adjustments (if any) and return the actual morph
- that should be added to the hand."
- | extentToHandToHand cmd |
- self formerOwner: owner.
- self formerPosition: self position.
- cmd := self undoGrabCommand.
- cmd ifNotNil:[self setProperty: #undoGrabCommand toValue: cmd].
- (extentToHandToHand := self valueOfProperty: #expandedExtent)
- ifNotNil:
- [self removeProperty: #expandedExtent.
- self extent: extentToHandToHand].
- ^self "Grab me"!
Item was removed:
- ----- Method: Morph>>aboutToBeGrownViaHalo (in category 'halo notification') -----
- aboutToBeGrownViaHalo
- "The receiver is about to be grown via the halo."!
Item was removed:
- ----- Method: Morph>>aboutToBeRotatedViaHalo (in category 'halo notification') -----
- aboutToBeRotatedViaHalo
- "The receiver is about to be rotated via the halo."!
Item was removed:
- ----- Method: Morph>>aboutToBeScaledViaHalo (in category 'halo notification') -----
- aboutToBeScaledViaHalo
- "The receiver is about to be scaled via the halo."!
Item was removed:
- ----- Method: Morph>>absorbStateFromRenderer: (in category 'menus') -----
- absorbStateFromRenderer: aRenderer
- "Transfer knownName, actorState, visible, and player info over from aRenderer, which was formerly imposed above me as a transformation shell but is now going away."
-
- | current |
- (current := aRenderer actorStateOrNil) ifNotNil:
- [self actorState: current.
- aRenderer actorState: nil].
-
- (current := aRenderer knownName) ifNotNil:
- [self setNameTo: current.
- aRenderer setNameTo: nil].
-
- (current := aRenderer player) ifNotNil:
- [self player: current.
- current rawCostume: self.
- aRenderer player: nil].
-
- self visible: aRenderer visible!
Item was removed:
- ----- Method: Morph>>acceptDroppingMorph:event: (in category 'dropping/grabbing') -----
- acceptDroppingMorph: aMorph event: evt
- "This message is sent when a morph is dropped onto a morph that has agreed to accept the dropped morph by responding 'true' to the wantsDroppedMorph:Event: message. This default implementation just adds the given morph to the receiver."
- | layout |
- layout := self layoutPolicy.
- layout ifNil:[^self addMorph: aMorph].
- self privateAddMorph: aMorph
- atIndex: (layout indexForInserting: aMorph at: evt position in: self).!
Item was removed:
- ----- Method: Morph>>actWhen (in category 'submorphs - misc') -----
- actWhen
- "Answer when the receiver, probably being used as a button, should have its action triggered"
-
- ^ self valueOfProperty: #actWhen ifAbsentPut: [#buttonDown]!
Item was removed:
- ----- Method: Morph>>actWhen: (in category 'submorphs - misc') -----
- actWhen: aButtonPhase
- "Set the receiver's actWhen trait"
-
- self setProperty: #actWhen toValue: aButtonPhase!
Item was removed:
- ----- Method: Morph>>actionMap (in category 'events-accessing') -----
- actionMap
- "Answer an action map"
-
- | actionMap |
- actionMap := self valueOfProperty: #actionMap.
- actionMap ifNil:
- [actionMap := self createActionMap].
- ^ actionMap!
Item was removed:
- ----- Method: Morph>>activeHand (in category 'structure') -----
- activeHand
-
- self flag: #deprecated. "mt: Use #currentHand instead."
- ^ self currentHand!
Item was removed:
- ----- Method: Morph>>actorState: (in category 'accessing') -----
- actorState: anActorState
- "change the receiver's actorState"
- self assureExtension actorState: anActorState!
Item was removed:
- ----- Method: Morph>>actorStateOrNil (in category 'accessing') -----
- actorStateOrNil
- "answer the redeiver's actorState"
- ^ extension ifNotNil: [extension actorState]!
Item was removed:
- ----- Method: Morph>>adaptToWorld: (in category 'e-toy support') -----
- adaptToWorld: aWorld
- "The receiver finds itself operating in a possibly-different new world. If any of the receiver's parts are world-dependent (such as a target of a SimpleButtonMorph, etc.), then have them adapt accordingly"
- submorphs do: [:m | m adaptToWorld: aWorld].
- self eventHandler ifNotNil:
- [self eventHandler adaptToWorld: aWorld]!
Item was removed:
- ----- Method: Morph>>addAddHandMenuItemsForHalo:hand: (in category 'menus') -----
- addAddHandMenuItemsForHalo: aMenu hand: aHandMorph
- "The former charter of this method was to add halo menu items that pertained specifically to the hand. Over time this charter has withered, and most morphs reimplement this method simply to add their morph-specific menu items. So in the latest round, all other implementors in the standard image have been removed. However, this is left here as a hook for the benefit of existing code in client uses."
-
- !
Item was removed:
- ----- Method: Morph>>addAlarm:after: (in category 'events-alarms') -----
- addAlarm: aSelector after: delayTime
- "Add an alarm (that is an action to be executed once) with the given set of parameters"
- ^self addAlarm: aSelector withArguments: #() after: delayTime!
Item was removed:
- ----- Method: Morph>>addAlarm:at: (in category 'events-alarms') -----
- addAlarm: aSelector at: scheduledTime
- "Add an alarm (that is an action to be executed once) with the given set of parameters"
- ^self addAlarm: aSelector withArguments: #() at: scheduledTime!
Item was removed:
- ----- Method: Morph>>addAlarm:with:after: (in category 'events-alarms') -----
- addAlarm: aSelector with: arg1 after: delayTime
- "Add an alarm (that is an action to be executed once) with the given set of parameters"
- ^self addAlarm: aSelector withArguments: (Array with: arg1) after: delayTime!
Item was removed:
- ----- Method: Morph>>addAlarm:with:at: (in category 'events-alarms') -----
- addAlarm: aSelector with: arg1 at: scheduledTime
- "Add an alarm (that is an action to be executed once) with the given set of parameters"
- ^self addAlarm: aSelector withArguments: (Array with: arg1) at: scheduledTime!
Item was removed:
- ----- Method: Morph>>addAlarm:with:with:after: (in category 'events-alarms') -----
- addAlarm: aSelector with: arg1 with: arg2 after: delayTime
- "Add an alarm (that is an action to be executed once) with the given set of parameters"
- ^self addAlarm: aSelector withArguments: (Array with: arg1 with: arg2) after: delayTime!
Item was removed:
- ----- Method: Morph>>addAlarm:with:with:at: (in category 'events-alarms') -----
- addAlarm: aSelector with: arg1 with: arg2 at: scheduledTime
- "Add an alarm (that is an action to be executed once) with the given set of parameters"
- ^self addAlarm: aSelector withArguments: (Array with: arg1 with: arg2) at: scheduledTime!
Item was removed:
- ----- Method: Morph>>addAlarm:withArguments:after: (in category 'events-alarms') -----
- addAlarm: aSelector withArguments: args after: delayTime
- "Add an alarm (that is an action to be executed once) with the given set of parameters"
- ^self addAlarm: aSelector withArguments: args at: Time millisecondClockValue + delayTime!
Item was removed:
- ----- Method: Morph>>addAlarm:withArguments:at: (in category 'events-alarms') -----
- addAlarm: aSelector withArguments: args at: scheduledTime
- "Add an alarm (that is an action to be executed once) with the given set of parameters"
- | scheduler |
- scheduler := self alarmScheduler.
- scheduler ifNotNil:[scheduler addAlarm: aSelector withArguments: args for: self at: scheduledTime].!
Item was removed:
- ----- Method: Morph>>addAllMorphs: (in category 'submorphs - add/remove') -----
- addAllMorphs: aCollection
- ^self addAllMorphsBack: aCollection!
Item was removed:
- ----- Method: Morph>>addAllMorphs:after: (in category 'submorphs - add/remove') -----
- addAllMorphs: aCollection after: anotherMorph
- ^self addAllMorphs: aCollection behind: anotherMorph!
Item was removed:
- ----- Method: Morph>>addAllMorphs:behind: (in category 'submorphs - add/remove') -----
- addAllMorphs: aCollection behind: anotherMorph
- ^self privateAddAllMorphs: aCollection
- atIndex: (submorphs indexOf: anotherMorph) + 1!
Item was removed:
- ----- Method: Morph>>addAllMorphs:inFrontOf: (in category 'submorphs - add/remove') -----
- addAllMorphs: aCollection inFrontOf: anotherMorph
- ^self privateAddAllMorphs: aCollection
- atIndex: ((submorphs indexOf: anotherMorph) max: 1)!
Item was removed:
- ----- Method: Morph>>addAllMorphsBack: (in category 'submorphs - add/remove') -----
- addAllMorphsBack: aCollection
- ^self privateAddAllMorphs: aCollection atIndex: submorphs size + 1!
Item was removed:
- ----- Method: Morph>>addAllMorphsBackInLayers: (in category 'submorphs - layers') -----
- addAllMorphsBackInLayers: morphs
-
- morphs do: [:morph | self addMorphBackInLayer: morph].!
Item was removed:
- ----- Method: Morph>>addAllMorphsFront: (in category 'submorphs - add/remove') -----
- addAllMorphsFront: aCollection
- ^self privateAddAllMorphs: aCollection atIndex: 1!
Item was removed:
- ----- Method: Morph>>addAllMorphsFrontInLayers: (in category 'submorphs - layers') -----
- addAllMorphsFrontInLayers: morphs
-
- morphs reverseDo: [:morph | self addMorphFrontInLayer: morph].!
Item was removed:
- ----- Method: Morph>>addAllMorphsInLayers: (in category 'submorphs - layers') -----
- addAllMorphsInLayers: morphs
-
- ^self addAllMorphsBackInLayers: morphs!
Item was removed:
- ----- Method: Morph>>addBorderStyleMenuItems:hand: (in category 'menu') -----
- addBorderStyleMenuItems: aMenu hand: aHandMorph
- "Probably one could offer border-style items even if it's not a borderedMorph, so this remains a loose end for the moment"
- !
Item was removed:
- ----- Method: Morph>>addCellLayoutMenuItems:hand: (in category 'layout-menu') -----
- addCellLayoutMenuItems: aMenu hand: aHand
- "Cell (e.g., child) related items"
- | menu sub |
- menu := MenuMorph new defaultTarget: self.
- menu addUpdating: #hasDisableTableLayoutString action: #changeDisableTableLayout.
- menu addLine.
-
- sub := MenuMorph new defaultTarget: self.
- #(rigid shrinkWrap spaceFill) do:[:sym|
- sub addUpdating: #hResizingString: target: self selector: #hResizing: argumentList: (Array with: sym)].
- menu add:'horizontal resizing' translated subMenu: sub.
-
- sub := MenuMorph new defaultTarget: self.
- #(rigid shrinkWrap spaceFill) do:[:sym|
- sub addUpdating: #vResizingString: target: self selector: #vResizing: argumentList: (Array with: sym)].
- menu add:'vertical resizing' translated subMenu: sub.
-
- aMenu ifNotNil:[aMenu add: 'child layout' translated subMenu: menu].
- ^menu!
Item was removed:
- ----- Method: Morph>>addCopyItemsTo: (in category 'menus') -----
- addCopyItemsTo: aMenu
- "Add copy-like items to the halo menu"
-
- | subMenu |
- subMenu := MenuMorph new defaultTarget: self.
- subMenu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:.
- subMenu add: 'copy text' translated action: #clipText.
- subMenu add: 'copy Postscript' translated action: #clipPostscript.
- subMenu add: 'print Postscript to file...' translated target: self selector: #printPSToFile.
- aMenu add: 'copy & print...' translated subMenu: subMenu!
Item was removed:
- ----- Method: Morph>>addCustomHaloMenuItems:hand: (in category 'menus') -----
- addCustomHaloMenuItems: aMenu hand: aHandMorph
- "Add morph-specific items to the given menu which was invoked by the given hand from the halo. To get started, we defer to the counterpart method used with the option-menu, but in time we can have separate menu choices for halo-menus and for option-menus"
-
- self addCustomMenuItems: aMenu hand: aHandMorph!
Item was removed:
- ----- Method: Morph>>addCustomMenuItems:hand: (in category 'menus') -----
- addCustomMenuItems: aCustomMenu hand: aHandMorph
- "Add morph-specific items to the given menu which was invoked by the given hand. This method provides is invoked both from the halo-menu and from the control-menu regimes."
- !
Item was removed:
- ----- Method: Morph>>addDebuggingItemsTo:hand: (in category 'debug and other') -----
- addDebuggingItemsTo: aMenu hand: aHandMorph
- aMenu add: 'debug...' translated subMenu: (self buildDebugMenu: aHandMorph)!
Item was removed:
- ----- Method: Morph>>addDropShadow (in category 'drop shadows') -----
- addDropShadow
-
- self
- hasDropShadow: true;
- shadowOffset: (self useSoftDropShadow
- ifTrue: [self userInterfaceTheme softShadowOffset ifNil: [10 at 8 corner: 10 at 12]]
- ifFalse: [self userInterfaceTheme hardShadowOffset ifNil: [1 at 1]]);
- shadowColor: (self useSoftDropShadow
- ifTrue: [self userInterfaceTheme softShadowColor ifNil: [Color black alpha: 0.01]]
- ifFalse: [self userInterfaceTheme hardShadowColor ifNil: [Color black alpha: 0.5]]).!
Item was removed:
- ----- Method: Morph>>addDropShadowMenuItems:hand: (in category 'drop shadows') -----
- addDropShadowMenuItems: aMenu hand: aHand
- | menu |
- menu := MenuMorph new defaultTarget: self.
- menu
- addUpdating: #hasDropShadowString
- action: #toggleDropShadow.
- menu addLine.
- menu add: 'shadow color...' translated target: self selector: #changeShadowColor.
- menu add: 'shadow offset...' translated target: self selector: #setShadowOffset:.
- aMenu add: 'drop shadow' translated subMenu: menu.!
Item was removed:
- ----- Method: Morph>>addEmbeddingMenuItemsTo:hand: (in category 'meta-actions') -----
- addEmbeddingMenuItemsTo: aMenu hand: aHandMorph
- "Construct a menu offerring embed targets for the receiver. If the incoming menu is is not degenerate, add the constructed menu as a submenu; in any case, answer the embed-target menu"
-
- | menu w |
- menu := MenuMorph new defaultTarget: self.
- w := self world.
- self potentialEmbeddingTargets reverseDo: [:m |
- menu add: (m == w ifTrue: ['desktop' translated] ifFalse: [m knownName ifNil:[m class name asString]]) target: m selector: #addMorphFrontFromWorldPosition: argumentList: {self topRendererOrSelf}.
- m == self topRendererOrSelf owner ifTrue:
- [menu lastItem color: Color red]].
- aMenu ifNotNil:
- [menu submorphCount > 0
- ifTrue:[aMenu add:'embed into' translated subMenu: menu]].
- ^ menu!
Item was removed:
- ----- Method: Morph>>addEventBubbleFilter: (in category 'events-filtering-bubbling') -----
- addEventBubbleFilter: anObject
- self eventBubbleFilters: (self addFilter: anObject to: self eventBubbleFilters).!
Item was removed:
- ----- Method: Morph>>addEventCaptureFilter: (in category 'events-filtering-capturing') -----
- addEventCaptureFilter: anObject
- self eventCaptureFilters: (self addFilter: anObject to: self eventCaptureFilters).!
Item was removed:
- ----- Method: Morph>>addExportMenuItems:hand: (in category 'menus') -----
- addExportMenuItems: aMenu hand: aHandMorph
- "Add export items to the menu"
-
- aMenu ifNotNil:
- [ | aSubMenu |
- aSubMenu := MenuMorph new defaultTarget: self.
- aSubMenu add: 'BMP file' translated action: #exportAsBMP.
- aSubMenu add: 'GIF file' translated action: #exportAsGIF.
- aSubMenu add: 'JPEG file' translated action: #exportAsJPEG.
- aSubMenu add: 'PNG file' translated action: #exportAsPNG.
- (self respondsTo: #exportAsEPS) ifTrue: [
- aSubMenu add: 'EPS file' translated action: #exportAsEPS].
- aMenu add: 'export...' translated subMenu: aSubMenu]
- !
Item was removed:
- ----- Method: Morph>>addFillStyleMenuItems:hand: (in category 'menus') -----
- addFillStyleMenuItems: aMenu hand: aHand
- "Add the items for changing the current fill style of the Morph"
- | menu |
- self canHaveFillStyles ifFalse:[^aMenu add: 'change color...' translated target: self action: #changeColor].
- menu := MenuMorph new defaultTarget: self.
- self fillStyle addFillStyleMenuItems: menu hand: aHand from: self.
- menu addLine.
- menu add: 'solid fill' translated action: #useSolidFill.
- menu add: 'gradient fill' translated action: #useGradientFill.
- menu add: 'bitmap fill' translated action: #useBitmapFill.
- menu add: 'default fill' translated action: #useDefaultFill.
- aMenu add: 'fill style' translated subMenu: menu.
- "aMenu add: 'change color...' translated action: #changeColor"!
Item was removed:
- ----- Method: Morph>>addFilter:to: (in category 'events-filtering') -----
- addFilter: anObject to: aFilterGroup
- "Add anObject to the given listener group. Return the new group."
- | filters |
- filters := aFilterGroup.
- (filters notNil and:[filters includes: anObject]) ifFalse:[
- filters
- ifNil:[filters := WeakArray with: anObject]
- ifNotNil:[filters := filters copyWith: anObject]].
- filters := filters copyWithout: nil. "obsolete entries"
- ^filters!
Item was removed:
- ----- Method: Morph>>addFlexShell (in category 'rotate scale and flex') -----
- addFlexShell
- "Wrap a rotating and scaling shell around this morph."
-
- | oldHalo myWorld flexMorph anIndex |
- oldHalo:= self halo.
- myWorld := self world.
- self owner
- ifNil: [flexMorph := self newTransformationMorph asFlexOf: self]
- ifNotNil: [:myOwner |
- anIndex := myOwner submorphIndexOf: self.
- "Avoid triggering outOfWorld: on self by first adding flexMorph to myOwner and only then making myself a submorph of flexMorph via asFlexOf:"
- flexMorph := self newTransformationMorph.
- myOwner addMorph: flexMorph asElementNumber: anIndex.
- flexMorph asFlexOf: self.
- myWorld ifNotNil: [myWorld startSteppingSubmorphsOf: flexMorph]].
- self transferStateToRenderer: flexMorph.
- oldHalo ifNotNil: [oldHalo setTarget: flexMorph].
-
- ^ flexMorph!
Item was removed:
- ----- Method: Morph>>addFlexShellIfNecessary (in category 'rotate scale and flex') -----
- addFlexShellIfNecessary
- "If this morph requires a flex shell to scale or rotate,
- then wrap it in one and return it.
- Polygons, eg, may override to return themselves."
-
- ^ self addFlexShell!
Item was removed:
- ----- Method: Morph>>addGestureMenuItems:hand: (in category 'menu') -----
- addGestureMenuItems: aMenu hand: aHandMorph
- "If the receiver wishes the Genie menu items, add a line to the menu and then those Genie items, else do nothing"!
Item was removed:
- ----- Method: Morph>>addGraphModelYellowButtonItemsTo:event: (in category 'menu') -----
- addGraphModelYellowButtonItemsTo: aCustomMenu event: evt
- ^aCustomMenu!
Item was removed:
- ----- Method: Morph>>addHalo (in category 'halos and balloon help') -----
- addHalo
- "Invoke a halo programatically (e.g., not from a meta gesture)"
-
- ^ self createHalo
- popUpFor: self;
- yourself!
Item was removed:
- ----- Method: Morph>>addHalo: (in category 'halos and balloon help') -----
- addHalo: evt
-
- ^ self createHalo
- popUpFor: self event: evt;
- yourself!
Item was removed:
- ----- Method: Morph>>addHaloActionsTo: (in category 'menus') -----
- addHaloActionsTo: aMenu
- "Add items to aMenu representing actions requestable via halo"
-
- | subMenu |
- subMenu := MenuMorph new defaultTarget: self.
- subMenu addTitle: self externalName.
- subMenu addStayUpItemSpecial.
- subMenu addLine.
- subMenu add: 'delete' translated action: #dismissViaHalo.
- subMenu balloonTextForLastItem: 'Delete this object -- warning -- can be destructive!!' translated.
-
- self maybeAddCollapseItemTo: subMenu.
- subMenu add: 'grab' translated action: #openInHand.
- subMenu balloonTextForLastItem: 'Pick this object up -- warning, since this removes it from its container, it can have adverse effects.' translated.
-
- subMenu addLine.
-
- subMenu add: 'resize' translated action: #resizeFromMenu.
- subMenu balloonTextForLastItem: 'Change the size of this object' translated.
-
- subMenu add: 'duplicate' translated action: #maybeDuplicateMorph.
- subMenu balloonTextForLastItem: 'Hand me a copy of this object' translated.
- "Note that this allows access to the non-instancing duplicate even when this is a uniclass instance"
-
- self couldMakeSibling ifTrue:
- [subMenu add: 'make a sibling' translated action: #handUserASibling.
- subMenu balloonTextForLastItem: 'Make a new sibling of this object and hand it to me' translated].
-
- subMenu addLine.
- subMenu add: 'property sheet' translated target: self renderedMorph action: #openAPropertySheet.
- subMenu balloonTextForLastItem: 'Open a property sheet for me. Allows changing lots of stuff at once.' translated.
-
- subMenu add: 'set color' translated target: self renderedMorph action: #changeColor.
- subMenu balloonTextForLastItem: 'Change the color of this object' translated.
-
- subMenu add: 'viewer' translated target: self action: #beViewed.
- subMenu balloonTextForLastItem: 'Open a Viewer that will allow everything about this object to be seen and controlled.' translated.
-
- subMenu add: 'tile browser' translated target: self action: #openInstanceBrowserWithTiles.
- subMenu balloonTextForLastItem: 'Open a tool that will facilitate tile scripting of this object.' translated.
-
- subMenu add: 'tile representing this object' translated target: self action: #tearOffTile.
- subMenu balloonTextForLastItem: 'Hand me a tile represting this object' translated.
- subMenu addLine.
-
- subMenu add: 'inspect' translated target: self action: #inspect.
- subMenu balloonTextForLastItem: 'Open an Inspector on this object' translated.
-
- aMenu add: 'halo actions...' translated subMenu: subMenu
- !
Item was removed:
- ----- Method: Morph>>addHandlesTo:box: (in category 'halos and balloon help') -----
- addHandlesTo: aHaloMorph box: box
- "Add halo handles to the halo. Apply the halo filter if appropriate"
-
-
- aHaloMorph haloBox: box.
- Preferences haloSpecifications do:
- [:aSpec | | wantsIt aSelector |
- aSelector := aSpec addHandleSelector.
- wantsIt := Preferences selectiveHalos
- ifTrue:
- [self wantsHaloHandleWithSelector: aSelector inHalo: aHaloMorph]
- ifFalse:
- [true].
- wantsIt ifTrue:
- [(#(addMakeSiblingHandle: addDupHandle:) includes: aSelector) ifTrue:
- [wantsIt := self preferredDuplicationHandleSelector = aSelector].
- wantsIt ifTrue:
- [aHaloMorph perform: aSelector with: aSpec]]].
-
- aHaloMorph innerTarget addOptionalHandlesTo: aHaloMorph box: box!
Item was removed:
- ----- Method: Morph>>addKeyboardBubbleFilter: (in category 'events-filtering-bubbling') -----
- addKeyboardBubbleFilter: anObject
- self keyboardBubbleFilters: (self addFilter: anObject to: self keyboardBubbleFilters).!
Item was removed:
- ----- Method: Morph>>addKeyboardCaptureFilter: (in category 'events-filtering-capturing') -----
- addKeyboardCaptureFilter: anObject
- self keyboardCaptureFilters: (self addFilter: anObject to: self keyboardCaptureFilters).!
Item was removed:
- ----- Method: Morph>>addLayoutMenuItems:hand: (in category 'layout-menu') -----
- addLayoutMenuItems: topMenu hand: aHand
- | aMenu |
- aMenu := MenuMorph new defaultTarget: self.
- aMenu addUpdating: #hasNoLayoutString action: #changeNoLayout.
- aMenu addUpdating: #hasProportionalLayoutString action: #changeProportionalLayout.
- aMenu addUpdating: #hasTableLayoutString action: #changeTableLayout.
- aMenu addLine.
- aMenu add: 'change layout inset...' translated action: #changeLayoutInset:.
- aMenu addLine.
- self addCellLayoutMenuItems: aMenu hand: aHand.
- self addTableLayoutMenuItems: aMenu hand: aHand.
- aMenu addLine.
- aMenu add: 'copy layout properties' translated action: #copyLayoutProperties.
- topMenu ifNotNil:[topMenu add: 'layout' translated subMenu: aMenu].
- ^aMenu!
Item was removed:
- ----- Method: Morph>>addMagicHaloFor: (in category 'halos and balloon help') -----
- addMagicHaloFor: aHand
-
- aHand halo ifNotNil: [:halo |
- halo target == self ifTrue:[^self].
- halo isMagicHalo ifFalse:[^self]].
-
- self createHalo
- popUpMagicallyFor: self hand: aHand!
Item was removed:
- ----- Method: Morph>>addMiscExtrasTo: (in category 'menus') -----
- addMiscExtrasTo: aMenu
- "Add a submenu of miscellaneous extra items to the menu."
-
- | realOwner realMorph subMenu |
- subMenu := MenuMorph new defaultTarget: self.
- (self isWorldMorph not and: [(self renderedMorph isSystemWindow) not])
- ifTrue: [subMenu add: 'put in a window' translated action: #embedInWindow].
-
- self isWorldMorph ifFalse:
- [subMenu add: 'adhere to edge...' translated action: #adhereToEdge.
- subMenu addLine].
-
- realOwner := (realMorph := self topRendererOrSelf) owner.
- (realOwner isKindOf: TextPlusPasteUpMorph) ifTrue:
- [subMenu add: 'GeeMail stuff...' translated subMenu: (realOwner textPlusMenuFor: realMorph)].
-
- subMenu
- add: 'add mouse up action' translated action: #addMouseUpAction;
- add: 'remove mouse up action' translated action: #removeMouseUpAction;
- add: 'hand me tiles to fire this button' translated action: #handMeTilesToFire.
- subMenu addLine.
- subMenu add: 'arrowheads on pen trails...' translated action: #setArrowheads.
- subMenu addLine.
-
- subMenu defaultTarget: self topRendererOrSelf.
- subMenu add: 'draw new path' translated action: #definePath.
- subMenu add: 'follow existing path' translated action: #followPath.
- subMenu add: 'delete existing path' translated action: #deletePath.
- subMenu addLine.
-
- self addGestureMenuItems: subMenu hand: self currentHand.
-
- aMenu add: 'extras...' translated subMenu: subMenu!
Item was removed:
- ----- Method: Morph>>addModelYellowButtonItemsTo:event: (in category 'menu') -----
- addModelYellowButtonItemsTo: aCustomMenu event: evt
- "Give my models a chance to add their context-menu items to
- aCustomMenu."
- self model
- ifNotNil: [:mod |
- mod
- addModelYellowButtonMenuItemsTo: aCustomMenu
- forMorph: self
- hand: evt hand]!
Item was removed:
- ----- Method: Morph>>addMorph: (in category 'submorphs - add/remove') -----
- addMorph: aMorph
-
- self addMorphFront: aMorph.!
Item was removed:
- ----- Method: Morph>>addMorph:after: (in category 'submorphs - add/remove') -----
- addMorph: newMorph after: aMorph
- ^self addMorph: newMorph behind: aMorph!
Item was removed:
- ----- Method: Morph>>addMorph:asElementNumber: (in category 'submorphs - add/remove') -----
- addMorph: aMorph asElementNumber: aNumber
-
- self flag: #deprecated.
- ^ self addMorph: aMorph atIndex: aNumber!
Item was removed:
- ----- Method: Morph>>addMorph:atIndex: (in category 'submorphs - add/remove') -----
- addMorph: aMorph atIndex: aNumber
- "Add the given morph so that it becomes the aNumber'th element of my submorph list. If aMorph is already one of my submorphs, reposition it."
-
- (submorphs includes: aMorph) ifTrue:
- [aMorph privateDelete].
- (aNumber <= submorphs size)
- ifTrue:
- [self addMorph: aMorph inFrontOf: (submorphs at: aNumber)]
- ifFalse:
- [self addMorphBack: aMorph].!
Item was removed:
- ----- Method: Morph>>addMorph:behind: (in category 'submorphs - add/remove') -----
- addMorph: newMorph behind: aMorph
- "Add a morph to the list of submorphs behind the specified morph"
- ^self privateAddMorph: newMorph atIndex: (submorphs indexOf: aMorph) + 1.
- !
Item was removed:
- ----- Method: Morph>>addMorph:fullFrame: (in category 'submorphs - misc') -----
- addMorph: aMorph fullFrame: aLayoutFrame
-
- aMorph layoutFrame: aLayoutFrame.
- aMorph hResizing: #spaceFill; vResizing: #spaceFill.
- self addMorph: aMorph.
-
- !
Item was removed:
- ----- Method: Morph>>addMorph:inFrontOf: (in category 'submorphs - add/remove') -----
- addMorph: newMorph inFrontOf: aMorph
- "Add a morph to the list of submorphs in front of the specified morph"
- ^self privateAddMorph: newMorph atIndex: ((submorphs indexOf: aMorph) max: 1).!
Item was removed:
- ----- Method: Morph>>addMorphBack: (in category 'submorphs - add/remove') -----
- addMorphBack: aMorph
- ^self privateAddMorph: aMorph atIndex: submorphs size+1!
Item was removed:
- ----- Method: Morph>>addMorphBackInLayer: (in category 'submorphs - layers') -----
- addMorphBackInLayer: aMorph
- "Note that we do not use #addMorph:, #addMorphBack:, #addMorphFront:, or any non-layer derivatives so that subclasses can safely overwrite those protocols and delegate to here."
-
- | targetLayer layerHere |
- targetLayer := aMorph morphicLayerNumber.
-
- submorphs "frontmost to backmost" withIndexDo: [ :each :index |
- layerHere := each morphicLayerNumber.
- "An indirect match (<) indicates the back of the target layer."
- targetLayer < layerHere ifTrue: [
- ^ self privateAddMorph: aMorph atIndex: index]].
-
- ^ self privateAddMorph: aMorph atIndex: submorphs size + 1
- !
Item was removed:
- ----- Method: Morph>>addMorphCentered: (in category 'submorphs - misc') -----
- addMorphCentered: aMorph
-
- aMorph position: bounds center - (aMorph extent // 2).
- self addMorphFront: aMorph.
- !
Item was removed:
- ----- Method: Morph>>addMorphFront: (in category 'submorphs - add/remove') -----
- addMorphFront: aMorph
- ^self privateAddMorph: aMorph atIndex: 1!
Item was removed:
- ----- Method: Morph>>addMorphFront:fromWorldPosition: (in category 'submorphs - misc') -----
- addMorphFront: aMorph fromWorldPosition: wp
-
- self addMorphFront: aMorph.
- aMorph position: (self transformFromWorld globalPointToLocal: wp)!
Item was removed:
- ----- Method: Morph>>addMorphFrontFromWorldPosition: (in category 'submorphs - misc') -----
- addMorphFrontFromWorldPosition: aMorph
- ^self addMorphFront: aMorph fromWorldPosition: aMorph positionInWorld.!
Item was removed:
- ----- Method: Morph>>addMorphFrontInLayer: (in category 'submorphs - layers') -----
- addMorphFrontInLayer: aMorph
- "Note that we do not use #addMorph:, #addMorphBack:, #addMorphFront:, or any non-layer derivatives so that subclasses can safely overwrite those protocols and delegate to here."
-
- | targetLayer layerHere |
- targetLayer := aMorph morphicLayerNumber.
-
- submorphs "frontmost to backmost" withIndexDo: [:each :index |
- layerHere := each morphicLayerNumber.
- "A direct match (=) indicates the front of the target layer."
- targetLayer <= layerHere ifTrue: [
- ^ self privateAddMorph: aMorph atIndex: index]].
-
- ^ self privateAddMorph: aMorph atIndex: submorphs size + 1!
Item was removed:
- ----- Method: Morph>>addMorphInLayer: (in category 'submorphs - layers') -----
- addMorphInLayer: aMorph
-
- ^ self addMorphBackInLayer: aMorph!
Item was removed:
- ----- Method: Morph>>addMorphNearBack: (in category 'submorphs - misc') -----
- addMorphNearBack: aMorph
- | bg |
- (submorphs notEmpty and: [submorphs last mustBeBackmost])
- ifTrue:
- [bg := submorphs last.
- bg privateDelete].
- self addMorphBack: aMorph.
- bg ifNotNil: [self addMorphBack: bg]!
Item was removed:
- ----- Method: Morph>>addMorphsTo:pianoRoll:eventTime:betweenTime:and: (in category '*Morphic-Sound-piano rolls') -----
- addMorphsTo: morphList pianoRoll: pianoRoll eventTime: t betweenTime: leftTime and: rightTime
-
- "a hack to allow for abitrary morphs to be dropped into piano roll"
- t > rightTime ifTrue: [^ self].
- t < leftTime ifTrue: [^ self].
- morphList add: (self left: (pianoRoll xForTime: t)).
- !
Item was removed:
- ----- Method: Morph>>addMouseActionIndicatorsWidth:color: (in category 'debug and other') -----
- addMouseActionIndicatorsWidth: anInteger color: aColor
-
- self deleteAnyMouseActionIndicators.
-
- self changed.
- self hasRolloverBorder: true.
- self setProperty: #rolloverWidth toValue: anInteger at anInteger.
- self setProperty: #rolloverColor toValue: aColor.
- self layoutChanged.
- self changed.
-
- !
Item was removed:
- ----- Method: Morph>>addMouseBubbleFilter: (in category 'events-filtering-bubbling') -----
- addMouseBubbleFilter: anObject
- self mouseBubbleFilters: (self addFilter: anObject to: self mouseBubbleFilters).!
Item was removed:
- ----- Method: Morph>>addMouseCaptureFilter: (in category 'events-filtering-capturing') -----
- addMouseCaptureFilter: anObject
- self mouseCaptureFilters: (self addFilter: anObject to: self mouseCaptureFilters).!
Item was removed:
- ----- Method: Morph>>addMouseUpAction (in category 'debug and other') -----
- addMouseUpAction
- | codeToRun oldCode |
- oldCode := self
- valueOfProperty: #mouseUpCodeToRun
- ifAbsent: [''].
- codeToRun := UIManager default request: 'MouseUp expression:' translated initialAnswer: oldCode.
- self addMouseUpActionWith: codeToRun!
Item was removed:
- ----- Method: Morph>>addMouseUpActionWith: (in category 'debug and other') -----
- addMouseUpActionWith: codeToRun
- ((codeToRun isMessageSend) not and: [codeToRun isEmptyOrNil])
- ifTrue: [^self].
- self setProperty: #mouseUpCodeToRun toValue: codeToRun.
- self
- on: #mouseUp
- send: #programmedMouseUp:for:
- to: self.
- self
- on: #mouseDown
- send: #programmedMouseDown:for:
- to: self.
- self
- on: #mouseEnter
- send: #programmedMouseEnter:for:
- to: self.
- self
- on: #mouseLeave
- send: #programmedMouseLeave:for:
- to: self!
Item was removed:
- ----- Method: Morph>>addMyYellowButtonMenuItemsToSubmorphMenus (in category 'menu') -----
- addMyYellowButtonMenuItemsToSubmorphMenus
- "Answer true if I have items to add to the context menus of my submorphs"
-
- ^true!
Item was removed:
- ----- Method: Morph>>addNestedYellowButtonItemsTo:event: (in category 'menu') -----
- addNestedYellowButtonItemsTo: aMenu event: evt
- "Add items to aMenu starting with me and proceeding down
- through my submorph chain,
- letting any submorphs that include the event position
- contribute their items to the bottom of the menu, separated by
- a line."
- | underMouse |
-
- self addYellowButtonMenuItemsTo: aMenu event: evt.
-
- underMouse := self
- submorphThat: [:each | each containsPoint: evt position]
- ifNone: [^ self].
-
- (underMouse addMyYellowButtonMenuItemsToSubmorphMenus
- and: [underMouse hasYellowButtonMenu])
- ifTrue: [| submenu |
- aMenu addLine.
- submenu := MenuMorph new defaultTarget: underMouse.
- underMouse addNestedYellowButtonItemsTo: submenu event: evt.
- aMenu
- add: underMouse externalName
- icon: (underMouse iconOrThumbnailOfSize: 16)
- subMenu: submenu
- ]
- !
Item was removed:
- ----- Method: Morph>>addOptionalHandlesTo:box: (in category 'halos and balloon help') -----
- addOptionalHandlesTo: aHalo box: box
- aHalo addDirectionHandles!
Item was removed:
- ----- Method: Morph>>addPaintingItemsTo:hand: (in category 'menus') -----
- addPaintingItemsTo: aMenu hand: aHandMorph
- | subMenu movies |
- subMenu := MenuMorph new defaultTarget: self.
- subMenu
- add: 'repaint' translated action: #editDrawing;
- add: 'set rotation center' translated action: #setRotationCenter;
- add: 'reset forward-direction' translated action: #resetForwardDirection;
- add: 'set rotation style' translated action: #setRotationStyle;
- add: 'erase pixels of color' translated action: #erasePixelsUsing:;
- add: 'recolor pixels of color' translated action: #recolorPixelsUsing:;
- add: 'reduce color palette' translated action: #reduceColorPalette:;
- add: 'detect edges' translated action: #edgeDetect;
- add: 'sharpen' translated action: #sharpen;
- add: 'blur' translated action: #blur;
- add: 'emboss' translated action: #emboss;
- add: 'add a border around this shape...' translated action: #addBorderToShape:.
- movies := (self world rootMorphsAt: aHandMorph targetPoint)
- 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!
Item was removed:
- ----- Method: Morph>>addSimpleHandlesTo:box: (in category 'halos and balloon help') -----
- addSimpleHandlesTo: aHaloMorph box: aBox
- ^ aHaloMorph addSimpleHandlesTo: aHaloMorph box: aBox!
Item was removed:
- ----- Method: Morph>>addStandardHaloMenuItemsTo:hand: (in category 'menus') -----
- addStandardHaloMenuItemsTo: aMenu hand: aHandMorph
- "Add standard halo items to the menu"
-
- | unlockables etoysLoaded |
-
- self isWorldMorph ifTrue:
- [^ self addWorldHaloMenuItemsTo: aMenu hand: aHandMorph].
-
- self mustBeBackmost ifFalse:
- [aMenu add: 'send to back' translated action: #goBehind.
- aMenu add: 'bring to front' translated action: #comeToFront.
- self addEmbeddingMenuItemsTo: aMenu hand: aHandMorph.
- aMenu addLine].
-
- self addFillStyleMenuItems: aMenu hand: aHandMorph.
- self addBorderStyleMenuItems: aMenu hand: aHandMorph.
- self addDropShadowMenuItems: aMenu hand: aHandMorph.
- self addLayoutMenuItems: aMenu hand: aHandMorph.
- self addHaloActionsTo: aMenu.
- owner isTextMorph ifTrue:[self addTextAnchorMenuItems: aMenu hand: aHandMorph].
- aMenu addLine.
- self addToggleItemsToHaloMenu: aMenu.
- aMenu addLine.
- self addCopyItemsTo: aMenu.
- etoysLoaded := Morph includesSelector: #addPlayerItemsTo:.
- etoysLoaded ifTrue: [self addPlayerItemsTo: aMenu].
- self addExportMenuItems: aMenu hand: aHandMorph.
- etoysLoaded ifTrue: [self addStackItemsTo: aMenu].
- self addMiscExtrasTo: aMenu.
- Preferences noviceMode ifFalse:
- [self addDebuggingItemsTo: aMenu hand: aHandMorph].
-
- aMenu addLine.
- aMenu defaultTarget: self.
-
- aMenu addLine.
-
- unlockables := self submorphs select:
- [:m | m isLocked].
- unlockables size = 1 ifTrue:
- [aMenu
- add: ('unlock "{1}"' translated format: unlockables first externalName)
- action: #unlockContents].
- unlockables size > 1 ifTrue:
- [aMenu add: 'unlock all contents' translated action: #unlockContents.
- aMenu add: 'unlock...' translated action: #unlockOneSubpart].
-
- aMenu defaultTarget: aHandMorph.
- !
Item was removed:
- ----- Method: Morph>>addTableLayoutMenuItems:hand: (in category 'layout-menu') -----
- addTableLayoutMenuItems: aMenu hand: aHand
- | menu sub |
- menu := MenuMorph new defaultTarget: self.
- menu addUpdating: #hasReverseCellsString action: #changeReverseCells.
- menu addUpdating: #hasClipLayoutCellsString action: #changeClipLayoutCells.
- menu addUpdating: #hasRubberBandCellsString action: #changeRubberBandCells.
- menu addLine.
- menu add: 'change cell gap...' translated action: #changeCellGap:.
- menu add: 'change cell inset...' translated action: #changeCellInset:.
- menu add: 'change min cell size...' translated action: #changeMinCellSize:.
- menu add: 'change max cell size...' translated action: #changeMaxCellSize:.
- menu addLine.
-
- sub := MenuMorph new defaultTarget: self.
- #(leftToRight rightToLeft topToBottom bottomToTop) do:[:sym|
- sub addUpdating: #listDirectionString: target: self selector: #changeListDirection: argumentList: (Array with: sym)].
- menu add: 'list direction' translated subMenu: sub.
-
- sub := MenuMorph new defaultTarget: self.
- #(none leftToRight rightToLeft topToBottom bottomToTop) do:[:sym|
- sub addUpdating: #wrapDirectionString: target: self selector: #wrapDirection: argumentList: (Array with: sym)].
- menu add: 'wrap direction' translated subMenu: sub.
-
- sub := MenuMorph new defaultTarget: self.
- #(center topLeft topRight bottomLeft bottomRight topCenter leftCenter rightCenter bottomCenter) do:[:sym|
- sub addUpdating: #cellPositioningString: target: self selector: #cellPositioning: argumentList: (Array with: sym)].
- menu add: 'cell positioning' translated subMenu: sub.
-
- sub := MenuMorph new defaultTarget: self.
- #(topLeft bottomRight center justified) do:[:sym|
- sub addUpdating: #listCenteringString: target: self selector: #listCentering: argumentList: (Array with: sym)].
- menu add: 'list centering' translated subMenu: sub.
-
- sub := MenuMorph new defaultTarget: self.
- #(topLeft bottomRight center justified) do:[:sym|
- sub addUpdating: #wrapCenteringString: target: self selector: #wrapCentering: argumentList: (Array with: sym)].
- menu add: 'wrap centering' translated subMenu: sub.
-
- sub := MenuMorph new defaultTarget: self.
- #(none equal) do:[:sym|
- sub addUpdating: #listSpacingString: target: self selector: #listSpacing: argumentList: (Array with: sym)].
- menu add: 'list spacing' translated subMenu: sub.
-
- sub := MenuMorph new defaultTarget: self.
- #(none localRect localSquare globalRect globalSquare) do:[:sym|
- sub addUpdating: #cellSpacingString: target: self selector: #cellSpacing: argumentList: (Array with: sym)].
- menu add: 'cell spacing' translated subMenu: sub.
-
- aMenu ifNotNil:[aMenu add: 'table layout' translated subMenu: menu].
- ^menu!
Item was removed:
- ----- Method: Morph>>addTextAnchorMenuItems:hand: (in category 'text-anchor') -----
- addTextAnchorMenuItems: topMenu hand: aHand
-
- ^ self textAnchorProperties
- addTextAnchorMenuItems: topMenu
- hand: aHand
- for: self!
Item was removed:
- ----- Method: Morph>>addTitleForHaloMenu: (in category 'menu') -----
- addTitleForHaloMenu: aMenu
- aMenu
- addTitle: self externalName
- icon: (self iconOrThumbnailOfSize: (Preferences tinyDisplay ifFalse:[28] ifTrue:[16]))!
Item was removed:
- ----- Method: Morph>>addToggleItemsToHaloMenu: (in category 'menus') -----
- addToggleItemsToHaloMenu: aMenu
- "Add standard true/false-checkbox items to the memu"
-
- #(
- (resistsRemovalString toggleResistsRemoval 'whether I should be reistant to easy deletion via the pink X handle' true)
- (stickinessString toggleStickiness 'whether I should be resistant to a drag done by mousing down on me' true)
- (lockedString lockUnlockMorph 'when "locked", I am inert to all user interactions' true)
- (hasClipSubmorphsString changeClipSubmorphs 'whether the parts of objects within me that are outside my bounds should be masked.' false)
- (hasDirectionHandlesString changeDirectionHandles 'whether direction handles are shown with the halo' false)
- (hasDragEnabledString changeDrag 'whether I am open to having objects dragged out of me' false)
- (hasDropEnabledString changeDrop 'whether I am open to having objects dropped into me' false)
- )
- select:[:each | Preferences noviceMode not or:[each fourth]]
- thenDo:
- [:each |
- aMenu addUpdating: each first action: each second.
- aMenu balloonTextForLastItem: each third translated].
-
- self couldHaveRoundedCorners ifTrue:
- [aMenu addUpdating: #roundedCornersString action: #toggleCornerRounding.
- aMenu balloonTextForLastItem: 'whether my corners should be rounded' translated]!
Item was removed:
- ----- Method: Morph>>addViewingItemsTo: (in category 'debug and other') -----
- addViewingItemsTo: aMenu
- "Add viewing-related items to the given menu. If any are added, this method is also responsible for adding a line after them"!
Item was removed:
- ----- Method: Morph>>addWorldHandlesTo:box: (in category 'halos and balloon help') -----
- addWorldHandlesTo: aHaloMorph box: box
- aHaloMorph haloBox: box.
- Preferences haloSpecificationsForWorld do:
- [:aSpec |
- aHaloMorph perform: aSpec addHandleSelector with: aSpec].
- aHaloMorph innerTarget addOptionalHandlesTo: aHaloMorph box: box!
Item was removed:
- ----- Method: Morph>>addWorldTargetSightingItems:hand: (in category 'menus') -----
- addWorldTargetSightingItems: aCustomMenu hand: aHandMorph
- "Use cursor to select a point on screen.
- Set target from all possible morphs under cursor sight."
-
- aCustomMenu addLine.
-
- aCustomMenu add: 'sight target' translated action: #sightWorldTargets:.
- !
Item was removed:
- ----- Method: Morph>>addYellowButtonMenuItemsTo:event: (in category 'menu') -----
- addYellowButtonMenuItemsTo: aMenu event: evt
- "Populate aMenu with appropriate menu items for a
- yellow-button (context menu) click."
- aMenu defaultTarget: self.
- ""
- Preferences noviceMode
- ifFalse: [aMenu addStayUpItem].
- ""
- self addModelYellowButtonItemsTo: aMenu event: evt.
- ""
- Preferences generalizedYellowButtonMenu
- ifFalse: [^ self].
- ""
- aMenu addLine.
- aMenu add: 'inspect' translated action: #inspect.
- ""
- aMenu addLine.
- self world selectedObject == self
- ifTrue: [aMenu add: 'deselect' translated action: #removeHalo]
- ifFalse: [aMenu add: 'select' translated action: #addHalo].
- ""
- (self isWorldMorph
- or: [self mustBeBackmost
- or: [self wantsToBeTopmost]])
- ifFalse: [""
- aMenu addLine.
- aMenu add: 'send to back' translated action: #goBehind.
- aMenu add: 'bring to front' translated action: #comeToFront.
- self addEmbeddingMenuItemsTo: aMenu hand: evt hand].
- ""
- self isWorldMorph
- ifFalse: [""
- Smalltalk
- at: #NCAAConnectorMorph
- ifPresent: [:connectorClass |
- aMenu addLine.
- aMenu add: 'connect to' translated action: #startWiring.
- aMenu addLine].
- ""
-
- self isFullOnScreen
- ifFalse: [aMenu add: 'move onscreen' translated action: #goHome]].
- ""
- Preferences noviceMode
- ifFalse: [""
- self addLayoutMenuItems: aMenu hand: evt hand.
- (owner notNil
- and: [owner isTextMorph])
- ifTrue: [self addTextAnchorMenuItems: aMenu hand: evt hand]].
- ""
- self isWorldMorph
- ifFalse: [""
- aMenu addLine.
- self addToggleItemsToHaloMenu: aMenu].
- ""
- aMenu addLine.
- self isWorldMorph
- ifFalse: [aMenu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:].
- self hasStrings ifTrue: [
- aMenu add: 'copy text' translated action: #clipText].
- ""
- self addExportMenuItems: aMenu hand: evt hand.
- ""
- (Preferences noviceMode not
- and: [self isWorldMorph not])
- ifTrue: [""
- aMenu addLine.
- aMenu add: 'adhere to edge...' translated action: #adhereToEdge].
- ""
- self addCustomMenuItems: aMenu hand: evt hand!
Item was removed:
- ----- Method: Morph>>addedMorph: (in category 'change reporting') -----
- addedMorph: aMorph
- "Notify the receiver that the given morph was just added."
- !
Item was removed:
- ----- Method: Morph>>adhereToEdge (in category 'menus') -----
- adhereToEdge
- | menu |
- menu := MenuMorph new defaultTarget: self.
- #(top right bottom left - center - topLeft topRight bottomRight bottomLeft - none)
- do: [:each |
- each == #-
- ifTrue: [menu addLine]
- ifFalse: [menu add: each asString translated selector: #setToAdhereToEdge: argument: each]].
- menu popUpEvent: self currentEvent in: self world!
Item was removed:
- ----- Method: Morph>>adhereToEdge: (in category 'menus') -----
- adhereToEdge: edgeSymbol
- | edgeMessage |
- (owner isNil or: [owner isHandMorph]) ifTrue: [^self].
- (owner class canUnderstand: edgeSymbol) ifFalse: [^self].
- (self class canUnderstand: ( edgeMessage := (edgeSymbol , ':') asSymbol ))
- ifFalse: [^self].
-
- self perform: edgeMessage
- withArguments: (Array with: (owner perform: edgeSymbol))!
Item was removed:
- ----- Method: Morph>>adjustLayoutBounds (in category 'layout') -----
- adjustLayoutBounds
- "Adjust the receivers bounds depending on the resizing strategy imposed"
-
- | hFit vFit box sbox myExtent myOrigin myBox |
- hFit := self hResizing.
- vFit := self vResizing.
- (hFit == #shrinkWrap or:[vFit == #shrinkWrap]) ifFalse:[^self]. "not needed"
-
- (self cellSpacing == #none and: [self listSpacing == #none]) ifFalse: [
- self flag: #todo. "mt: Find a way to make cell sizes accessible from here."
- self cellSpacing: #none; listSpacing: #none.
- self notify: 'It is not possible to shrink-wrap around submorphs when the layout policy reserves extra cell space. At this point, we have no access to that extra cell space and we do not know whether the submorph did make use of that extra space. So, shrink-wrapping could make the bounds very unstable.\\Please either reset #cellSpacing and #listSpacing - or change the resizing strategy to #rigid or #spaceFill.' withCRs.
- ^ self].
-
- box := self layoutBounds.
- sbox := self submorphBoundsForShrinkWrap outsetBy: self cellInset.
-
- myExtent := box extent.
- myOrigin := box origin.
- hFit == #shrinkWrap ifTrue:[
- myExtent := sbox extent x @ myExtent y.
- myOrigin := sbox origin x @ myOrigin y].
- vFit == #shrinkWrap ifTrue:[
- myExtent := myExtent x @ sbox extent y.
- myOrigin := myOrigin x @ sbox origin y].
- "Make sure we don't get smaller than minWidth/minHeight"
- myExtent x < self minWidth ifTrue:[
- myExtent := (myExtent x max:
- (self minWidth - self bounds width + self layoutBounds width)) @ myExtent y].
- myExtent y < self minHeight ifTrue:[
- myExtent := myExtent x @ (myExtent y max:
- (self minHeight - self bounds height + self layoutBounds height))].
-
- myBox := myOrigin extent: myExtent.
- self setLayoutBoundsFromLayout: myBox.!
Item was removed:
- ----- Method: Morph>>adjustedCenter (in category 'menus') -----
- adjustedCenter
- "Provides a hook for objects to provide a reference point other than the receiver's center,for the purpose of centering a submorph under special circumstances, such as BalloonMorph"
-
- ^ self center!
Item was removed:
- ----- Method: Morph>>adjustedCenter: (in category 'menus') -----
- adjustedCenter: c
- "Set the receiver's position based on the #adjustedCenter protocol for adhereToEdge. By default this simply sets the receiver's center. Though there are (at its inception anyway) no other implementors of this method, it is required in use with the #adhereToEdge when the centering of a submorph is to be with reference to a rectangle other than the receiver's center."
-
- self center: c!
Item was removed:
- ----- Method: Morph>>adoptPaneColor: (in category 'accessing') -----
- adoptPaneColor: paneColor
- self submorphsDo:[:m| m adoptPaneColor: paneColor].!
Item was removed:
- ----- Method: Morph>>alarmScheduler (in category 'events-alarms') -----
- alarmScheduler
- "Return the scheduler being responsible for triggering alarms"
- ^self world!
Item was removed:
- ----- Method: Morph>>align:with: (in category 'geometry - misc') -----
- align: aPoint1 with: aPoint2
- "Translate by aPoint2 - aPoint1."
-
- ^ self position: self position + (aPoint2 - aPoint1)!
Item was removed:
- ----- Method: Morph>>allKnownNames (in category 'submorphs - accessing') -----
- allKnownNames
- "Return a list of all known names based on the scope of the receiver. Does not include the name of the receiver itself. Items in parts bins are excluded. Reimplementors (q.v.) can extend the list"
-
- ^ Array streamContents:
- [:s | self allSubmorphNamesDo: [:n | s nextPut: n]]
- !
Item was removed:
- ----- Method: Morph>>allMenuWordings (in category 'menus') -----
- allMenuWordings
- | tempMenu |
- tempMenu := self buildHandleMenu: self currentHand.
- tempMenu allMorphsDo: [:m | m step]. "Get wordings current"
- ^ tempMenu allWordings!
Item was removed:
- ----- Method: Morph>>allMorphs (in category 'submorphs - accessing') -----
- allMorphs
- "Return a collection containing all morphs in this composite morph (including the receiver)."
-
- | all |
- all := OrderedCollection new: 100.
- self allMorphsDo: [: m | all add: m].
- ^ all!
Item was removed:
- ----- Method: Morph>>allMorphsAndBookPagesInto: (in category 'e-toy support') -----
- allMorphsAndBookPagesInto: aSet
- "Return a set of all submorphs. Don't forget the hidden ones like BookMorph pages that are not showing. Consider only objects that are in memory (see allNonSubmorphMorphs)."
-
- submorphs do: [:m | m allMorphsAndBookPagesInto: aSet].
- self allNonSubmorphMorphs do: [:m |
- (aSet includes: m) ifFalse: ["Stop infinite recursion"
- m allMorphsAndBookPagesInto: aSet]].
- aSet add: self.
- self player ifNotNil:
- [self player allScriptEditors do: [:e | e allMorphsAndBookPagesInto: aSet]].
- ^ aSet!
Item was removed:
- ----- Method: Morph>>allMorphsBreadthFirstDo: (in category 'submorphs - enumerating') -----
- allMorphsBreadthFirstDo: aBlock
-
- self
- allMorphsBreadthFirstDo: aBlock
- sorted: nil.!
Item was removed:
- ----- Method: Morph>>allMorphsBreadthFirstDo:sorted: (in category 'submorphs - enumerating') -----
- allMorphsBreadthFirstDo: aBlock sorted: aSortBlockOrNil
-
- | remaining |
- remaining := OrderedCollection with: self.
- [remaining notEmpty] whileTrue: [
- | next |
- next := remaining removeFirst.
- aBlock value: next.
- remaining addAll: (aSortBlockOrNil
- ifNil: [next submorphs "Avoid extra copy. See #sorted:."]
- ifNotNil: [next submorphs sorted: aSortBlockOrNil])].!
Item was removed:
- ----- Method: Morph>>allMorphsDepthFirstDo: (in category 'submorphs - enumerating') -----
- allMorphsDepthFirstDo: aBlock
- "Evaluate the given block for all morphs in this composite morph (including the receiver)."
-
- submorphs do: [:m | m allMorphsDepthFirstDo: aBlock].
- aBlock value: self!
Item was removed:
- ----- Method: Morph>>allMorphsDo: (in category 'submorphs - enumerating') -----
- allMorphsDo: aBlock
- "Evaluate the given block for all morphs in this composite morph (including the receiver)."
-
- self allMorphsDepthFirstDo: aBlock.!
Item was removed:
- ----- Method: Morph>>allMorphsWithPlayersDo: (in category 'submorphs - misc') -----
- 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>>allNonSubmorphMorphs (in category 'submorphs - misc') -----
- allNonSubmorphMorphs
- "Return a collection containing all morphs in this morph which are not currently in the submorph containment hierarchy (put in primarily for bookmorphs)"
-
- ^ OrderedCollection new!
Item was removed:
- ----- Method: Morph>>allOwners (in category 'structure') -----
- allOwners
- "Return the owners of the reciever"
-
- ^ Array streamContents: [:strm | self allOwnersDo: [:m | strm nextPut: m]]!
Item was removed:
- ----- Method: Morph>>allOwnersDo: (in category 'structure') -----
- allOwnersDo: aBlock
- "Evaluate aBlock with all owners of the receiver"
- owner ifNotNil:[^owner withAllOwnersDo: aBlock].!
Item was removed:
- ----- Method: Morph>>allStringsAfter: (in category 'debug and other') -----
- allStringsAfter: submorph
-
- ^ OrderedCollection streamContents: [:stream |
- self allStringsAfter: submorph do: [:string |
- stream nextPut: string]]!
Item was removed:
- ----- Method: Morph>>allStringsAfter:do: (in category 'debug and other') -----
- allStringsAfter: submorph do: aBlock
- "Evaluate aBlock for each text in any of my submorphs. If the specified submorph is non-nil, begin with that container."
-
- | ok |
- ok := submorph isNil.
- self allMorphsDo: [:sub | | string |
- ok ifFalse: [ok := sub == submorph].
- "and do this one too"
- ok ifTrue: [
- (string := sub userString)
- ifNotNil: [string isString
- ifTrue: [aBlock value: string]
- ifFalse: [string do: aBlock]]]].!
Item was removed:
- ----- Method: Morph>>allSubmorphNamesDo: (in category 'submorphs - enumerating') -----
- allSubmorphNamesDo: nameBlock
- "Return a list of all known names of submorphs and nested submorphs of the receiver, based on the scope of the receiver. Items in parts bins are excluded"
-
- self isPartsBin ifTrue: [^ self]. "Don't report names from parts bins"
- self submorphsDo:
- [:m | m knownName ifNotNil: [:n | nameBlock value: n].
- m allSubmorphNamesDo: nameBlock].
- !
Item was removed:
- ----- Method: Morph>>allowsGestureStart: (in category 'geniestubs') -----
- allowsGestureStart: evt
- ^false!
Item was removed:
- ----- Method: Morph>>altSpecialCursor0 (in category 'debug and other') -----
- altSpecialCursor0
- "an arrow"
- ^(Form
- extent: 16 at 16
- depth: 8
- fromArray: #( 0 0 0 0 14869218 3806520034 3806520034 3791650816 14848144 2425393296 2425393378 0 14848144 2425393296 2425414144 0 14848144 2425393296 2430730240 0 14848144 2425393296 3791650816 0 14848144 2425393378 3791650816 0 14848144 2425414370 3806461952 0 14848144 2430788322 3806519808 0 14848144 3791651042 3806520034 0 14848226 0 3806520034 3791650816 14868992 0 14869218 3806461952 14811136 0 58082 3806519808 0 0 226 3806520034 0 0 0 3806520034 0 0 0 14869218)
- offset: 0 at 0)
- !
Item was removed:
- ----- Method: Morph>>altSpecialCursor1 (in category 'debug and other') -----
- altSpecialCursor1
- "a star and an arrow"
- ^(Form
- extent: 31 at 26
- depth: 8
- fromArray: #( 14417920 0 0 0 0 0 0 0 3705461980 3705461980 3705405440 0 0 0 0 0 3705461980 3705461980 3705461760 0 0 0 0 0 14474460 3705461980 3705405440 0 0 0 0 0 56540 3705461980 3690987520 0 0 3690987520 0 0 220 3705461980 3705461760 0 0 3690987520 0 0 220 3705405440 3705461980 0 0 3705405440 0 0 0 3705461760 56540 3690987520 220 3705405440 0 0 0 3705405440 220 3705461760 220 3705405440 0 0 0 0 0 14474460 220 3705461760 0 0 0 0 0 56540 3691044060 3705461760 0 0 0 0 0 220 3705461980 3705461760 0 0 0 0 56540 3705461980 3705461980 3705461980 3705461980 3705461760 0 0 220 3705461980 3705461980 3705461980 3705461980 3705461760 0 0 0 3705461980 3705461980 3705461980 3705461980 3705405440 0 0 0 14474460 3705461980 3705461980 3705461980 3690987520 0 0 0 56540 3705461980 3705461980 3705461760 0 0 0 0 220 3705461980 3705461980 3705405440 0 0 0 0 0 3705461980 3705461980 3690987520 0 0 0 0 0 3705461980 3705461980 3705405440 0 0 0 0 220 3705461980 3705461980 3705405440 0 0 0 0 220 370546198
0 3705461980 3705405440 0 0 0 0 220 3705461980 14474460 3705405440 0 0 0 0 220 3705405440 220 3705461760 0 0 0 0 56540 3690987520 0 3705461760 0 0 0 0 56540 0 0 14474240 0)
- offset: 0 at 0)!
Item was removed:
- ----- Method: Morph>>altSpecialCursor2 (in category 'debug and other') -----
- altSpecialCursor2
- | f |
- "a blue box with transparent center"
- f := Form extent: 32 at 32 depth: 32.
- f offset: (f extent // 2) negated.
- f fill: f boundingBox rule: Form over fillColor: (Color blue alpha: 0.5).
- f fill: (f boundingBox insetBy: 4) rule: Form over fillColor: Color transparent.
- ^f
- !
Item was removed:
- ----- Method: Morph>>altSpecialCursor3 (in category 'debug and other') -----
- altSpecialCursor3
-
- ^self altSpecialCursor3: Color blue!
Item was removed:
- ----- Method: Morph>>altSpecialCursor3: (in category 'debug and other') -----
- altSpecialCursor3: aColor
- | f box |
- "a bulls-eye pattern in this color"
- f := Form extent: 32 at 32 depth: 32.
- f offset: (f extent // 2) negated.
- box := f boundingBox.
- [ box width > 0] whileTrue: [
- f fill: box rule: Form over fillColor: aColor.
- f fill: (box insetBy: 2) rule: Form over fillColor: Color transparent.
- box := box insetBy: 4.
- ].
- ^f
- !
Item was removed:
- ----- Method: Morph>>applyStatusToAllSiblings: (in category 'meta-actions') -----
- applyStatusToAllSiblings: evt
- "Apply the statuses of all my scripts to the script status of all my siblings"
-
- | aPlayer |
- (aPlayer := self topRendererOrSelf player) belongsToUniClass ifFalse: [self error: 'not uniclass'].
- aPlayer instantiatedUserScriptsDo:
- [:aScriptInstantiation | aScriptInstantiation assignStatusToAllSiblings]!
Item was removed:
- ----- Method: Morph>>applyUserInterfaceTheme (in category 'updating') -----
- applyUserInterfaceTheme
-
- "Re-initialize the shadow. Ensure shadow cache invalidation."
- self hasDropShadow ifTrue: [
- self addDropShadow.
- self removeProperty: #dropShadow.
- self changed].!
Item was removed:
- ----- Method: Morph>>areasRemainingToFill: (in category 'drawing') -----
- areasRemainingToFill: aRectangle
- "May be overridden by any subclasses with opaque regions"
-
- ^ Array with: aRectangle!
Item was removed:
- ----- Method: Morph>>arrangeToStartStepping (in category 'stepping and presenter') -----
- arrangeToStartStepping
- "Arrange to start getting sent the 'step' message, but don't do that initial #step call that startStepping does"
-
- self arrangeToStartSteppingIn: self world!
Item was removed:
- ----- Method: Morph>>arrangeToStartSteppingIn: (in category 'stepping and presenter') -----
- arrangeToStartSteppingIn: aWorld
- "Start getting sent the 'step' message in aWorld. Like startSteppingIn:, but without the initial one to get started'"
- aWorld ifNotNil:
- [aWorld startStepping: self.
- self changed]!
Item was removed:
- ----- Method: Morph>>asMorph (in category 'creation') -----
- asMorph
- ^ self!
Item was removed:
- ----- Method: Morph>>asNumber: (in category 'e-toy support') -----
- asNumber: aPointOrNumber
- "Support for e-toy demo."
-
- aPointOrNumber class = Point
- ifTrue: [^ aPointOrNumber r]
- ifFalse: [^ aPointOrNumber].
- !
Item was removed:
- ----- Method: Morph>>asPostscript (in category '*morphic-Postscript Canvases') -----
- asPostscript
- ^self asEPS.
- !
Item was removed:
- ----- Method: Morph>>asSnapshotThumbnail (in category 'converting') -----
- asSnapshotThumbnail
- ^(ThumbnailImageMorph new newImage: self imageForm ) extent: 90 asPoint .!
Item was removed:
- ----- Method: Morph>>asTextAnchor (in category 'text-anchor') -----
- asTextAnchor
- "Convert the receiver to be embedded in text."
-
- ^ TextAnchor new anchoredMorph: self!
Item was removed:
- ----- Method: Morph>>assureExtension (in category 'accessing - extension') -----
- assureExtension
- "creates an extension for the receiver if needed"
- extension ifNil: [self initializeExtension].
- ^ extension!
Item was removed:
- ----- Method: Morph>>assureExternalName (in category 'player') -----
- assureExternalName
- | aName |
- ^ (aName := self knownName) ifNil:
- [self setNameTo: (aName := self externalName).
- ^ aName]!
Item was removed:
- ----- Method: Morph>>assureFlexShell (in category 'rotate scale and flex') -----
- assureFlexShell
- "Canonical assure message when working with flex shells."
-
- ^ self addFlexShellIfNecessary!
Item was removed:
- ----- Method: Morph>>assureGridLayoutProperties (in category 'layout properties') -----
- assureGridLayoutProperties
-
- | assuredProperties |
- self layoutProperties
- ifNil: [
- self layoutProperties: (assuredProperties := GridLayoutProperties new initializeFrom: self)]
- ifNotNil: [:existingProperties |
- existingProperties includesGridLayoutProperties
- ifTrue: [assuredProperties := existingProperties]
- ifFalse: [self layoutProperties: (assuredProperties := existingProperties asGridLayoutProperties)]].
- ^ assuredProperties!
Item was removed:
- ----- Method: Morph>>assureLayoutProperties (in category 'layout properties') -----
- assureLayoutProperties
- | props |
- props := self layoutProperties.
- props == self ifTrue:[props := nil].
- props ifNil:[
- props := LayoutProperties new initializeFrom: self.
- self layoutProperties: props].
- ^props!
Item was removed:
- ----- Method: Morph>>assureTableLayoutProperties (in category 'layout properties') -----
- assureTableLayoutProperties
-
- | assuredProperties |
- self layoutProperties
- ifNil: [
- self layoutProperties: (assuredProperties := TableLayoutProperties new initializeFrom: self)]
- ifNotNil: [:existingProperties |
- existingProperties includesTableLayoutProperties
- ifTrue: [assuredProperties := existingProperties]
- ifFalse: [self layoutProperties: (assuredProperties := existingProperties asTableLayoutProperties)]].
- ^ assuredProperties!
Item was removed:
- ----- Method: Morph>>attachToResource (in category 'fileIn/out') -----
- attachToResource
- "Connect a file -- either a saved .morph file or a graphics file as my resource.
- There appears to be nothing preventing a user from attaching a completely unrelated file ?"
-
- | pathName |
- pathName := UIManager default chooseFileMatchingSuffixes: (Form allTypicalFileExtensions add: 'morph'; yourself) label: 'Choose a file to load' translated.
- pathName ifNil: [^ self]. "User made no choice"
-
- self setProperty: #resourceFilePath toValue: pathName!
Item was removed:
- ----- Method: Morph>>automaticViewing (in category 'e-toy support') -----
- automaticViewing
- "Backstop, in case this message gets sent to an owner that is not a playfield"
- ^ false!
Item was removed:
- ----- Method: Morph>>balloonColor (in category 'halos and balloon help') -----
- balloonColor
- ^ self
- valueOfProperty: #balloonColor
- ifAbsent: [self defaultBalloonColor]!
Item was removed:
- ----- Method: Morph>>balloonColor: (in category 'halos and balloon help') -----
- balloonColor: aColor
- ^ self
- setProperty: #balloonColor
- toValue: aColor!
Item was removed:
- ----- Method: Morph>>balloonFont (in category 'halos and balloon help') -----
- balloonFont
- ^ self
- valueOfProperty: #balloonFont
- ifAbsent: [self defaultBalloonFont]!
Item was removed:
- ----- Method: Morph>>balloonFont: (in category 'halos and balloon help') -----
- balloonFont: aFont
- ^ self setProperty: #balloonFont toValue: aFont!
Item was removed:
- ----- Method: Morph>>balloonHelpAligner (in category 'halos and balloon help') -----
- balloonHelpAligner
- "Answer the morph to which the receiver's balloon help should point"
- ^ (self valueOfProperty: #balloonTarget) ifNil: [self]!
Item was removed:
- ----- Method: Morph>>balloonHelpDelayTime (in category 'halos and balloon help') -----
- balloonHelpDelayTime
- "Return the number of milliseconds before a balloon help should be put up on the receiver. The balloon help will only be put up if the receiver responds to #wantsBalloon by returning true."
- ^ Preferences balloonHelpDelayTime!
Item was removed:
- ----- Method: Morph>>balloonHelpTextForHandle: (in category 'halos and balloon help') -----
- balloonHelpTextForHandle: aHandle
- "Answer a string providing balloon help for the
- given halo handle"
- | itsSelector |
- itsSelector := aHandle eventHandler firstMouseSelector.
- itsSelector == #doRecolor:with:
- ifTrue: [^ Preferences propertySheetFromHalo
- ifTrue: ['Open a property sheet.']
- ifFalse: ['Change color']].
- itsSelector == #mouseDownInDimissHandle:with:
- ifTrue: [^ TrashCanMorph preserveTrash
- ifTrue: ['Move to trash']
- ifFalse: ['Remove from screen']].
- #(#(#addFullHandles 'More halo handles') #(#addSimpleHandles 'Fewer halo handles') #(#chooseEmphasisOrAlignment 'Emphasis & alignment') #(#chooseFont 'Change font') #(#chooseNewGraphicFromHalo 'Choose a new graphic') #(#chooseStyle 'Change style') #(#dismiss 'Remove') #(#doDebug:with: 'Debug') #(#doDirection:with: 'Choose forward direction') #(#doDup:with: 'Duplicate') #(#doMakeSibling:with: 'Make a sibling') #(#doMenu:with: 'Menu') #(#doGrab:with: 'Pick up') #(#editButtonsScript 'See the script for this button') #(#editDrawing 'Repaint') #(#doDupOrMakeSibling:with: 'Duplicate (press shift to make a sibling)') #(#doMakeSiblingOrDup:with: 'Make a sibling (press shift to make simple duplicate)') #(#makeNascentScript 'Make a scratch script') #(#makeNewDrawingWithin 'Paint new object') #(#mouseDownInCollapseHandle:with: 'Collapse') #(#mouseDownOnHelpHandle: 'Help') #(#openViewerForArgument 'Open a Viewer for me. Press shift for a snapshot.') #(#openViewerForTarget:with: 'Open a Viewer
for me. Press shift for a snapshot.') #(#paintBackground 'Paint background') #(#prepareToTrackCenterOfRotation:with: 'Move object or set center of rotation') #(#presentViewMenu 'Present the Viewing menu') #(#startDrag:with: 'Move') #(#startGrow:with: 'Change size (Ctrl + drag blue button)') #(#startRot:with: 'Rotate') #(#startScale:with: 'Change scale') #(#tearOffTile 'Make a tile representing this object') #(#tearOffTileForTarget:with: 'Make a tile representing this object') #(#trackCenterOfRotation:with: 'Set center of rotation') )
- do: [:pair | itsSelector == pair first
- ifTrue: [^ pair last]].
- ^ 'unknown halo handle'translated!
Item was removed:
- ----- Method: Morph>>balloonMorphClass (in category 'halos and balloon help') -----
- balloonMorphClass
-
- ^ NewBalloonMorph useNewBalloonMorph
- ifTrue: [NewBalloonMorph]
- ifFalse: [BalloonMorph]!
Item was removed:
- ----- Method: Morph>>balloonText (in category 'accessing') -----
- balloonText
- "Answer balloon help text or nil, if no help is available."
- "NB: subclasses may override such that they programatically construct the text, for economy's sake, such as model phrases in a Viewer."
-
- | balloonSelector |
- extension ifNil: [^ nil].
-
- extension balloonText
- ifNotNil: [:balloonText | ^ balloonText].
- balloonSelector := extension balloonTextSelector
- ifNil: [^ nil].
- (ScriptingSystem helpStringOrNilFor: balloonSelector)
- ifNotNil: [:result | ^ result].
- balloonSelector == #methodComment
- ifTrue: [^ self methodCommentAsBalloonHelp].
- balloonSelector isUnary
- ifTrue: [
- (self respondsTo: balloonSelector)
- ifTrue: [^ self perform: balloonSelector].
- (self model respondsTo: balloonSelector)
- ifTrue: [^ self model perform: balloonSelector]].
- ^ nil!
Item was removed:
- ----- Method: Morph>>balloonText: (in category 'accessing') -----
- balloonText: aString
-
- self assureExtension balloonText: aString.!
Item was removed:
- ----- Method: Morph>>balloonTextSelector (in category 'accessing') -----
- balloonTextSelector
- "Answer balloon text selector item in the extension, nil if none"
- ^ extension ifNotNil: [extension balloonTextSelector]!
Item was removed:
- ----- Method: Morph>>balloonTextSelector: (in category 'accessing') -----
- balloonTextSelector: aSelector
- "change the receiver's balloonTextSelector"
- self assureExtension balloonTextSelector: aSelector!
Item was removed:
- ----- Method: Morph>>basicInitialize (in category 'initialization') -----
- basicInitialize
- "Do basic generic initialization of the instance variables:
- Set up the receiver, created by a #basicNew and now ready to
- be initialized, by placing initial values in the instance variables
- as appropriate"
- owner := nil.
- submorphs := Array empty.
- bounds := self defaultBounds.
- color := self defaultColor!
Item was removed:
- ----- Method: Morph>>beFlap: (in category 'accessing') -----
- beFlap: aBool
- "Mark the receiver with the #flap property, or unmark it"
-
- aBool
- ifTrue:
- [self setProperty: #flap toValue: true.
- self disableLayout: true.
- self hResizing: #rigid.
- self vResizing: #rigid.
- self morphicLayerNumber: self class navigatorLayer]
- ifFalse:
- [self removeProperty: #flap.
- self disableLayout: false.
- self morphicLayerNumber: nil]!
Item was removed:
- ----- Method: Morph>>beSticky (in category 'accessing') -----
- beSticky
- "make the receiver sticky"
- self assureExtension sticky: true!
Item was removed:
- ----- Method: Morph>>beThisWorldsModel (in category 'meta-actions') -----
- beThisWorldsModel
-
- self world setModel: self.
- self model: nil slotName: nil. "A world's model cannot have another model"!
Item was removed:
- ----- Method: Morph>>beTransparent (in category 'accessing') -----
- beTransparent
- self color: Color transparent!
Item was removed:
- ----- Method: Morph>>beUnsticky (in category 'accessing') -----
- beUnsticky
- "If the receiver is marked as sticky, make it now be unsticky"
- extension ifNotNil: [extension sticky: false]!
Item was removed:
- ----- Method: Morph>>borderColor (in category 'accessing') -----
- borderColor
- ^self borderStyle color!
Item was removed:
- ----- Method: Morph>>borderColor: (in category 'accessing') -----
- borderColor: aColorOrSymbolOrNil
-
- self flag: #compatibility. "mt: For old code. Should be removed in the future."
- aColorOrSymbolOrNil
- ifNil: [self borderStyle: nil]
- ifNotNil: [:colorOrSymbol |
- colorOrSymbol isSymbol ifTrue: [
- ^ self borderStyle: ((self borderStyleForSymbol: colorOrSymbol)
- width: self borderStyle width;
- baseColor: self borderStyle baseColor;
- trackColorFrom: self;
- yourself)]].
-
- "Ensure a style object that can remember width and color."
- self borderStyle style = #none
- ifTrue: [self borderStyle: BorderStyle simple].
-
- "Set the color of the current border style."
- self borderStyle
- baseColor: aColorOrSymbolOrNil;
- trackColorFrom: self.
-
- self changed.!
Item was removed:
- ----- Method: Morph>>borderStyle (in category 'accessing') -----
- borderStyle
- ^ self valueOfProperty: #borderStyle ifAbsentPut: [BorderStyle default]!
Item was removed:
- ----- Method: Morph>>borderStyle: (in category 'accessing') -----
- borderStyle: aBorderStyle
-
- aBorderStyle = self borderStyle ifTrue: [^ self].
-
- "If we cannot draw the new border, accept at least its color and width."
- ((self canDrawBorder: aBorderStyle) or: [aBorderStyle isNil])
- ifTrue: [self setProperty: #borderStyle toValue: aBorderStyle]
- ifFalse: [
- self borderStyle
- width: aBorderStyle width;
- baseColor: aBorderStyle baseColor].
-
- self borderStyle trackColorFrom: self.
-
- self
- layoutChanged;
- changed.!
Item was removed:
- ----- Method: Morph>>borderStyleForSymbol: (in category 'accessing') -----
- borderStyleForSymbol: aStyleSymbol
- "Answer a suitable BorderStyle for me of the type represented by a given symbol"
-
- ^ (BorderStyle borderStyleForSymbol: aStyleSymbol asSymbol)
- ifNotNil: [:style | | existing |
- existing := self borderStyle.
- style
- width: existing width;
- baseColor: existing baseColor;
- trackColorFrom: self;
- yourself]!
Item was removed:
- ----- Method: Morph>>borderWidth (in category 'accessing') -----
- borderWidth
- ^self borderStyle width!
Item was removed:
- ----- Method: Morph>>borderWidth: (in category 'accessing') -----
- borderWidth: aNumber
- "Sets the width of the border in the current border style. If there is no border yet, set up a simple one so that the user can actually see the border width."
-
- self borderStyle width = aNumber ifTrue: [^ self].
-
- self borderStyle style = #none
- ifTrue: [^ self borderStyle: (BorderStyle simple width: aNumber; yourself)].
-
- self borderStyle width: aNumber.
- self layoutChanged; changed.!
Item was removed:
- ----- Method: Morph>>borderWidthForRounding (in category 'accessing') -----
- borderWidthForRounding
-
- ^ self borderWidth!
Item was removed:
- ----- Method: Morph>>bottom (in category 'geometry') -----
- bottom
- " Return the y-coordinate of my bottom side "
-
- ^ bounds bottom!
Item was removed:
- ----- Method: Morph>>bottom: (in category 'geometry') -----
- bottom: aNumber
- " Move me so that my bottom is at the y-coordinate aNumber. My extent (width & height) are unchanged "
-
- self position: (bounds left @ (aNumber - self height))!
Item was removed:
- ----- Method: Morph>>bottomCenter (in category 'geometry') -----
- bottomCenter
-
- ^ bounds bottomCenter!
Item was removed:
- ----- Method: Morph>>bottomLeft (in category 'geometry') -----
- bottomLeft
-
- ^ bounds bottomLeft!
Item was removed:
- ----- Method: Morph>>bottomLeft: (in category 'geometry') -----
- bottomLeft: aPoint
- " Move me so that my bottom left corner is at aPoint. My extent (width & height) are unchanged "
-
- self position: ((aPoint x) @ (aPoint y - self height)).
- !
Item was removed:
- ----- Method: Morph>>bottomRight (in category 'geometry') -----
- bottomRight
-
- ^ bounds bottomRight!
Item was removed:
- ----- Method: Morph>>bottomRight: (in category 'geometry') -----
- bottomRight: aPoint
- " Move me so that my bottom right corner is at aPoint. My extent (width & height) are unchanged "
-
- self position: ((aPoint x - bounds width) @ (aPoint y - self height))
- !
Item was removed:
- ----- Method: Morph>>boundingBoxOfSubmorphs (in category 'drawing') -----
- boundingBoxOfSubmorphs
- | aBox |
- aBox := bounds origin extent: self minimumExtent. "so won't end up with something empty"
- submorphs do:
- [:m | m visible ifTrue: [aBox := aBox quickMerge: m fullBounds]].
- ^ aBox
- !
Item was removed:
- ----- Method: Morph>>bounds (in category 'geometry') -----
- bounds
- "Return the bounds of this morph."
- "Note: It is best not to override this method because many methods in Morph and its subclasses use the instance variable directly rather than 'self bounds'. Instead, subclasses should be sure that the bounds instance variable is correct."
-
- ^ bounds
- !
Item was removed:
- ----- Method: Morph>>bounds: (in category 'geometry') -----
- bounds: newBounds
- | oldExtent newExtent |
- oldExtent := self extent.
- newExtent := newBounds extent.
- (oldExtent dotProduct: oldExtent) <= (newExtent dotProduct: newExtent) ifTrue:[
- "We're growing. First move then resize."
- self position: newBounds topLeft; extent: newExtent.
- ] ifFalse:[
- "We're shrinking. First resize then move."
- self extent: newExtent; position: newBounds topLeft.
- ].!
Item was removed:
- ----- Method: Morph>>bounds:from: (in category 'geometry - local/global') -----
- bounds: aRectangle from: referenceMorph
- "Return the receiver's bounds as seen by aMorphs coordinate frame"
- owner ifNil: [^ aRectangle].
- ^(owner transformFrom: referenceMorph) globalBoundsToLocal: aRectangle
- !
Item was removed:
- ----- Method: Morph>>bounds:in: (in category 'geometry - local/global') -----
- bounds: aRectangle in: referenceMorph
- "Return the receiver's bounds as seen by aMorphs coordinate frame"
- owner ifNil: [^ aRectangle].
- ^(owner transformFrom: referenceMorph) localBoundsToGlobal: aRectangle
- !
Item was removed:
- ----- Method: Morph>>boundsForBalloon (in category 'halos and balloon help') -----
- boundsForBalloon
-
- "some morphs have bounds that are way too big"
- ^self boundsInWorld!
Item was removed:
- ----- Method: Morph>>boundsIn: (in category 'geometry - local/global') -----
- boundsIn: referenceMorph
- "Return the receiver's bounds as seen by aMorphs coordinate frame"
- ^self bounds: self bounds in: referenceMorph!
Item was removed:
- ----- Method: Morph>>boundsInWorld (in category 'geometry - local/global') -----
- boundsInWorld
- ^self bounds: self bounds in: self world!
Item was removed:
- ----- Method: Morph>>boundsWithinCorners (in category 'drawing') -----
- boundsWithinCorners
- "Return a single sub-rectangle that lies entirely inside corners
- that are made by me.
- Used to identify large regions of window that do not need to be redrawn."
-
- ^ self wantsRoundedCorners
- ifTrue: [self bounds insetBy: 0 at self cornerRadius]
- ifFalse: [self bounds]
- !
Item was removed:
- ----- Method: Morph>>bringAllSiblingsToMe: (in category 'meta-actions') -----
- bringAllSiblingsToMe: evt
- "bring all siblings of the receiver's player found in the same container to the receiver's location."
-
- | aPlayer aPosition aContainer |
- (aPlayer := self topRendererOrSelf player) belongsToUniClass ifFalse: [self error: 'not uniclass'].
- aPosition := self topRendererOrSelf position.
- aContainer := self topRendererOrSelf owner.
- (aPlayer class allInstances copyWithout: aPlayer) do:
- [:each |
- (aContainer submorphs includes: each costume) ifTrue:
- [each costume position: aPosition]]!
Item was removed:
- ----- Method: Morph>>buildDebugMenu: (in category 'debug and other') -----
- buildDebugMenu: aHand
- "Answer a debugging menu for the receiver. The hand argument is seemingly historical and plays no role presently"
-
- | aMenu aPlayer |
- aMenu := MenuMorph new defaultTarget: self.
- aMenu addStayUpItem.
- (self hasProperty: #errorOnDraw) ifTrue:
- [aMenu add: 'start drawing again' translated action: #resumeAfterDrawError.
- aMenu addLine].
- (self hasProperty: #errorOnStep) ifTrue:
- [aMenu add: 'start stepping again' translated action: #resumeAfterStepError.
- aMenu addLine].
- (self hasProperty: #errorOnLayout) ifTrue:
- [aMenu add: 'start layouting again' translated action: #resumeAfterLayoutError.
- aMenu addLine].
-
- aMenu add: 'inspect morph' translated action: #inspectInMorphic:.
- aMenu add: 'inspect owner chain' translated action: #inspectOwnerChain.
- Smalltalk isMorphic ifFalse:
- [aMenu add: 'inspect morph (in MVC)' translated action: #inspect].
-
- self isMorphicModel ifTrue:
- [aMenu add: 'inspect model' translated target: self model action: #inspect;
- add: 'explore model' translated target: self model action: #explore].
- (aPlayer := self player) ifNotNil:
- [aMenu add: 'inspect player' translated target: aPlayer action: #inspect].
-
- aMenu add: 'explore morph' translated target: self selector: #exploreInMorphic:.
-
- aMenu addLine.
- aPlayer ifNotNil:
- [ aMenu add: 'viewer for Player' translated target: self player action: #beViewed.
- aMenu balloonTextForLastItem: 'Opens a viewer on my Player -- this is the same thing you get if you click on the cyan "View" halo handle' translated ].
-
- aMenu add: 'viewer for Morph' translated target: self action: #viewMorphDirectly.
- aMenu balloonTextForLastItem: 'Opens a Viewer on this Morph, rather than on its Player' translated.
- aMenu addLine.
-
- aPlayer ifNotNil:
- [aPlayer class isUniClass ifTrue: [
- aMenu add: 'browse player class' translated target: aPlayer selector: #haveFullProtocolBrowsedShowingSelector: argumentList: #(nil)]].
- aMenu add: 'browse morph class' translated target: self selector: #browseHierarchy.
- (self isMorphicModel)
- ifTrue: [aMenu
- add: 'browse model class'
- target: self model
- selector: #browseHierarchy].
- aMenu addLine.
-
- self addViewingItemsTo: aMenu.
- aMenu
- add: 'make own subclass' translated action: #subclassMorph;
- add: 'save morph in file' translated action: #saveOnFile;
- addLine;
- add: 'call #tempCommand' translated action: #tempCommand;
- add: 'define #tempCommand' translated action: #defineTempCommand;
- addLine;
-
- add: 'control-menu...' translated target: self selector: #invokeMetaMenu:;
- add: 'edit balloon help' translated action: #editBalloonHelpText.
-
- ^ aMenu!
Item was removed:
- ----- Method: Morph>>buildHandleMenu: (in category 'meta-actions') -----
- buildHandleMenu: aHand
- "Build the morph menu for the given morph's halo's menu handle. This menu has two sections. The first section contains commands that are interpreted by the hand; the second contains commands provided by the target morph. This method allows the morph to decide which items should be included in the hand's section of the menu."
-
- | menu |
-
- (Preferences generalizedYellowButtonMenu
- and: [Preferences noviceMode])
- ifTrue: [^ self buildYellowButtonMenu: aHand].
-
- menu := MenuMorph new defaultTarget: self.
- menu addStayUpItem.
- menu addLine.
- self addStandardHaloMenuItemsTo: menu hand: aHand.
- menu defaultTarget: aHand.
- self addAddHandMenuItemsForHalo: menu hand: aHand.
- menu defaultTarget: self.
- self addCustomHaloMenuItems: menu hand: aHand.
- menu defaultTarget: aHand.
- ^ menu
- !
Item was removed:
- ----- Method: Morph>>buildMetaMenu: (in category 'meta-actions') -----
- buildMetaMenu: evt
- "Build the morph menu. This menu has two sections. The first section contains commands that are handled by the hand; the second contains commands handled by the argument morph."
- | menu |
- menu := MenuMorph new defaultTarget: self.
- menu addStayUpItem.
- menu add: 'grab' translated action: #grabMorph:.
- menu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:.
- self maybeAddCollapseItemTo: menu.
- menu add: 'delete' translated action: #dismissMorph:.
- menu addLine.
- menu add: 'copy text' translated action: #clipText.
- menu add: 'copy Postscript' translated action: #clipPostscript.
- menu add: 'print Postscript to file...' translated action: #printPSToFile.
- menu addLine.
- menu add: 'go behind' translated action: #goBehind.
- menu add: 'add halo' translated action: #addHalo:.
- menu add: 'duplicate' translated action: #maybeDuplicateMorph:.
-
- self addEmbeddingMenuItemsTo: menu hand: evt hand.
-
- menu add: 'resize' translated action: #resizeMorph:.
- "Give the argument control over what should be done about fill styles"
- self addFillStyleMenuItems: menu hand: evt hand.
- self addDropShadowMenuItems: menu hand: evt hand.
- self addLayoutMenuItems: menu hand: evt hand.
- menu addUpdating: #hasClipSubmorphsString target: self selector: #changeClipSubmorphs argumentList: #().
- menu addLine.
-
- (self morphsAt: evt position) size > 1 ifTrue:
- [menu add: 'submorphs...' translated
- target: self
- selector: #invokeMetaMenuAt:event:
- argument: evt position].
- menu addLine.
- menu add: 'inspect' translated selector: #inspectAt:event: argument: evt position.
- menu add: 'explore' translated action: #explore.
- menu add: 'browse hierarchy' translated action: #browseHierarchy.
- menu add: 'make own subclass' translated action: #subclassMorph.
- menu addLine.
- (self isMorphicModel) ifTrue:
- [menu add: 'save morph as prototype' translated action: #saveAsPrototype.
- (self ~~ self world modelOrNil) ifTrue:
- [menu add: 'become this world''s model' translated action: #beThisWorldsModel]].
- menu add: 'save morph in file' translated action: #saveOnFile.
- (self hasProperty: #resourceFilePath)
- ifTrue: [((self valueOfProperty: #resourceFilePath) endsWith: '.morph')
- ifTrue: [menu add: 'save as resource' translated action: #saveAsResource].
- menu add: 'update from resource' translated action: #updateFromResource]
- ifFalse: [menu add: 'attach to resource' translated action: #attachToResource].
- menu add: 'show actions' translated action: #showActions.
- menu addLine.
- self addDebuggingItemsTo: menu hand: evt hand.
-
- self addCustomMenuItems: menu hand: evt hand.
- ^ menu
- !
Item was removed:
- ----- Method: Morph>>buildYellowButtonMenu: (in category 'menu') -----
- buildYellowButtonMenu: aHand
- "Build the morph menu for the yellow button."
-
- | menu |
- menu := MenuMorph new defaultTarget: self.
- self addNestedYellowButtonItemsTo: menu event: self currentEvent.
- MenuIcons decorateMenu: menu.
- ^ menu!
Item was removed:
- ----- Method: Morph>>canApplyUserInterfaceTheme (in category 'visual properties') -----
- canApplyUserInterfaceTheme
- ^ self isInWorld and: [(self hasProperty: #noUserInterfaceTheme) not]!
Item was removed:
- ----- Method: Morph>>canBeEncroached (in category 'private') -----
- canBeEncroached
- "Support for the #smartHorizontalSplitters preference."
- ^ true!
Item was removed:
- ----- Method: Morph>>canDrawAtHigherResolution (in category 'testing') -----
- canDrawAtHigherResolution
-
- ^false!
Item was removed:
- ----- Method: Morph>>canDrawBorder: (in category 'testing') -----
- canDrawBorder: aBorderStyle
- "Return true if the receiver can be drawn with the given border style."
- ^true!
Item was removed:
- ----- Method: Morph>>canHaveFillStyles (in category 'visual properties') -----
- canHaveFillStyles
- "Return true if the receiver can have general fill styles; not just colors.
- This method is for gradually converting old morphs."
- ^self class == Morph "no subclasses"!
Item was removed:
- ----- Method: Morph>>cellGap (in category 'layout properties - table') -----
- cellGap
- "Layout specific. This property specifies an extra space *between* cells in the layout."
- | props |
- props := self layoutProperties.
- ^props ifNil:[0] ifNotNil:[props cellGap].!
Item was removed:
- ----- Method: Morph>>cellGap: (in category 'layout properties - table') -----
- cellGap: aNumber
- "Layout specific. This property specifies an extra space *between* cells in the layout."
- self assureTableLayoutProperties cellGap: aNumber.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>cellInset (in category 'layout properties - table') -----
- cellInset
- "Layout specific. This property specifies an extra inset for each cell in the layout."
- | props |
- props := self layoutProperties.
- ^props ifNil:[0] ifNotNil:[props cellInset].!
Item was removed:
- ----- Method: Morph>>cellInset: (in category 'layout properties - table') -----
- cellInset: aNumber
- "Layout specific. This property specifies an extra inset for each cell in the layout."
- self assureTableLayoutProperties cellInset: aNumber.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>cellPositioning (in category 'layout properties - table') -----
- cellPositioning
- "Layout specific. This property describes how the receiver should be layed out in its owner when the bounds of the cell assigned to the receiver do not exactly match its bounds. Possible values are:
- #topLeft, #topRight, #bottomLeft, #bottomRight, #topCenter, #leftCenter, #rightCenter, #bottomCenter, #center
- which align the receiver's bounds with the cell at the given point."
- | props |
- props := self layoutProperties.
- ^props ifNil:[#center] ifNotNil:[props cellPositioning].!
Item was removed:
- ----- Method: Morph>>cellPositioning: (in category 'layout properties - table') -----
- cellPositioning: aSymbol
- "Layout specific. This property describes how the receiver should be layed out in its owner when the bounds of the cell assigned to the receiver do not exactly match its bounds. Possible values are:
- #topLeft, #topRight, #bottomLeft, #bottomRight, #topCenter, #leftCenter, #rightCenter, #bottomCenter, #center
- which align the receiver's bounds with the cell at the given point."
- self assureTableLayoutProperties cellPositioning: aSymbol.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>cellPositioningString: (in category 'layout-menu') -----
- cellPositioningString: aSymbol
- ^self layoutMenuPropertyString: aSymbol from: self cellPositioning!
Item was removed:
- ----- Method: Morph>>cellSpacing (in category 'layout properties - table') -----
- cellSpacing
- "Layout specific. This property describes how the cell size for each element in a list should be computed.
- #globalRect - globally equal rectangular cells
- #globalSquare - globally equal square cells
- #localRect - locally (e.g., per row/column) equal rectangular cells
- #localSquare - locally (e.g., per row/column) equal square cells
- #none - cells are sized based on available row/column constraints
- "
- | props |
- props := self layoutProperties.
- ^props ifNil:[#none] ifNotNil:[props cellSpacing].!
Item was removed:
- ----- Method: Morph>>cellSpacing: (in category 'layout properties - table') -----
- cellSpacing: aSymbol
- "Layout specific. This property describes how the cell size for each element in a list should be computed.
- #globalRect - globally equal rectangular cells
- #globalSquare - globally equal square cells
- #localRect - locally (e.g., per row/column) equal rectangular cells
- #localSquare - locally (e.g., per row/column) equal square cells
- #none - cells are sized based on available row/column constraints
- "
- self checkCellSpacingProperty: aSymbol.
- self assureTableLayoutProperties cellSpacing: aSymbol.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>cellSpacingString: (in category 'layout-menu') -----
- cellSpacingString: aSymbol
- ^self layoutMenuPropertyString: aSymbol from: self cellSpacing!
Item was removed:
- ----- Method: Morph>>center (in category 'geometry') -----
- center
-
- ^ bounds center!
Item was removed:
- ----- Method: Morph>>center: (in category 'geometry') -----
- center: aPoint
- self position: (aPoint - (self extent // 2))!
Item was removed:
- ----- Method: Morph>>changeCellGap: (in category 'layout-menu') -----
- changeCellGap: evt
- | handle |
- handle := HandleMorph new forEachPointDo:[:newPoint |
- self cellGap: (newPoint - evt cursorPoint) asIntegerPoint // 5].
- evt hand attachMorph: handle.
- handle startStepping.
- !
Item was removed:
- ----- Method: Morph>>changeCellInset: (in category 'layout-menu') -----
- changeCellInset: evt
- | handle |
- handle := HandleMorph new forEachPointDo:[:newPoint |
- self cellInset: (newPoint - evt cursorPoint) asIntegerPoint // 5].
- evt hand attachMorph: handle.
- handle startStepping.
- !
Item was removed:
- ----- Method: Morph>>changeClipLayoutCells (in category 'layout-menu') -----
- changeClipLayoutCells
- self invalidRect: self fullBounds.
- self clipLayoutCells: self clipLayoutCells not.
- self invalidRect: self fullBounds.!
Item was removed:
- ----- Method: Morph>>changeClipSubmorphs (in category 'drawing') -----
- changeClipSubmorphs
- self clipSubmorphs: self clipSubmorphs not.!
Item was removed:
- ----- Method: Morph>>changeColor (in category 'menus') -----
- changeColor
- "Change the color of the receiver -- triggered, e.g. from a menu"
- NewColorPickerMorph useIt
- ifTrue: [ (NewColorPickerMorph on: self) openNear: self fullBoundsInWorld ]
- ifFalse:
- [ self removeHalo."Halo can obscure the color picker"
- ColorPickerMorph new
- choseModalityFromPreference ;
- sourceHand: self activeHand ;
- target: self ;
- selector: #fillStyle: ;
- originalColor: self color ;
-
- putUpFor: self
- near: self fullBoundsInWorld ]!
Item was removed:
- ----- Method: Morph>>changeColorTarget:selector:originalColor:hand: (in category 'meta-actions') -----
- changeColorTarget: anObject selector: aSymbol originalColor: aColor hand: aHand
- "Put up a color picker for changing some kind of color. May be modal or modeless, depending on #modalColorPickers setting"
- | desiredLoc |
- self flag: #arNote.
- "Simplify this due to anObject == self for almost all cases"
- desiredLoc := anObject isMorph
- ifTrue:
- [ Rectangle
- center: self position
- extent: 20 ]
- ifFalse:
- [ anObject == self world
- ifTrue: [ anObject viewBox bottomLeft + (20 @ -20) extent: 200 ]
- ifFalse: [ anObject fullBoundsInWorld ] ].
- ^ NewColorPickerMorph useIt
- ifTrue:
- [ (NewColorPickerMorph
- on: anObject
- originalColor: aColor
- setColorSelector: aSymbol) openNear: desiredLoc ]
- ifFalse:
- [ ColorPickerMorph new
- choseModalityFromPreference ;
- sourceHand: aHand ;
- target: anObject ;
- selector: aSymbol ;
- originalColor: aColor ;
-
- putUpFor: anObject
- near: desiredLoc ;
- yourself ]!
Item was removed:
- ----- Method: Morph>>changeDirectionHandles (in category 'menus') -----
- changeDirectionHandles
- ^self wantsDirectionHandles: self wantsDirectionHandles not!
Item was removed:
- ----- Method: Morph>>changeDisableTableLayout (in category 'layout-menu') -----
- changeDisableTableLayout
- self disableTableLayout: self disableTableLayout not.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>changeDrag (in category 'menus') -----
- changeDrag
- ^ self enableDrag: self dragEnabled not!
Item was removed:
- ----- Method: Morph>>changeDragAndDrop (in category 'menus') -----
- changeDragAndDrop
- ^ self enableDragNDrop: self dragNDropEnabled not!
Item was removed:
- ----- Method: Morph>>changeDrop (in category 'menus') -----
- changeDrop
- ^ self enableDrop: self dropEnabled not!
Item was removed:
- ----- Method: Morph>>changeHeightForWidth (in category 'layout-menu') -----
- changeHeightForWidth
- "Convenience. Configure morphs that do not have a layout policy to be layed out properly in an owner that has such a policy. Tell that owner that I change my height if somebody changes my width."
-
- self
- hResizing: #spaceFill;
- vResizing: #shrinkWrap;
- wrapDirection: #topToBottom.!
Item was removed:
- ----- Method: Morph>>changeLayoutInset: (in category 'layout-menu') -----
- changeLayoutInset: evt
- | handle |
- handle := HandleMorph new forEachPointDo:[:newPoint |
- self layoutInset: (newPoint - evt cursorPoint) asIntegerPoint // 5].
- evt hand attachMorph: handle.
- handle startStepping.
- !
Item was removed:
- ----- Method: Morph>>changeListDirection: (in category 'layout-menu') -----
- changeListDirection: aSymbol
- | listDir wrapDir |
- self listDirection: aSymbol.
- (self wrapDirection == #none) ifTrue:[^self].
- "otherwise automatically keep a valid table layout"
- listDir := self listDirection.
- wrapDir := self wrapDirection.
- (listDir == #leftToRight or:[listDir == #rightToLeft]) ifTrue:[
- wrapDir == #leftToRight ifTrue:[^self wrapDirection: #topToBottom].
- wrapDir == #rightToLeft ifTrue:[^self wrapDirection: #bottomToTop].
- ] ifFalse:[
- wrapDir == #topToBottom ifTrue:[^self wrapDirection: #leftToRight].
- wrapDir == #bottomToTop ifTrue:[^self wrapDirection: #rightToLeft].
- ].
- !
Item was removed:
- ----- Method: Morph>>changeMaxCellSize: (in category 'layout-menu') -----
- changeMaxCellSize: evt
- | handle |
- handle := HandleMorph new forEachPointDo:[:newPoint |
- self maxCellSize: (newPoint - evt cursorPoint) asIntegerPoint].
- evt hand attachMorph: handle.
- handle startStepping.
- !
Item was removed:
- ----- Method: Morph>>changeMinCellSize: (in category 'layout-menu') -----
- changeMinCellSize: evt
- | handle |
- handle := HandleMorph new forEachPointDo:[:newPoint |
- self minCellSize: (newPoint - evt cursorPoint) asIntegerPoint].
- evt hand attachMorph: handle.
- handle startStepping.
- !
Item was removed:
- ----- Method: Morph>>changeNoLayout (in category 'layout-menu') -----
- changeNoLayout
- self layoutPolicy ifNil:[^self]. "already no layout"
- self layoutPolicy: nil.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>changeProportionalLayout (in category 'layout-menu') -----
- changeProportionalLayout
- | layout |
- ((layout := self layoutPolicy) notNil and:[layout isProportionalLayout])
- ifTrue:[^self]. "already proportional layout"
- self layoutPolicy: ProportionalLayout new.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>changeReverseCells (in category 'layout-menu') -----
- changeReverseCells
- self reverseTableCells: self reverseTableCells not.!
Item was removed:
- ----- Method: Morph>>changeRubberBandCells (in category 'layout-menu') -----
- changeRubberBandCells
- self rubberBandCells: self rubberBandCells not.!
Item was removed:
- ----- Method: Morph>>changeShadowColor (in category 'drop shadows') -----
- changeShadowColor
- "Change the shadow color of the receiver -- triggered, e.g. from a menu"
- NewColorPickerMorph useIt
- ifTrue:
- [ (NewColorPickerMorph
- on: self
- originalColor: self shadowColor
- setColorSelector: #shadowColor:) openNearMorph: self ]
- ifFalse:
- [ ColorPickerMorph new
- choseModalityFromPreference ;
- sourceHand: self activeHand ;
- target: self ;
- selector: #shadowColor: ;
- originalColor: self shadowColor ;
-
- putUpFor: self
- near: self fullBoundsInWorld ]!
Item was removed:
- ----- Method: Morph>>changeTableLayout (in category 'layout-menu') -----
- changeTableLayout
- | layout |
- ((layout := self layoutPolicy) notNil and:[layout isTableLayout])
- ifTrue:[^self]. "already table layout"
- self layoutPolicy: TableLayout new.!
Item was removed:
- ----- Method: Morph>>changeWidthForHeight (in category 'layout-menu') -----
- changeWidthForHeight
- "Convenience. Configure morphs that do not have a layout policy to be layed out properly in an owner that has such a policy. Tell that owner that I change my width if somebody changes my height."
-
- self
- hResizing: #shrinkWrap;
- vResizing: #spaceFill;
- wrapDirection: #leftToRight.!
Item was removed:
- ----- Method: Morph>>changed (in category 'updating') -----
- changed
- "Report that the area occupied by this morph should be redrawn."
- ^fullBounds
- ifNil:[self invalidRect: self outerBounds]
- ifNotNil:[self invalidRect: fullBounds]!
Item was removed:
- ----- Method: Morph>>changedViaHalo: (in category 'halo notification') -----
- changedViaHalo: halo
- "The receiver has been manipulated from a halo in an operation that has completed now."!
Item was removed:
- ----- Method: Morph>>changesHeightForWidth (in category 'layout-menu') -----
- changesHeightForWidth
- "When both axes are on #spaceFill, the receiver (morph) usually adapts any inner height-for-width layout unless there is more space to fill. Since we cannot know in advance, we assume that an extra layout run might be necessary."
-
- ^ (self hResizing == #spaceFill and: [self vResizing == #spaceFill])
- or: [(self hResizing ~= #shrinkWrap
- and: [self vResizing = #shrinkWrap])
- and: [self wrapDirection ~= #none]]!
Item was removed:
- ----- Method: Morph>>changesWidthForHeight (in category 'layout-menu') -----
- changesWidthForHeight
- "When both axes are on #spaceFill, the receiver (morph) usually adapts any inner height-for-width layout unless there is more space to fill. Since we cannot know in advance, we assume that an extra layout run might be necessary."
-
- ^ (self hResizing == #spaceFill and: [self vResizing == #spaceFill])
- or: [(self hResizing = #shrinkWrap
- and: [self vResizing ~= #shrinkWrap])
- and: [self wrapDirection ~= #none]]!
Item was removed:
- ----- Method: Morph>>checkCellSpacingProperty: (in category 'layout') -----
- checkCellSpacingProperty: aSymbol
-
- aSymbol == #none ifTrue: [^ self].
-
- aSymbol == #globalRect ifTrue: [^ self].
- aSymbol == #globalSquare ifTrue: [^ self].
- aSymbol == #localRect ifTrue: [^ self].
- aSymbol == #localSquare ifTrue: [^ self].
-
- Error signal: 'Invalid cell-spacing property. Use #none, #globalRect, #globalSquare, #localRect, or #localSquare.'.!
Item was removed:
- ----- Method: Morph>>checkListSpacingProperty: (in category 'layout') -----
- checkListSpacingProperty: aSymbol
-
- aSymbol == #none ifTrue: [^ self].
- aSymbol == #equal ifTrue: [^ self].
-
- Error signal: 'Invalid value for list-spacing property. Use #none or #equal.'.!
Item was removed:
- ----- Method: Morph>>checkResizingProperty: (in category 'layout') -----
- checkResizingProperty: aSymbol
-
- aSymbol == #rigid ifTrue: [^ self].
- aSymbol == #shrinkWrap ifTrue: [^ self].
- aSymbol == #spaceFill ifTrue: [^ self].
-
- Error signal: 'Invalid value for resizing property. Use #rigid, #shrinkWrap, or #spaceFill.'.!
Item was removed:
- ----- Method: Morph>>chooseNewGraphic (in category 'menus') -----
- chooseNewGraphic
- "Used by any morph that can be represented by a graphic"
- self chooseNewGraphicCoexisting: false
- !
Item was removed:
- ----- Method: Morph>>chooseNewGraphicCoexisting: (in category 'menus') -----
- chooseNewGraphicCoexisting: aBoolean
- "Allow the user to choose a different form for her form-based morph"
-
- | replacee aGraphicalMenu |
- self isInWorld ifFalse: "menu must have persisted for a not-in-world object."
- [aGraphicalMenu := Project current world submorphThat:
- [:m | (m isKindOf: GraphicalMenu) and: [m target == self]]
- ifNone:
- [^ self].
- ^ aGraphicalMenu show; flashBounds].
- 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]!
Item was removed:
- ----- Method: Morph>>chooseNewGraphicFromHalo (in category 'menus') -----
- chooseNewGraphicFromHalo
- "Allow the user to select a changed graphic to replace the one in the receiver"
-
- self currentWorld abandonAllHalos.
- self chooseNewGraphicCoexisting: true
- !
Item was removed:
- ----- Method: Morph>>clearArea (in category 'accessing') -----
- clearArea
- "Answer the clear area of the receiver. It means the area free
- of docking bars."
- | visTop visBottom visLeft visRight |
-
- visTop := self top.
- visBottom := self bottom.
- visLeft := self left.
- visRight := self right.
-
- self dockingBars
- do: [:each |
- (each isAdheringToTop and: [each bottom > visTop])
- ifTrue: [visTop := each bottom].
-
- (each isAdheringToBottom and: [each top < visBottom])
- ifTrue: [visBottom := each top].
-
- (each isAdheringToLeft and: [each right > visLeft])
- ifTrue: [visLeft := each right].
-
- (each isAdheringToRight and: [each left < visRight])
- ifTrue: [visRight := each left]
- ].
-
- ^ Rectangle
- left: visLeft
- right: visRight
- top: visTop
- bottom: visBottom
- !
Item was removed:
- ----- Method: Morph>>click (in category 'event handling') -----
- click
- "Pretend the user clicked on me."
-
- (self handlesMouseDown: nil) ifTrue: [
- self mouseDown: nil.
- self mouseUp: nil].!
Item was removed:
- ----- Method: Morph>>click: (in category 'event handling') -----
- click: evt
- "Handle a single-click event. This message is only sent to clients that request it by sending #waitForClicksOrDrag:event: to the initiating hand in their mouseDown: method. This default implementation does nothing.
- LC 2/14/2000 08:32 - added: EventHandler notification"
-
- self eventHandler ifNotNil:
- [self eventHandler click: evt fromMorph: self].!
Item was removed:
- ----- Method: Morph>>clipLayoutCells (in category 'drawing') -----
- clipLayoutCells
- "Drawing/layout specific. If this property is set, clip the
- submorphs of the receiver by its cell bounds."
- ^ self
- valueOfProperty: #clipLayoutCells
- ifAbsent: [false]!
Item was removed:
- ----- Method: Morph>>clipLayoutCells: (in category 'drawing') -----
- clipLayoutCells: aBool
- "Drawing/layout specific. If this property is set, clip the submorphs of the receiver by its cell bounds."
- aBool == false
- ifTrue:[self removeProperty: #clipLayoutCells]
- ifFalse:[self setProperty: #clipLayoutCells toValue: aBool].
- self changed.!
Item was removed:
- ----- Method: Morph>>clipPostscript (in category '*morphic-Postscript Canvases') -----
- clipPostscript
- ^Clipboard clipboardText: self asPostscript.
-
- !
Item was removed:
- ----- Method: Morph>>clipSubmorphs (in category 'drawing') -----
- clipSubmorphs
- "Drawing specific. If this property is set, clip the receiver's
- submorphs to the receiver's clipping bounds."
-
- extension ifNil: [^false].
- ^ self
- valueOfProperty: #clipSubmorphs
- ifAbsent: [false]!
Item was removed:
- ----- Method: Morph>>clipSubmorphs: (in category 'drawing') -----
- clipSubmorphs: aBool
- "Drawing specific. If this property is set, clip the receiver's submorphs to the receiver's clipping bounds."
-
- self fullBounds; changed.
-
- aBool == false
- ifTrue:[self removeProperty: #clipSubmorphs]
- ifFalse:[self setProperty: #clipSubmorphs toValue: aBool].
-
- self
- layoutChanged;
- fullBounds; changed.!
Item was removed:
- ----- Method: Morph>>clipText (in category 'printing') -----
- clipText
- "Copy the text in the receiver or in its submorphs to the clipboard"
- | content |
- "My own text"
- content := self userString.
- "Or in my submorphs"
- content ifNil: [
- | list |
- list := self allStringsAfter: nil.
- list notEmpty ifTrue: [
- content := String streamContents: [:stream |
- list do: [:each | stream nextPutAll: each; cr]]]].
- "Did we find something?"
- content
- ifNil: [self flash "provide feedback"]
- ifNotNil: [Clipboard clipboardText: content].!
Item was removed:
- ----- Method: Morph>>clippingBounds (in category 'drawing') -----
- clippingBounds
- "Return the bounds to which any submorphs should be clipped if the property is set"
- ^self innerBounds!
Item was removed:
- ----- Method: Morph>>collapse (in category 'menus') -----
- collapse
- CollapsedMorph new beReplacementFor: self!
Item was removed:
- ----- Method: Morph>>color (in category 'accessing') -----
- color
-
- ^ color "has already been set to ((self valueOfProperty: #fillStyle) asColor)"!
Item was removed:
- ----- Method: Morph>>color: (in category 'accessing') -----
- color: aColor
- "Set the receiver's color. Directly set the color if appropriate, else go by way of fillStyle"
-
- (aColor isColor or: [aColor isKindOf: InfiniteForm]) ifFalse:[^ self fillStyle: aColor].
- color = aColor ifFalse:
- [self removeProperty: #fillStyle.
- color := aColor.
- self borderStyle trackColorFrom: self.
- self changed]!
Item was removed:
- ----- Method: Morph>>colorChangedForSubmorph: (in category 'change reporting') -----
- colorChangedForSubmorph: aSubmorph
- "The color associated with aSubmorph was changed through the UI; react if needed"!
Item was removed:
- ----- Method: Morph>>colorForInsets (in category 'accessing') -----
- colorForInsets
- "Return the color to be used for shading inset borders. The default is my own color, but it might want to be, eg, my owner's color. Whoever's color ends up prevailing, the color itself gets the last chance to determine, so that when, for example, an InfiniteForm serves as the color, callers won't choke on some non-Color object being returned"
- (color isColor and:[color isTransparent and:[owner notNil]]) ifTrue:[^owner colorForInsets].
- ^ color colorForInsets
- !
Item was removed:
- ----- Method: Morph>>colorString: (in category 'printing') -----
- colorString: aColor
-
- aColor ifNil: [ ^'nil' ].
- ^aColor name
- ifNil: [ aColor storeString ]
- ifNotNil: [ :colorName | 'Color ', colorName ]!
Item was removed:
- ----- Method: Morph>>comeToFront (in category 'submorphs - add/remove') -----
- comeToFront
- | outerMorph |
- outerMorph := self topRendererOrSelf.
- (outerMorph owner isNil or: [outerMorph owner hasSubmorphs not])
- ifTrue: [^self].
- outerMorph owner firstSubmorph == outerMorph
- ifFalse: [outerMorph owner addMorphFront: outerMorph]!
Item was removed:
- ----- Method: Morph>>comeToFrontAndAddHalo (in category 'halos and balloon help') -----
- comeToFrontAndAddHalo
- self comeToFront.
- self addHalo!
Item was removed:
- ----- Method: Morph>>commandHistory (in category 'undo') -----
- commandHistory
- "Return the command history for the receiver"
- | w |
- (w := self world) ifNotNil:[^w commandHistory].
- (w := self currentWorld) ifNotNil:[^w commandHistory].
- ^CommandHistory new. "won't really record anything but prevent breaking things"!
Item was removed:
- ----- Method: Morph>>completeModificationHash (in category 'testing') -----
- completeModificationHash
-
- "World completeModificationHash"
-
- | resultSize result |
- resultSize := 10.
- result := ByteArray new: resultSize.
- self allMorphsDo: [ :each | | here |
- here := each modificationHash.
- here withIndexDo: [ :ch :index | | i |
- i := index \\ resultSize + 1.
- result at: i put: ((result at: i) bitXor: ch asciiValue)
- ].
- ].
- ^result!
Item was removed:
- ----- Method: Morph>>constructorString (in category 'printing') -----
- constructorString
-
- ^ String streamContents: [:s | self printConstructorOn: s indent: 0].
- !
Item was removed:
- ----- Method: Morph>>containingWindow (in category 'structure') -----
- containingWindow
- "Answer a window that contains the receiver. Try to use the model to find the right window. If I do not have a model, use the model of one of my owners. We could also just use #isSystemWindow. This, however, gives system windows the chance to refrain from taking ownership of this morph."
-
- | component |
- component := self.
- component model isNil ifTrue: [component := self firstOwnerSuchThat: [:m| m model notNil]].
- ^(component isNil or: [component isWindowForModel: component model])
- ifTrue: [component]
- ifFalse: [(component firstOwnerSuchThat: [:m | m isWindowForModel: component model])
- "For models composed of models, we have to use #isSystemWindow."
- ifNil: [component firstOwnerSuchThat: [:m | m isSystemWindow]]]!
Item was removed:
- ----- Method: Morph>>containsPoint: (in category 'geometry testing') -----
- containsPoint: aPoint
-
- ^ self bounds containsPoint: aPoint!
Item was removed:
- ----- Method: Morph>>containsPoint:event: (in category 'events-processing') -----
- containsPoint: aPoint event: anEvent
- "Return true if aPoint is considered to be inside the receiver for the given event.
- The default implementation treats locked children as integral part of their owners."
- (self fullBounds containsPoint: aPoint) ifFalse:[^false].
- (self containsPoint: aPoint) ifTrue:[^true].
- self submorphsDo:[:m|
- (m isLocked and:[m fullContainsPoint:
- ((m transformedFrom: self) globalPointToLocal: aPoint)]) ifTrue:[^true]].
- ^false!
Item was removed:
- ----- Method: Morph>>copy (in category 'copying') -----
- copy
-
- ^ self veryDeepCopy!
Item was removed:
- ----- Method: Morph>>copyLayoutProperties (in category 'layout properties') -----
- copyLayoutProperties
- ^[Clipboard clipboardText: self layoutProperties storeString] ifError:[ nil ] !
Item was removed:
- ----- Method: Morph>>copyToPasteBuffer: (in category 'meta-actions') -----
- copyToPasteBuffer: evt
- self okayToDuplicate ifTrue:[evt hand copyToPasteBuffer: self].!
Item was removed:
- ----- Method: Morph>>copyWithoutSubmorph: (in category 'submorphs - misc') -----
- copyWithoutSubmorph: sub
- "Needed to get a morph to draw without one of its submorphs.
- NOTE: This must be thrown away immediately after use."
- ^ self shallowCopy privateSubmorphs: (submorphs copyWithout: sub)!
Item was removed:
- ----- Method: Morph>>cornerRadius (in category 'rounding') -----
- cornerRadius
-
- ^ self
- valueOfProperty: #cornerRadius
- ifAbsent: [self class preferredCornerRadius]!
Item was removed:
- ----- Method: Morph>>cornerRadius: (in category 'rounding') -----
- cornerRadius: radius
-
- self
- setProperty: #cornerRadius
- toValue: radius.
-
- self changed.!
Item was removed:
- ----- Method: Morph>>cornerStyle (in category 'rounding') -----
- cornerStyle
- "Returns one of the following symbols:
- #square
- #rounded
- according to the current corner style."
-
- ^ self valueOfProperty: #cornerStyle ifAbsent: [#square]!
Item was removed:
- ----- Method: Morph>>cornerStyle: (in category 'rounding') -----
- cornerStyle: aSymbol
- "This method makes it possible to set up desired corner style. aSymbol has to be one of:
- #square
- #rounded"
-
- self setProperty: #cornerStyle toValue: aSymbol.
- self changed.!
Item was removed:
- ----- Method: Morph>>couldHaveRoundedCorners (in category 'accessing') -----
- couldHaveRoundedCorners
- ^ true!
Item was removed:
- ----- Method: Morph>>couldMakeSibling (in category 'testing') -----
- couldMakeSibling
- "Answer whether it is appropriate to ask the receiver to make a sibling"
-
- ^ true!
Item was removed:
- ----- Method: Morph>>createHalo (in category 'halos and balloon help') -----
- createHalo
-
- ^ (Smalltalk at: self haloClass ifAbsent: [HaloMorph]) new!
Item was removed:
- ----- Method: Morph>>currentPlayerDo: (in category 'e-toy support') -----
- currentPlayerDo: aBlock
- "If the receiver is a viewer/scriptor associated with a current Player object, evaluate the given block against that object"!
Item was removed:
- ----- Method: Morph>>cursor (in category 'e-toy support') -----
- cursor
- "vacuous backstop in case it gets sent to a morph that doesn't know what to do with it"
-
- ^ 1!
Item was removed:
- ----- Method: Morph>>cursor: (in category 'e-toy support') -----
- cursor: aNumber
- "vacuous backstop in case it gets sent to a morph that doesn't know what to do with it"
- !
Item was removed:
- ----- Method: Morph>>cursorPoint (in category 'event handling') -----
- cursorPoint
- ^ self currentHand lastEvent cursorPoint!
Item was removed:
- ----- Method: Morph>>decimalPlacesForGetter: (in category 'e-toy support') -----
- decimalPlacesForGetter: aGetter
- "Answer the decimal places I prefer for showing a slot with the given getter, or nil if none"
-
- | decimalPrefs |
- decimalPrefs := self renderedMorph valueOfProperty: #decimalPlacePreferences ifAbsent: [^ nil].
- ^ decimalPrefs at: aGetter ifAbsent: [nil]!
Item was removed:
- ----- Method: Morph>>deepCopy (in category 'copying') -----
- deepCopy
-
- self error: 'Please use veryDeepCopy'.
- !
Item was removed:
- ----- Method: Morph>>defaultArrowheadSize (in category 'menus') -----
- defaultArrowheadSize
-
- ^ self class defaultArrowheadSize!
Item was removed:
- ----- Method: Morph>>defaultBalloonColor (in category 'halos and balloon help') -----
- defaultBalloonColor
- ^ Display depth <= 2
- ifTrue: [Color white]
- ifFalse: [BalloonMorph balloonColor]!
Item was removed:
- ----- Method: Morph>>defaultBalloonFont (in category 'halos and balloon help') -----
- defaultBalloonFont
- ^ BalloonMorph balloonFont!
Item was removed:
- ----- Method: Morph>>defaultBitmapFillForm (in category 'visual properties') -----
- defaultBitmapFillForm
- ^ImageMorph defaultForm.
- !
Item was removed:
- ----- Method: Morph>>defaultBounds (in category 'initialization') -----
- defaultBounds
- "answer the default bounds for the receiver"
- ^ 0 @ 0 corner: 50 @ 40!
Item was removed:
- ----- Method: Morph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color blue!
Item was removed:
- ----- Method: Morph>>defaultEventDispatcher (in category 'events-processing') -----
- defaultEventDispatcher
- "Return the default event dispatcher to use with events that are directly sent to the receiver"
- ^MorphicEventDispatcher new!
Item was removed:
- ----- Method: Morph>>defaultHaloDispatcher (in category 'halos and balloon help') -----
- defaultHaloDispatcher
-
- ^ MorphicHaloDispatcher new!
Item was removed:
- ----- Method: Morph>>defaultLabelForInspector (in category 'user interface') -----
- defaultLabelForInspector
- "Answer the default label to be used for an Inspector window on the receiver."
- ^ self printStringLimitedTo: 40!
Item was removed:
- ----- Method: Morph>>defaultNameStemForInstances (in category 'accessing') -----
- defaultNameStemForInstances
- ^self class name!
Item was removed:
- ----- Method: Morph>>defaultValueOrNil (in category 'e-toy support') -----
- defaultValueOrNil
- "If the receiver has a property named #defaultValue, return that property's value, else return nil"
-
- ^ self valueOfProperty: #defaultValue ifAbsent: [nil]!
Item was removed:
- ----- Method: Morph>>defersHaloOnClickTo: (in category 'halos and balloon help') -----
- defersHaloOnClickTo: aSubMorph
- "If a cmd-click on aSubMorph would make it a preferred recipient of the halo, answer true"
- "May want to add a way (via a property) for morphs to assert true here -- this would let certain kinds of morphs that are unusually reluctant to take the halo on initial click"
-
- ^ false
- !
Item was removed:
- ----- Method: Morph>>defineTempCommand (in category 'debug and other') -----
- defineTempCommand
- "To use this, comment out what's below here, and substitute your own code.
- You will then be able to invoke it from the standard debugging menus. If invoked from the world menu, you'll always get it invoked on behalf of the world, but if invoked from an individual morph's meta-menu, it will be invoked on behalf of that individual morph.
-
- Note that you can indeed reimplement tempCommand in an individual morph's class if you wish"
-
- ToolSet browse: Morph
- selector: #tempCommand!
Item was removed:
- ----- Method: Morph>>delete (in category 'submorphs - add/remove') -----
- delete
- "Remove the receiver as a submorph of its owner and make its
- new owner be nil."
- | oldWorld |
- self removeHalo.
- (oldWorld := self world) ifNotNil: [
- self disableSubmorphFocusForHand: self activeHand.
- self activeHand
- releaseKeyboardFocus: self;
- releaseMouseFocus: self].
- owner ifNotNil: [
- self privateDelete. "remove from world"
- self player ifNotNil: [:player |
- oldWorld ifNotNil: [
- player noteDeletionOf: self fromWorld: oldWorld]]].!
Item was removed:
- ----- Method: Morph>>deleteAnyMouseActionIndicators (in category 'debug and other') -----
- deleteAnyMouseActionIndicators
-
- self changed.
- (self valueOfProperty: #mouseActionIndicatorMorphs ifAbsent: [#()]) do: [ :each |
- each deleteWithSiblings "one is probably enough, but be safe"
- ].
- self removeProperty: #mouseActionIndicatorMorphs.
- self hasRolloverBorder: false.
- self removeProperty: #rolloverWidth.
- self removeProperty: #rolloverColor.
- self layoutChanged.
- self changed.
-
- !
Item was removed:
- ----- Method: Morph>>deleteBalloon (in category 'halos and balloon help') -----
- deleteBalloon
- "If I am showing a balloon, delete it."
- | w |
- w := self world ifNil:[^self].
- w deleteBalloonTarget: self.!
Item was removed:
- ----- Method: Morph>>deleteDockingBars (in category 'submorphs - misc') -----
- deleteDockingBars
- "Delete the receiver's docking bars"
- self dockingBars
- do: [:each | each delete]!
Item was removed:
- ----- Method: Morph>>deleteSubmorphsWithProperty: (in category 'submorphs - misc') -----
- deleteSubmorphsWithProperty: aSymbol
- submorphs copy do:
- [:m | (m hasProperty: aSymbol) ifTrue: [m delete]]!
Item was removed:
- ----- Method: Morph>>deleteUnlessHasFocus (in category 'submorphs - misc') -----
- deleteUnlessHasFocus
- "Runs on a step timer because we cannot be guaranteed to get focus change events."
- (self currentHand keyboardFocus ~= self and: [ self isInWorld ]) ifTrue:
- [ self
- stopSteppingSelector: #deleteUnlessHasFocus ;
- delete ]!
Item was removed:
- ----- Method: Morph>>demandsBoolean (in category 'classification') -----
- demandsBoolean
- "Answer whether the receiver will only accept a drop if it is boolean-valued. Particular to tile-scripting."
-
- ^ self hasProperty: #demandsBoolean!
Item was removed:
- ----- Method: Morph>>demandsThumbnailing (in category 'thumbnail') -----
- demandsThumbnailing
- "Answer whether the receiver, if in a thumbnailable parts bin, wants to be thumbnailed whether or not size requires it"
-
- ^ false!
Item was removed:
- ----- Method: Morph>>disableDragNDrop (in category 'dropping/grabbing') -----
- disableDragNDrop
- self enableDragNDrop: false!
Item was removed:
- ----- Method: Morph>>disableLayout (in category 'layout properties') -----
- disableLayout
- "Layout specific. Disable laying out the receiver in a layout"
- | props |
- props := self layoutProperties.
- ^props ifNil:[false] ifNotNil:[props disableLayout].!
Item was removed:
- ----- Method: Morph>>disableLayout: (in category 'layout properties') -----
- disableLayout: aBool
- "Layout specific. Disable laying out the receiver in the owner's layout if any. The receiver's layout (policy) is not affected by this."
-
- self fullBounds; layoutChanged.
- self assureLayoutProperties disableLayout: aBool.
- self fullBounds; layoutChanged; changed.!
Item was removed:
- ----- Method: Morph>>disableSubmorphFocusForHand: (in category 'dispatching') -----
- disableSubmorphFocusForHand: aHandMorph
- "Check whether this morph or any of its submorph has the Genie focus.
- If yes, disable it."
- !
Item was removed:
- ----- Method: Morph>>disableTableLayout (in category 'layout properties') -----
- disableTableLayout
- "Layout specific. Disable laying out the receiver in table layout"
- | props |
- props := self layoutProperties.
- ^props ifNil:[false] ifNotNil:[props disableTableLayout].!
Item was removed:
- ----- Method: Morph>>disableTableLayout: (in category 'layout properties') -----
- disableTableLayout: aBool
- "Layout specific. Disable laying out the receiver in table layout"
-
- self fullBounds; layoutChanged.
- self assureLayoutProperties disableTableLayout: aBool.
- self fullBounds; layoutChanged; changed.!
Item was removed:
- ----- Method: Morph>>dismissMorph (in category 'meta-actions') -----
- dismissMorph
- "This is called from an explicit halo destroy/delete action.
- So first disconnect all constraints to keep the graph up to date."
-
- (self respondsTo: #disconnectAllConstraints) "Connectors package"
- ifTrue: [ self perform: #disconnectAllConstraints ].
- (self respondsTo: #releaseGraphModels) "CGPrereqs package (Connectors)"
- ifTrue: [ self perform: #releaseGraphModels ].
- self world ifNotNil:
- [:w | 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 - misc') -----
- 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.
- TrashCanMorph preserveTrash ifTrue: [
- TrashCanMorph slideDismissalsToTrash
- ifTrue:[self slideToTrash: nil]
- ifFalse:[TrashCanMorph moveToTrash: self].
- ].
-
- cmd := Command new cmdWording: 'dismiss ' translated, self externalName.
- cmd undoTarget: Project current world selector: #reintroduceIntoWorld: argument: self.
- cmd redoTarget: Project current world selector: #onceAgainDismiss: argument: self.
- Project current world rememberCommand: cmd.!
Item was removed:
- ----- Method: Morph>>displayScaleChangedBy: (in category 'display scale') -----
- displayScaleChangedBy: factor!
Item was removed:
- ----- Method: Morph>>doButtonAction (in category 'button') -----
- doButtonAction
- "If the receiver has a button-action defined, do it now. The default button action of any morph is, well, to do nothing. Note that there are several ways -- too many ways -- for morphs to have button-like actions. It is intended for morph classes whose very nature is to be buttons -- this method provides glue so that arbitrary buttons on the UI can be 'fired' programmatically from user scripts."!
Item was removed:
- ----- Method: Morph>>doCancel (in category 'user interface') -----
- doCancel
- self delete!
Item was removed:
- ----- Method: Morph>>doLayout (in category 'layout') -----
- doLayout
-
- self doLayoutIn: self layoutBounds.!
Item was removed:
- ----- Method: Morph>>doLayoutIn: (in category 'layout') -----
- doLayoutIn: layoutBounds
- "Compute a new layout based on the given layout bounds."
-
- | box priorBounds |
- "0) Quick return. No children means no effect in layout policies. Use #minWidth and #minHeight to implement #shrinkWrap for morphs without submorphs."
- self hasSubmorphs ifFalse: [^ fullBounds := self outerBounds].
-
- "X.1) Prepare redraw. Testing for #bounds or #layoutBounds would be sufficient to figure out if we need an invalidation afterwards but #outerBounds is what we need for all leaf nodes so we use that"
- priorBounds := self outerBounds.
-
- "1) Give our children a chance to manually adjust *before* layout (cell) computation. This allows morphs to layout in their owner without having to use a layout policy."
- self submorphsDo: [:m | m ownerChanged].
-
- "2) Compute the new layout. This goes down the entire morph hierarchy. See #layoutInBounds: and #minExtent, which are the usual layout-policy callbacks."
- self layoutPolicy ifNil: [self submorphsDo: [:m | m fullBounds]] ifNotNil: [:layout |
-
- "2.1) Compute the new layout."
- self removeProperty: #doLayoutAgain.
- layout layout: self in: layoutBounds.
-
- "2.2) Do one additional run on the layout if requested in #layoutInBounds:."
- (self hasProperty: #doLayoutAgain) ifTrue: [
- self removeProperty: #doLayoutAgain.
- layout flushLayoutCache.
- layout layout: self in: layoutBounds].
- self assert: (self hasProperty: #doLayoutAgain) not].
-
- "3) Watch out for minimal extent and apply #shrinkWrap constraints."
- self adjustLayoutBounds.
-
- "4) Compute and set the new full bounds. IMPORTANT to finish layout computation."
- fullBounds := self privateFullBounds.
-
- "X.2) Redraw."
- box := self outerBounds.
- box = priorBounds ifFalse: [
- self invalidRect: (priorBounds quickMerge: box)].!
Item was removed:
- ----- Method: Morph>>doLayoutSafely (in category 'layout') -----
- doLayoutSafely
- "Also see #resumeAfterLayoutError."
-
- [fullBounds] whileNil: [
- [self doLayout] on: Error, Halt, Warning do: [:error |
-
- | errorMorph |
- (error signalerContext
- findContextSuchThat: [:context |
- context receiver isMorph and: [context receiver layoutPolicy notNil]])
- ifNil: [^ error pass "We cannot help here. Maybe the receiver is not yet initialized?"]
- ifNotNil: [:errorContext | errorMorph := errorContext receiver].
- errorMorph
- instVarNamed: #fullBounds
- put: (errorMorph instVarNamed: #bounds).
- (Warning handles: error) ifFalse: [
- "Disable the policy unless it is a warning, which should be secured where signaled to ease debugging."
- errorMorph
- setProperty: #errorOnLayout toValue: errorMorph layoutPolicy;
- setProperty: #layoutPolicy toValue: nil. "Avoid #layoutChanged!!"].
-
- ToolSet debugException: error]].!
Item was removed:
- ----- Method: Morph>>doMenuItem: (in category 'menus') -----
- doMenuItem: menuString
- | aMenu anItem aNominalEvent aHand |
- aMenu := self buildHandleMenu: (aHand := self currentHand).
- aMenu allMorphsDo: [:m | m step]. "Get wordings current"
- anItem := aMenu itemWithWording: menuString.
- anItem ifNil:
- [^ self player scriptingError: 'Menu item not found: ', menuString].
- aNominalEvent := MouseButtonEvent new
- setType: #mouseDown
- position: anItem bounds center
- which: 4 "red"
- buttons: 4 "red"
- hand: aHand
- stamp: nil.
- anItem invokeWithEvent: aNominalEvent!
Item was removed:
- ----- Method: Morph>>dockingBars (in category 'submorphs - misc') -----
- dockingBars
- "Answer the receiver's dockingBars"
- ^ self submorphs
- select: [:each | each isDockingBar]
- !
Item was removed:
- ----- Method: Morph>>doesOwnRotation (in category 'drawing') -----
- doesOwnRotation
- "Some morphs don't want to TransformMorph to rotate their images, but we do"
- ^ false!
Item was removed:
- ----- Method: Morph>>doubleClick: (in category 'event handling') -----
- doubleClick: evt
- "Handle a double-click event. This message is only sent to clients that request it by sending #waitForClicksOrDrag:event: to the initiating hand in their mouseDown: method. This default implementation does nothing.
- LC 2/14/2000 08:32 - added: EventHandler notification"
-
- self eventHandler ifNotNil:
- [self eventHandler doubleClick: evt fromMorph: self].!
Item was removed:
- ----- Method: Morph>>doubleClickTimeout: (in category 'event handling') -----
- doubleClickTimeout: evt
- "Handle a double-click timeout event. This message is only sent to clients that request it by sending #waitForClicksOrDrag:event: to the initiating hand in their mouseDown: method. This default implementation does nothing."
-
- self eventHandler ifNotNil:
- [self eventHandler doubleClickTimeout: evt fromMorph: self].!
Item was removed:
- ----- Method: Morph>>downshiftedNameOfObjectRepresented (in category 'naming') -----
- downshiftedNameOfObjectRepresented
- "Answer the downshiped version of the external name of the object represented"
-
- ^ self nameOfObjectRepresented asLowercase!
Item was removed:
- ----- Method: Morph>>dragEnabled (in category 'dropping/grabbing') -----
- dragEnabled
- "Get this morph's ability to add and remove morphs via drag-n-drop."
- ^(self valueOfProperty: #dragEnabled) == true
- !
Item was removed:
- ----- Method: Morph>>dragEnabled: (in category 'dropping/grabbing') -----
- dragEnabled: aBool
- ^self enableDrag: aBool!
Item was removed:
- ----- Method: Morph>>dragNDropEnabled (in category 'dropping/grabbing') -----
- dragNDropEnabled
- "Note: This method is only useful for dragEnabled == dropEnabled at all times"
- self separateDragAndDrop.
- ^self dragEnabled and:[self dropEnabled]!
Item was removed:
- ----- Method: Morph>>dragSelectionColor (in category 'dropping/grabbing') -----
- dragSelectionColor
- ^ Color magenta!
Item was removed:
- ----- Method: Morph>>drawDropHighlightOn: (in category 'drawing') -----
- drawDropHighlightOn: aCanvas
-
- self highlightedForDrop ifTrue: [
- self wantsRoundedCorners
- ifTrue: [aCanvas frameRoundRect: self fullBounds radius: self cornerRadius width: 1 color: self dropHighlightColor]
- ifFalse: [aCanvas frameRectangle: self fullBounds color: self dropHighlightColor]].!
Item was removed:
- ----- Method: Morph>>drawDropShadowOn: (in category 'drawing') -----
- drawDropShadowOn: aCanvas
- "Rectangular shadow with support for rounded corners."
-
- | shadowBounds |
- shadowBounds := self shadowOffset isRectangle
- ifTrue: [self bounds outsetBy: self shadowOffset]
- ifFalse: [self bounds translateBy: (self shadowOffset negated max: 0 at 0)].
-
- "Only redraw the shadow if the shadow area is affected."
- ((aCanvas clipRect intersects: shadowBounds) and: [((self bounds insetBy: (self wantsRoundedCorners ifFalse: [0] ifTrue: [self cornerRadius])) containsRect: aCanvas clipRect) not])
- ifTrue: [
- (self hasProperty: #dropShadow)
- ifFalse: [self updateDropShadowCache].
- aCanvas
- translucentImage: (self valueOfProperty: #dropShadow)
- at: shadowBounds topLeft].!
Item was removed:
- ----- Method: Morph>>drawErrorOn: (in category 'drawing') -----
- drawErrorOn: aCanvas
- "The morph (or one of its submorphs) had an error in its drawing method."
- | saneBounds |
- saneBounds := bounds rounded.
- aCanvas
- frameAndFillRectangle: saneBounds
- fillColor: Color red
- borderWidth: 1
- borderColor: Color yellow.
- aCanvas line: saneBounds topLeft to: saneBounds bottomRight width: 1 color: Color yellow.
- aCanvas line: saneBounds topRight to: saneBounds bottomLeft width: 1 color: Color yellow.!
Item was removed:
- ----- Method: Morph>>drawKeyboardFocusIndicationOn: (in category 'drawing') -----
- drawKeyboardFocusIndicationOn: aCanvas
-
- self wantsRoundedCorners
- ifTrue: [aCanvas frameRoundRect: self bounds radius: self cornerRadius width: self keyboardFocusWidth + self borderWidth color: self keyboardFocusColor]
- ifFalse: [aCanvas frameRectangle: self bounds width: self keyboardFocusWidth + self borderWidth color: self keyboardFocusColor].!
Item was removed:
- ----- Method: Morph>>drawMouseDownHighlightOn: (in category 'drawing') -----
- drawMouseDownHighlightOn: aCanvas
-
- self highlightedForMouseDown ifTrue: [
- self wantsRoundedCorners
- ifTrue: [aCanvas frameRoundRect: self fullBounds radius: self cornerRadius width: 1 color: self color darker darker]
- ifFalse: [aCanvas frameRectangle: self fullBounds color: self color darker darker]].!
Item was removed:
- ----- Method: Morph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- self wantsRoundedCorners
- ifTrue: [aCanvas frameAndFillRoundRect: self bounds radius: self cornerRadius fillStyle: self fillStyle borderStyle: self borderStyle]
- ifFalse: [aCanvas frameAndFillRectangle: self bounds fillStyle: self fillStyle borderStyle: self borderStyle].
-
- !
Item was removed:
- ----- Method: Morph>>drawOnCanvas: (in category 'filter streaming') -----
- drawOnCanvas: aCanvas
- ^aCanvas fullDraw: self.
- !
Item was removed:
- ----- Method: Morph>>drawOverlayOn: (in category 'drawing') -----
- drawOverlayOn: aCanvas
- "Draw something over all my submorphs."
-
- self drawDropHighlightOn: aCanvas.
- self drawMouseDownHighlightOn: aCanvas.
-
- (self indicateKeyboardFocus and: [self hasKeyboardFocus])
- ifTrue: [self drawKeyboardFocusIndicationOn: aCanvas].!
Item was removed:
- ----- Method: Morph>>drawPostscriptOn: (in category '*morphic-Postscript Canvases') -----
- drawPostscriptOn: aCanvas
-
- self drawOn:aCanvas.
- !
Item was removed:
- ----- Method: Morph>>drawRolloverBorderOn: (in category 'drawing') -----
- drawRolloverBorderOn: aCanvas
- | colorToUse offsetToUse myShadow newForm f |
- colorToUse := self
- valueOfProperty: #rolloverColor
- ifAbsent: [Color blue alpha: 0.5].
- offsetToUse := self
- valueOfProperty: #rolloverWidth
- ifAbsent: [10 @ 10].
- self hasRolloverBorder: false.
- myShadow := self shadowForm.
- self hasRolloverBorder: true.
- myShadow offset: 0 @ 0.
- f := ColorForm extent: myShadow extent depth: 1.
- myShadow displayOn: f.
- f colors: {Color transparent. colorToUse}.
- newForm := Form extent: offsetToUse * 2 + myShadow extent depth: 32.
- (WarpBlt toForm: newForm) sourceForm: f;
- cellSize: 1;
- combinationRule: 3;
- copyQuad: f boundingBox innerCorners toRect: newForm boundingBox.
-
- self flag: #roundedCorners. "mt: Check for #wantsRoundedCorners and call appropriate things in canvas."
- aCanvas
- translateBy: offsetToUse negated
- during: [:shadowCanvas |
- shadowCanvas shadowColor: colorToUse.
- shadowCanvas paintImage: newForm at: self position]!
Item was removed:
- ----- Method: Morph>>drawSubmorphsOn: (in category 'drawing') -----
- drawSubmorphsOn: aCanvas
- "Display submorphs back to front"
-
- | drawBlock |
- submorphs isEmpty ifTrue: [^self].
- drawBlock := [:canvas | submorphs reverseDo: [:m | canvas fullDrawMorph: m]].
- self clipSubmorphs
- ifTrue: [aCanvas clipBy: self clippingBounds during: drawBlock]
- ifFalse: [drawBlock value: aCanvas]!
Item was removed:
- ----- Method: Morph>>dropEnabled (in category 'dropping/grabbing') -----
- dropEnabled
- "Get this morph's ability to add and remove morphs via drag-n-drop."
- ^(self valueOfProperty: #dropEnabled) == true
- !
Item was removed:
- ----- Method: Morph>>dropEnabled: (in category 'dropping/grabbing') -----
- dropEnabled: aBool
- ^self enableDrop: aBool!
Item was removed:
- ----- Method: Morph>>dropHighlightColor (in category 'dropping/grabbing') -----
- dropHighlightColor
- ^ Color blue!
Item was removed:
- ----- Method: Morph>>dropSuccessColor (in category 'dropping/grabbing') -----
- dropSuccessColor
- ^ Color blue!
Item was removed:
- ----- Method: Morph>>duplicate (in category 'copying') -----
- duplicate
- "Make and return a duplicate of the receiver"
-
- | newMorph aName w aPlayer topRend |
- ((topRend := self topRendererOrSelf) ~~ self) ifTrue: [^ topRend duplicate].
-
- self okayToDuplicate ifFalse: [^ self].
- aName := (w := self world) ifNotNil:
- [w nameForCopyIfAlreadyNamed: self].
- newMorph := self veryDeepCopy.
- aName ifNotNil: [newMorph setNameTo: aName].
-
- newMorph arrangeToStartStepping.
- newMorph privateOwner: nil. "no longer in world"
- newMorph isPartsDonor: false. "no longer parts donor"
- (aPlayer := newMorph player) belongsToUniClass ifTrue:
- [aPlayer class bringScriptsUpToDate].
- aPlayer ifNotNil: [self currentWorld presenter flushPlayerListCache].
- ^ newMorph!
Item was removed:
- ----- Method: Morph>>duplicateMorph: (in category 'meta-actions') -----
- duplicateMorph: evt
- "Make and return a duplicate of the receiver's argument"
- | dup |
- dup := self duplicate.
- evt hand grabMorph: dup from: owner. "duplicate was ownerless so use #grabMorph:from: here"
- ^dup!
Item was removed:
- ----- Method: Morph>>duplicateMorphCollection: (in category 'copying') -----
- duplicateMorphCollection: aCollection
- "Make and return a duplicate of the receiver"
-
- | newCollection names |
-
- names := aCollection collect: [ :ea | | newMorph w |
- (w := ea world) ifNotNil:
- [w nameForCopyIfAlreadyNamed: ea].
- ].
-
- newCollection := aCollection veryDeepCopy.
-
- newCollection with: names do: [ :newMorph :name |
- name ifNotNil: [ newMorph setNameTo: name ].
- newMorph arrangeToStartStepping.
- newMorph privateOwner: nil. "no longer in world"
- newMorph isPartsDonor: false. "no longer parts donor"
- ].
-
- ^newCollection!
Item was removed:
- ----- Method: Morph>>duplicateMorphImage: (in category 'meta-actions') -----
- duplicateMorphImage: evt
- "Make and return a imageMorph of the receiver's argument imageForm"
- | dup |
- dup := self asSnapshotThumbnail withSnapshotBorder.
- dup bounds: self bounds.
- evt hand grabMorph: dup from: owner.
- "duplicate was ownerless so use #grabMorph:from: here"
- ^ dup!
Item was removed:
- ----- Method: Morph>>eToyRejectDropMorph:event: (in category 'WiW support') -----
- eToyRejectDropMorph: morphToDrop event: evt
-
- | tm am |
-
- tm := TextMorph new
- beAllFont: ((TextStyle named: Preferences standardEToysFont familyName) fontOfSize: 24);
- contents: 'GOT IT!!'.
- (am := AlignmentMorph new)
- color: Color yellow;
- layoutInset: 10;
- useRoundedCorners;
- vResizing: #shrinkWrap;
- hResizing: #shrinkWrap;
- addMorph: tm;
- fullBounds;
- position: (self bounds center - (am extent // 2));
- openInWorld: self world.
- SoundService default playSoundNamed: 'yum' ifAbsentReadFrom: 'yum.aif'.
- morphToDrop rejectDropMorphEvent: evt. "send it back where it came from"
- am delete
- !
Item was removed:
- ----- Method: Morph>>editBalloonHelpContent: (in category 'halos and balloon help') -----
- editBalloonHelpContent: aString
- | reply |
- reply := UIManager default
- multiLineRequest: 'Edit the balloon help text for ' translated, self externalName
- centerAt: Sensor cursorPoint
- initialAnswer: (aString ifNil: [self noHelpString] ifNotNil: [aString])
- answerHeight: 200.
- reply ifNil: [^ self]. "User cancelled out of the dialog"
- (reply isEmpty or: [reply asString = self noHelpString])
- ifTrue: [self setBalloonText: nil]
- ifFalse: [self setBalloonText: reply]!
Item was removed:
- ----- Method: Morph>>editBalloonHelpText (in category 'halos and balloon help') -----
- editBalloonHelpText
- "Modify the receiver's balloon help text."
-
- self editBalloonHelpContent: self balloonText!
Item was removed:
- ----- Method: Morph>>embedInWindow (in category 'e-toy support') -----
- embedInWindow
-
- | window worldToUse |
-
- worldToUse := self world. "I'm assuming we are already in a world"
- window := (SystemWindow labelled: self defaultLabelForInspector) model: nil.
- window bounds: ((self position - ((0 at window labelHeight) + window borderWidth))
- corner: self bottomRight + window borderWidth).
- window addMorph: self frame: (0 at 0 extent: 1 at 1).
- window updatePaneColors.
- worldToUse addMorph: window.
- window beKeyWindow.!
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 addMorphFrontFromWorldPosition: self!
Item was removed:
- ----- Method: Morph>>embeddedInMorphicWindowLabeled: (in category 'e-toy support') -----
- embeddedInMorphicWindowLabeled: labelString
- | window |
- window := (SystemWindow labelled: labelString) model: nil.
- window setStripeColorsFrom: Color white.
- window addMorph: self frame: (0 at 0 extent: 1 at 1).
- ^ window!
Item was removed:
- ----- Method: Morph>>enableDrag: (in category 'dropping/grabbing') -----
- enableDrag: aBoolean
- self setProperty: #dragEnabled toValue: aBoolean!
Item was removed:
- ----- Method: Morph>>enableDragNDrop (in category 'dropping/grabbing') -----
- enableDragNDrop
- self enableDragNDrop: true!
Item was removed:
- ----- Method: Morph>>enableDragNDrop: (in category 'dropping/grabbing') -----
- enableDragNDrop: aBoolean
- "Set both properties at once"
- self separateDragAndDrop.
- self enableDrag: aBoolean.
- self enableDrop: aBoolean.!
Item was removed:
- ----- Method: Morph>>enableDrop: (in category 'dropping/grabbing') -----
- enableDrop: aBoolean
- self setProperty: #dropEnabled toValue: aBoolean!
Item was removed:
- ----- Method: Morph>>encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: (in category '*Morphic-Sound-piano rolls') -----
- encounteredAtTime: ticks inScorePlayer: scorePlayer atIndex: index inEventTrack: track secsPerTick: secsPerTick
-
- "a hack to allow for abitrary morphs to be dropped into piano roll"
- self triggerActionFromPianoRoll.!
Item was removed:
- ----- Method: Morph>>eventBubbleFilters (in category 'events-filtering-bubbling') -----
- eventBubbleFilters
- ^ self valueOfProperty: #eventBubbleFilters!
Item was removed:
- ----- Method: Morph>>eventBubbleFilters: (in category 'events-filtering-bubbling') -----
- eventBubbleFilters: anArrayOrNil
- ^ self setProperty: #eventBubbleFilters toValue: anArrayOrNil!
Item was removed:
- ----- Method: Morph>>eventCaptureFilters (in category 'events-filtering-capturing') -----
- eventCaptureFilters
- ^ self valueOfProperty: #eventCaptureFilters!
Item was removed:
- ----- Method: Morph>>eventCaptureFilters: (in category 'events-filtering-capturing') -----
- eventCaptureFilters: anArrayOrNil
- ^ self setProperty: #eventCaptureFilters toValue: anArrayOrNil!
Item was removed:
- ----- Method: Morph>>eventFilterDocumentation (in category 'events-filtering') -----
- eventFilterDocumentation
- "
- Event filters represent a mechanism to intercept events *before* morphs get the chance to handle them. So, there are still event handlers, which are usually the morphs themselves. However, morphs can also be their own event filters. One application of event filters is keyboard shortcuts. Such filters should invoke the shortcut but ignore the original event to *be sure* that no other morph ever handles that. System windows have window shortcuts. The world has world shortcuts.
-
- When user input events are dispatched, there is a capturing phase and a bubbling phase. This dispatching behavior is described in MorphicEventDispatcher. Capturing means that we are looking for the handler (resp. morph) to handle the event, traversing submorph hierarchy. Bubbling means that once a morph handled the event, all owners get also the chance to handle that event *if* they honor the #wasHandled flag.. Event filters can be attached to any morph for the capturing or the bubbling phase. See it as code that is execute before/after the event handlers.
-
- Event filters are objects that implement #filterEvent:for:. All objects understand that message but do nothing. There is a PluggableEventFilter for a more dynamic programming approach.
-
- Morphic hands have specific focus holders. There is a keyboard focus and a mouse focus. For example, text morphs are good candidates for holders of the keyboard focus. Both foci bypass the traditional event capturing phase, which usually start at the world morph. However, capture filters are also apply before handling the focus event. See Morph >> #handleFocusEvent: for that. Note that after handling the focus event, events do bubble along their owners, which usually do nothing if they honor the #wasHandled flag, and hence all bubble event filters are executed unless events get ignored. Thus, we mimick the behavior of MorphicEventDispatcher in #handleFocusEvent:.
-
- There are event filters for all kinds of events, filters for keyboard events, and filters for mouse events. You can always install generic event filters and then check for the particular event type in that filter. However, it is good style to not install keyboard event filters as generic event filters. It makes code more readable.
-
- You can install global event capture filters in instances of HandMorph. For example, Project current world firstHand provides access to the project's world's hand. Avoid using globals such as ActiveHand or ActiveWorld. BEWARE that global event filters can have unexpected effects and may be difficult to debug. Note that you cannot install global event bubble filters in the HandMorph. You have to install such a filter in the world because hands are not part of the event bubbling phase.
-
- For an example of keyboard capturing filters see SystemWindow >> #addKeyboardShortcuts and SystemWindow >> #filterEvent:for:. You can also take a look at: PasteUpMorph >> #addKeyboardShortcuts and PasteUpMorph >> #filterEvent:for: and DockingBarMorph >> #filterEvent:for: for a more elaborate example.
-
- Event filters include all the behavior of event listeners. An event listener converted to an event filter would be a global event capture filter that sents a copy of the event to itself:
-
- | listenerFilter someMorph |
- someMorph := Morph new.
- listenerFilter := PluggableEventFilter on: [:event :target | event copy sentTo: someMorph. event].
- Project current world activeHand addEventCaptureFilter: listenerFilter.
-
- Instead of:
-
- | someMorph |
- someMorph := Morph new.
- Project current world activeHand addEventListener: someMorph.
-
- The filter version might look more complicated than the traditional listener version but note that it is quite rare to install global event filters. The example for keyboard shortcuts reflects the simplicity of event filters."!
Item was removed:
- ----- Method: Morph>>eventHandler (in category 'accessing') -----
- eventHandler
- "answer the receiver's eventHandler"
- ^ extension ifNotNil: [extension eventHandler] !
Item was removed:
- ----- Method: Morph>>eventHandler: (in category 'accessing') -----
- eventHandler: anEventHandler
- "Note that morphs can share eventHandlers and all is OK. "
- self assureExtension eventHandler: anEventHandler!
Item was removed:
- ----- Method: Morph>>expandFullBoundsForDropShadow: (in category 'drawing') -----
- expandFullBoundsForDropShadow: aRectangle
- "Return an expanded rectangle for an eventual drop shadow"
- | delta box |
-
- self shadowOffset isRectangle
- ifTrue: [^ aRectangle outsetBy: self shadowOffset].
-
- box := aRectangle.
- delta := self shadowOffset.
- box := delta x >= 0
- ifTrue:[box right: aRectangle right + delta x]
- ifFalse:[box left: aRectangle left + delta x].
- box := delta y >= 0
- ifTrue:[box bottom: aRectangle bottom + delta y]
- ifFalse:[box top: aRectangle top + delta y].
- ^box!
Item was removed:
- ----- Method: Morph>>expandFullBoundsForRolloverBorder: (in category 'drawing') -----
- expandFullBoundsForRolloverBorder: aRectangle
- | delta |
- delta := self valueOfProperty: #rolloverWidth ifAbsent: [10 at 10].
- ^aRectangle expandBy: delta.
-
- !
Item was removed:
- ----- Method: Morph>>exploreInMorphic (in category 'menus') -----
- exploreInMorphic
-
- ToolSet explore: self.!
Item was removed:
- ----- Method: Morph>>exploreInMorphic: (in category 'menus') -----
- exploreInMorphic: evt
-
- ToolSet explore: self.!
Item was removed:
- ----- Method: Morph>>exportAsBMP (in category 'menus') -----
- exportAsBMP
- | fName |
- fName := UIManager default saveFilenameRequest:'Please enter the name' translated initialAnswer: self externalName,'.bmp'.
- fName ifNil:[^self].
- self exportAsBMPNamed: fName!
Item was removed:
- ----- Method: Morph>>exportAsBMPNamed: (in category 'menus') -----
- exportAsBMPNamed: aString
- self imageForm writeBMPfileNamed: aString!
Item was removed:
- ----- Method: Morph>>exportAsGIF (in category 'menus') -----
- exportAsGIF
- | fName |
- fName := UIManager default saveFilenameRequest:'Please enter the name' translated initialAnswer: self externalName,'.gif'.
- fName ifNil:[^self].
- self exportAsGIFNamed: fName!
Item was removed:
- ----- Method: Morph>>exportAsGIFNamed: (in category 'menus') -----
- exportAsGIFNamed: aString
- GIFReadWriter
- putForm: self imageForm
- onFileNamed: aString!
Item was removed:
- ----- Method: Morph>>exportAsJPEG (in category 'menus') -----
- exportAsJPEG
- | fName |
- fName := UIManager default saveFilenameRequest: 'Please enter the name' translated initialAnswer: self externalName,'.jpeg'.
- fName ifNil: [^ self].
- self exportAsJPEGNamed: fName!
Item was removed:
- ----- Method: Morph>>exportAsJPEGNamed: (in category 'menus') -----
- exportAsJPEGNamed: aString
- self imageForm writeJPEGfileNamed: aString!
Item was removed:
- ----- Method: Morph>>exportAsPNG (in category 'menus') -----
- exportAsPNG
- | fName |
- fName := UIManager default saveFilenameRequest:'Please enter the name' translated initialAnswer: self externalName,'.png'.
- fName ifNil:[^self].
- self exportAsPNGNamed: fName!
Item was removed:
- ----- Method: Morph>>exportAsPNGNamed: (in category 'menus') -----
- exportAsPNGNamed: aString
- PNGReadWriter
- putForm: self imageForm
- onFileNamed: aString!
Item was removed:
- ----- Method: Morph>>extension (in category 'accessing - extension') -----
- extension
- "answer the recevier's extension"
- ^ extension!
Item was removed:
- ----- Method: Morph>>extent (in category 'geometry') -----
- extent
-
- ^ bounds extent!
Item was removed:
- ----- Method: Morph>>extent: (in category 'geometry') -----
- extent: aPoint
-
- (bounds extent closeTo: aPoint) ifTrue: [^ self].
- self changed.
- bounds := (bounds topLeft extent: aPoint) rounded.
- self removeProperty: #dropShadow.
- self layoutChanged.
- self changed.
- !
Item was removed:
- ----- Method: Morph>>externalName (in category 'viewer') -----
- externalName
- ^ self knownName ifNil: [self innocuousName]!
Item was removed:
- ----- Method: Morph>>fillStyle (in category 'visual properties') -----
- fillStyle
- "Return the current fillStyle of the receiver."
- ^ self
- valueOfProperty: #fillStyle
- ifAbsent: ["Workaround already converted morphs"
- color
- ifNil: [self defaultColor]]!
Item was removed:
- ----- Method: Morph>>fillStyle: (in category 'visual properties') -----
- fillStyle: aFillStyle
- "Set the current fillStyle of the receiver."
- self setProperty: #fillStyle toValue: aFillStyle.
- "Workaround for Morphs not yet converted"
- color := aFillStyle asColor.
- self borderStyle trackColorFrom: self.
- self changed.!
Item was removed:
- ----- Method: Morph>>fillWithRamp:oriented: (in category 'visual properties') -----
- fillWithRamp: rampSpecsOrColor oriented: aRatio
- rampSpecsOrColor isColor
- ifTrue: [self color: rampSpecsOrColor".
- self borderColor: rampSpecsOrColor muchDarker"]
- ifFalse: [| fill |
- fill := GradientFillStyle ramp: rampSpecsOrColor.
- fill origin: self bounds topLeft.
- fill direction: (self bounds extent * aRatio) truncated.
- fill radial: false.
- self fillStyle: fill.
- self borderColor: (rampSpecsOrColor first value mixed: 0.5 with: rampSpecsOrColor last value) muchDarker]!
Item was removed:
- ----- Method: Morph>>findA: (in category 'submorphs - misc') -----
- findA: aClass
- "Return the first submorph of the receiver that is descended from the given class. Return nil if there is no such submorph. Clients of this code should always check for a nil return value so that the code will be robust if the user takes the morph apart."
-
- ^self submorphs
- detect: [:p | p isKindOf: aClass]
- ifNone: [nil]!
Item was removed:
- ----- Method: Morph>>findDeepSubmorphThat:ifAbsent: (in category 'submorphs - misc') -----
- findDeepSubmorphThat: block1 ifAbsent: block2
- self
- allMorphsDo: [:m | (block1 value: m)
- == true ifTrue: [^ m]].
- ^ block2 value!
Item was removed:
- ----- Method: Morph>>findDeeplyA: (in category 'submorphs - misc') -----
- findDeeplyA: aClass
- "Return a morph in the submorph tree of the receiver that is descended from the given class. Return nil if there is no such morph. Clients of this code should always check for a nil return value so that the code will be robust if the user takes the morph apart."
-
- ^ (self allMorphs copyWithout: self)
- detect: [:p | p isKindOf: aClass]
- ifNone: [nil]!
Item was removed:
- ----- Method: Morph>>findSubmorphBinary: (in category 'submorphs - misc') -----
- findSubmorphBinary: aBlock
- "Use binary search for finding a specific submorph of the receiver. Caller must be certain that the ordering holds for the submorphs."
- ^submorphs findBinary: aBlock ifNone:[nil].!
Item was removed:
- ----- Method: Morph>>firstClickTimedOut: (in category 'event handling') -----
- firstClickTimedOut: evt
- "Useful for double-click candidates who want to know whether or not the click is a single or double. In this case, ignore the #click: and wait for either this or #doubleClick:"
-
- !
Item was removed:
- ----- Method: Morph>>firstOwnerSuchThat: (in category 'structure') -----
- firstOwnerSuchThat: conditionBlock
-
- self allOwnersDo: [:m | (conditionBlock value: m) ifTrue: [^ m]].
- ^ nil
- !
Item was removed:
- ----- Method: Morph>>firstSubmorph (in category 'submorphs - accessing') -----
- firstSubmorph
- ^submorphs first!
Item was removed:
- ----- Method: Morph>>flash (in category 'macpal') -----
- flash
- | originalColor |
- originalColor := self color.
- [ self color:
- (originalColor
- ifNil: [ Color black ]
- ifNotNil: [( (originalColor alpha: 1) adjustSaturation: 0.8 brightness: 0) negated ]) ]
- ensure:
- [ self refreshWorld.
- self color: originalColor ]!
Item was removed:
- ----- Method: Morph>>flashBounds (in category 'drawing') -----
- flashBounds
- "Flash the receiver's bounds -- does not use the receiver's color, thus works with StringMorphs and SketchMorphs, etc., for which #flash is useless. No senders initially, but useful to send this from a debugger or inspector"
-
- 5 timesRepeat:
- [Display flash: self boundsInWorld andWait: 120]!
Item was removed:
- ----- Method: Morph>>formerOwner (in category 'dropping/grabbing') -----
- formerOwner
- ^self valueOfProperty: #formerOwner!
Item was removed:
- ----- Method: Morph>>formerOwner: (in category 'dropping/grabbing') -----
- formerOwner: aMorphOrNil
- aMorphOrNil
- ifNil: [self removeProperty: #formerOwner]
- ifNotNil: [self setProperty: #formerOwner toValue: aMorphOrNil]!
Item was removed:
- ----- Method: Morph>>formerPosition (in category 'dropping/grabbing') -----
- formerPosition
- ^self valueOfProperty: #formerPosition!
Item was removed:
- ----- Method: Morph>>formerPosition: (in category 'dropping/grabbing') -----
- formerPosition: formerPosition
- formerPosition
- ifNil: [self removeProperty: #formerPosition]
- ifNotNil: [self setProperty: #formerPosition toValue: formerPosition]!
Item was removed:
- ----- Method: Morph>>forwardDirection (in category 'rotate scale and flex') -----
- forwardDirection
- "Return the receiver's offset to distinguish #heading from #rotationDegrees."
-
- ^ self valueOfProperty: #forwardDirection ifAbsent: [0.0]!
Item was removed:
- ----- Method: Morph>>forwardDirection: (in category 'rotate scale and flex') -----
- forwardDirection: newDirection
-
- self setProperty: #forwardDirection toValue: newDirection.!
Item was removed:
- ----- Method: Morph>>fullBounds (in category 'layout') -----
- fullBounds
- "Return the bounding box of the receiver and all its children. Recompute the layout if necessary. See #layoutChanged."
-
- ^ fullBounds ifNil: [self doLayoutSafely. fullBounds]!
Item was removed:
- ----- Method: Morph>>fullBoundsInWorld (in category 'geometry - local/global') -----
- fullBoundsInWorld
- ^self bounds: self fullBounds in: self world!
Item was removed:
- ----- Method: Morph>>fullContainsPoint: (in category 'geometry testing') -----
- fullContainsPoint: aPoint
-
- (self fullBounds containsPoint: aPoint) ifFalse: [^ false]. "quick elimination"
- (self containsPoint: aPoint) ifTrue: [^ true]. "quick acceptance"
- submorphs do: [:m | (m fullContainsPoint: aPoint) ifTrue: [^ true]].
- ^ false
- !
Item was removed:
- ----- Method: Morph>>fullDrawOn: (in category 'drawing') -----
- fullDrawOn: aCanvas
- "Draw the full Morphic structure on the given Canvas"
-
- self visible ifFalse: [^ self].
- (aCanvas isVisible: self fullBounds) ifFalse:[^self].
- (self hasProperty: #errorOnDraw) ifTrue:[^self drawErrorOn: aCanvas].
- "Note: At some point we should generalize this into some sort of
- multi-canvas so that we can cross-optimize some drawing operations."
-
- "Pass 1: Draw eventual drop-shadow"
- self hasDropShadow ifTrue: [self drawDropShadowOn: aCanvas].
- (self hasRolloverBorder and: [(aCanvas seesNothingOutside: self bounds) not])
- ifTrue: [self drawRolloverBorderOn: aCanvas].
-
- "Pass 2: Draw receiver itself"
- (aCanvas isVisible: self bounds) ifTrue:[aCanvas drawMorph: self].
- self drawSubmorphsOn: aCanvas.
- self drawOverlayOn: aCanvas.!
Item was removed:
- ----- Method: Morph>>fullDrawPostscriptOn: (in category '*morphic-Postscript Canvases') -----
- fullDrawPostscriptOn: aCanvas
-
- self fullDrawOn:aCanvas.
- !
Item was removed:
- ----- Method: Morph>>fullLoadCachedState (in category 'caching') -----
- fullLoadCachedState
- "Load the cached state of the receiver and its full submorph tree."
-
- self allMorphsDo: [:m | m loadCachedState].
- !
Item was removed:
- ----- Method: Morph>>fullPrintOn: (in category 'printing') -----
- fullPrintOn: aStream
-
- aStream nextPutAll: self class name , ' newBounds: (';
- print: bounds;
- nextPutAll: ') color: ' , (self colorString: color)!
Item was removed:
- ----- Method: Morph>>fullReleaseCachedState (in category 'caching') -----
- fullReleaseCachedState
- "Release the cached state of the receiver and its full submorph tree."
-
- self allMorphsDo: [:m | m releaseCachedState].
- !
Item was removed:
- ----- Method: Morph>>getNumericValue (in category 'e-toy support') -----
- getNumericValue
- "Only certain kinds of morphs know how to deal with this frontally; here we provide support for a numeric property of any morph"
-
- ^ self valueOfProperty: #numericValue ifAbsent: [0]!
Item was removed:
- ----- Method: Morph>>globalPointToLocal: (in category 'geometry - local/global') -----
- globalPointToLocal: aPoint
- ^self point: aPoint from: nil!
Item was removed:
- ----- Method: Morph>>goBehind (in category 'submorphs - add/remove') -----
- goBehind
- "Move the receiver to bottom z-order."
-
- | topRend |
- topRend := self topRendererOrSelf.
- topRend owner ifNotNil:
- [:own | own addMorphNearBack: topRend]
- !
Item was removed:
- ----- Method: Morph>>grabMorph: (in category 'meta-actions') -----
- grabMorph: evt
-
- evt hand grabMorph: self!
Item was removed:
- ----- Method: Morph>>grabTransform (in category 'dropping/grabbing') -----
- grabTransform
- "Return the transform for the receiver which should be applied during grabbing"
- ^owner ifNil:[IdentityTransform new] ifNotNil:[owner grabTransform]!
Item was removed:
- ----- Method: Morph>>gridFormOrigin:grid:background:line: (in category 'e-toy support') -----
- gridFormOrigin: origin grid: smallGrid background: backColor line: lineColor
-
- | bigGrid gridForm gridOrigin |
- gridOrigin := origin \\ smallGrid.
- bigGrid := (smallGrid asPoint x) @ (smallGrid asPoint y).
- gridForm := Form extent: bigGrid depth: Display depth.
- backColor ifNotNil: [gridForm fillWithColor: backColor].
- gridOrigin x to: gridForm width by: smallGrid x do:
- [:x | gridForm fill: (x at 0 extent: 1 at gridForm height) fillColor: lineColor].
- gridOrigin y to: gridForm height by: smallGrid y do:
- [:y | gridForm fill: (0 at y extent: gridForm width at 1) fillColor: lineColor].
- ^ InfiniteForm with: gridForm
- !
Item was removed:
- ----- Method: Morph>>gridModulus (in category 'layout properties - grid') -----
- gridModulus
- "Layout specific. This property describes how the cell size in the grid."
-
- ^ self layoutProperties ifNil: [8 at 8] ifNotNil: [:properties | properties modulus]!
Item was removed:
- ----- Method: Morph>>gridModulus: (in category 'layout properties - grid') -----
- gridModulus: aPoint
- "Layout specific. This property describes how the cell size in the grid."
-
- self assureGridLayoutProperties modulus: aPoint.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>gridOrigin (in category 'layout properties - grid') -----
- gridOrigin
- "Layout specific. This property describes the offset in the grid."
-
- ^ self layoutProperties ifNil: [0 at 0] ifNotNil: [:properties | properties origin]!
Item was removed:
- ----- Method: Morph>>gridOrigin: (in category 'layout properties - grid') -----
- gridOrigin: aPoint
- "Layout specific. This property describes the offset in the grid."
-
- self assureGridLayoutProperties origin: aPoint.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>hResizing (in category 'layout properties') -----
- hResizing
- "Layout specific. This property describes how the receiver should be resized with respect to its owner and its children. Possible values are:
- #rigid - do not resize the receiver
- #spaceFill - resize to fill owner's available space
- #shrinkWrap - resize to fit children
- "
- | props |
- props := self layoutProperties.
- ^props ifNil:[#rigid] ifNotNil:[props hResizing].!
Item was removed:
- ----- Method: Morph>>hResizing: (in category 'layout properties') -----
- hResizing: aSymbol
- "Layout specific. This property describes how the receiver should be resized with respect to its owner and its children. Possible values are:
- #rigid - do not resize the receiver
- #spaceFill - resize to fill owner's available space
- #shrinkWrap - resize to fit children
- "
- self checkResizingProperty: aSymbol.
- self assureLayoutProperties hResizing: aSymbol.
- self layoutChanged.
- !
Item was removed:
- ----- Method: Morph>>hResizingString: (in category 'layout-menu') -----
- hResizingString: aSymbol
- ^self layoutMenuPropertyString: aSymbol from: self hResizing!
Item was removed:
- ----- Method: Morph>>halo (in category 'halos and balloon help') -----
- halo
-
- (self outermostWorldMorph ifNil: [^nil]) haloMorphs do: [:h | h target == self ifTrue: [^ h]].
- ^ nil!
Item was removed:
- ----- Method: Morph>>haloClass (in category 'halos and balloon help') -----
- haloClass
- "Answer the name of the desired kind of HaloMorph to launch on behalf of the receiver"
-
- ^ #HaloMorph
- !
Item was removed:
- ----- Method: Morph>>haloDelayTime (in category 'halos and balloon help') -----
- haloDelayTime
- "Return the number of milliseconds before a halo should be put up on the receiver. The halo will only be put up if the receiver responds to #wantsHalo by returning true."
- ^800!
Item was removed:
- ----- Method: Morph>>handUserASibling (in category 'e-toy support') -----
- handUserASibling
- "Make and hand the user a sibling instance. Force the creation of a uniclass at this point if one does not already exist for the receiver."
-
- | topRend |
- topRend := self topRendererOrSelf.
- topRend couldMakeSibling ifFalse: [^ Beeper beep].
-
- topRend assuredPlayer assureUniClass.
- (topRend makeSiblings: 1) first openInHand!
Item was removed:
- ----- Method: Morph>>handleDropMorph: (in category 'events-processing') -----
- handleDropMorph: anEvent
- "Handle a dropping morph."
- | aMorph localPt |
- anEvent wasHandled ifTrue: [^ self]. "Not interested"
- aMorph := anEvent contents.
- "Do a symmetric check if both morphs like each other"
- ((self wantsDroppedMorph: aMorph event: anEvent) "I want her"
- and: [aMorph wantsToBeDroppedInto: self]) "she wants me"
- ifFalse: [aMorph removeProperty: #undoGrabCommand.
- ^ self].
- anEvent wasHandled: true.
- "Transform the morph into the receiver's coordinate frame. This is currently incomplete since it only takes the offset into account where it really should take the entire transform."
- localPt := (self transformedFrom: anEvent hand world) "full transform down"
- globalPointToLocal: aMorph referencePosition.
- aMorph referencePosition: localPt.
- self acceptDroppingMorph: aMorph event: anEvent.
- aMorph justDroppedInto: self event: anEvent.
- !
Item was removed:
- ----- Method: Morph>>handleEvent: (in category 'events-processing') -----
- handleEvent: anEvent
- "Apply event filters and then handle the resulting event. We have to return the event to chain filters."
-
- | filteredEvent |
- filteredEvent := self sendFilterEventBubble: anEvent for: self.
- filteredEvent wasIgnored ifFalse: [filteredEvent sentTo: self].
- ^ filteredEvent!
Item was removed:
- ----- Method: Morph>>handleFocusEvent: (in category 'events-processing') -----
- handleFocusEvent: anEvent
- "Handle the given event. This message is sent if the receiver currently has the focus and is therefore receiving events directly from some hand. However, it might already have been handled due to overrides in #processFocusEvent:using:. We might want to get rid of this call-back in the future..."
-
- ^ anEvent wasHandled
- ifTrue: [anEvent]
- ifFalse: [self handleEvent: anEvent]!
Item was removed:
- ----- Method: Morph>>handleKeyDown: (in category 'events-processing') -----
- handleKeyDown: anEvent
- "System level event handling."
- anEvent wasHandled ifTrue: [^ self].
- (self handlesKeyboard: anEvent) ifFalse: [^ self].
- (anEvent hand keyboardFocus ~~ self
- and: [self handlesKeyboardOnlyOnFocus])
- ifTrue: [^ self].
-
- anEvent wasHandled: true.
- ^ self keyDown: anEvent!
Item was removed:
- ----- Method: Morph>>handleKeyUp: (in category 'events-processing') -----
- handleKeyUp: anEvent
- "System level event handling."
- anEvent wasHandled ifTrue: [^ self].
- (self handlesKeyboard: anEvent) ifFalse: [^ self].
- (anEvent hand keyboardFocus ~~ self
- and: [self handlesKeyboardOnlyOnFocus])
- ifTrue: [^ self].
-
- anEvent wasHandled: true.
- ^ self keyUp: anEvent!
Item was removed:
- ----- Method: Morph>>handleKeystroke: (in category 'events-processing') -----
- handleKeystroke: anEvent
- "System level event handling. Has support for automatically grabbing the keyboard focus considering the keyboard focus delegate. See #newKeyboardFocus:"
-
- | handler |
- anEvent wasHandled ifTrue: [^ self].
- (self handlesKeyboard: anEvent) ifFalse: [^ self].
- (anEvent hand keyboardFocus ~~ self
- and: [self handlesKeyboardOnlyOnFocus])
- ifTrue: [^ self].
-
- handler := self wantsKeyboardFocus
- ifFalse: [self]
- ifTrue: [(anEvent hand newKeyboardFocus: self) ifNil: [self]].
- anEvent handler: handler.
-
- anEvent wasHandled: true.
- ^ handler keyStroke: anEvent!
Item was removed:
- ----- Method: Morph>>handleListenEvent: (in category 'events-processing') -----
- handleListenEvent: anEvent
- "Handle the given event. This message is sent if the receiver is a registered listener for the given event."
- ^anEvent sentTo: self.!
Item was removed:
- ----- Method: Morph>>handleMouseDown: (in category 'events-processing') -----
- handleMouseDown: anEvent
- "System level event handling."
- anEvent wasHandled ifTrue:[^self]. "not interested"
- anEvent hand removePendingBalloonFor: self.
- anEvent hand removePendingHaloFor: self.
- anEvent wasHandled: true.
-
- "Make me modal during mouse transitions"
- anEvent hand newMouseFocus: self event: anEvent.
-
- "this mouse down could be the start of a gesture, or the end of a gesture focus"
- (self isGestureStart: anEvent)
- ifTrue: [^ self gestureStart: anEvent].
-
- self mouseDown: anEvent.
-
- (self handlesMouseStillDown: anEvent) ifTrue:[
- self startStepping: #handleMouseStillDown:
- at: Time millisecondClockValue + self mouseStillDownThreshold
- arguments: {anEvent copy resetHandlerFields}
- stepTime: self mouseStillDownStepRate ].
- !
Item was removed:
- ----- Method: Morph>>handleMouseEnter: (in category 'events-processing') -----
- handleMouseEnter: anEvent
- "System level event handling."
- (anEvent isDraggingEvent) ifTrue:[
- (self handlesMouseOverDragging: anEvent) ifTrue:[
- anEvent wasHandled: true.
- self mouseEnterDragging: anEvent].
- ^self].
- self wantsHalo "If receiver wants halo and balloon, trigger balloon after halo"
- ifTrue:[anEvent hand triggerHaloFor: self after: self haloDelayTime]
- ifFalse:[self wantsBalloon
- ifTrue:[anEvent hand triggerBalloonFor: self after: self balloonHelpDelayTime]].
- (self handlesMouseOver: anEvent) ifTrue:[
- anEvent wasHandled: true.
- self mouseEnter: anEvent.
- ].!
Item was removed:
- ----- Method: Morph>>handleMouseLeave: (in category 'events-processing') -----
- handleMouseLeave: anEvent
- "System level event handling."
- anEvent hand removePendingBalloonFor: self.
- anEvent hand removePendingHaloFor: self.
- anEvent isDraggingEvent ifTrue:[
- (self handlesMouseOverDragging: anEvent) ifTrue:[
- anEvent wasHandled: true.
- self mouseLeaveDragging: anEvent].
- ^self].
- (self handlesMouseOver: anEvent) ifTrue:[
- anEvent wasHandled: true.
- self mouseLeave: anEvent.
- ].
- !
Item was removed:
- ----- Method: Morph>>handleMouseMove: (in category 'events-processing') -----
- handleMouseMove: anEvent
- "System level event handling."
- anEvent wasHandled ifTrue: [ ^ self ].
- "not interested"
- (self handlesMouseMove: anEvent) ifFalse: [ ^ self ].
- anEvent wasHandled: true.
- self mouseMove: anEvent.
- (self handlesMouseStillDown: anEvent) ifTrue:
- [ "Step at the new location"
- self
- startStepping: #handleMouseStillDown:
- at: Time millisecondClockValue
- arguments: {anEvent copy resetHandlerFields}
- stepTime: self mouseStillDownStepRate ]!
Item was removed:
- ----- Method: Morph>>handleMouseOver: (in category 'events-processing') -----
- handleMouseOver: anEvent
- "System level event handling."
- anEvent hand mouseFocus == self ifTrue:[
- "Got this directly through #handleFocusEvent: so check explicitly"
- (self containsPoint: anEvent position event: anEvent) ifFalse:[^self]].
- anEvent hand noticeMouseOver: self event: anEvent!
Item was removed:
- ----- Method: Morph>>handleMouseStillDown: (in category 'events-processing') -----
- handleMouseStillDown: anEvent
- "Called from the stepping mechanism for morphs wanting continuously repeated 'yes the mouse is still down, yes it is still down, yes it has not changed yet, no the mouse is still not up, yes the button is down' etc messages"
- (anEvent hand mouseFocus == self)
- ifFalse:[^self stopSteppingSelector: #handleMouseStillDown:].
- self mouseStillDown: anEvent.
- !
Item was removed:
- ----- Method: Morph>>handleMouseUp: (in category 'events-processing') -----
- handleMouseUp: anEvent
- "System level event handling."
- anEvent wasHandled ifTrue:[^self]. "not interested"
- anEvent hand mouseFocus == self ifFalse:[^self]. "Not interested in other parties"
- anEvent hand releaseMouseFocus: self.
- anEvent wasHandled: true.
- self mouseUp: anEvent.
- self stopSteppingSelector: #handleMouseStillDown:.!
Item was removed:
- ----- Method: Morph>>handleMouseWheel: (in category 'events-processing') -----
- handleMouseWheel: anEvent
- "System level event handling."
-
- anEvent wasHandled ifTrue: [^self].
- (self handlesMouseWheel: anEvent) ifFalse: [^ self].
- anEvent wasHandled: true.
- ^ self mouseWheel: anEvent!
Item was removed:
- ----- Method: Morph>>handleUnknownEvent: (in category 'events-processing') -----
- handleUnknownEvent: anEvent
- "An event of an unknown type was sent to the receiver. What shall we do?!!"
- Beeper beep.
- anEvent printString displayAt: 0 at 0.
- anEvent wasHandled: true.!
Item was removed:
- ----- Method: Morph>>handleWindowEvent: (in category 'events-processing') -----
- handleWindowEvent: anEvent
- "Handle an event concerning our host window"
- anEvent wasHandled ifTrue:[^self]. "not interested"
- (self wantsWindowEvent: anEvent) ifFalse:[^self].
- anEvent wasHandled: true.
- self windowEvent: anEvent.
- !
Item was removed:
- ----- Method: Morph>>handledOwnDraggingBy:on: (in category 'dropping/grabbing') -----
- handledOwnDraggingBy: aHandMorph on: aCanvas
- "this is my chance to do something differrent to the normal dragging work. return true if I did what I wanted, false if not"
- ^false!
Item was removed:
- ----- Method: Morph>>handlerForMouseDown: (in category 'event handling') -----
- handlerForMouseDown: anEvent
- "Return the (prospective) handler for a mouse down event. The handler is temporarily
- installed and can be used for morphs further down the hierarchy to negotiate whether
- the inner or the outer morph should finally handle the event."
-
- anEvent yellowButtonPressed
- ifTrue: [^ self handlerForYellowButtonDown: anEvent].
- (self handlesMouseDown: anEvent)
- ifFalse: [^ nil]. "not interested"
-
- anEvent handler
- ifNil: [^ self ]. "Same priority but I am innermost"
-
- "Nobody else was interested"
- ^self mouseDownPriority >= anEvent handler mouseDownPriority
- ifTrue: [ self]
- ifFalse: [ nil]!
Item was removed:
- ----- Method: Morph>>handlerForYellowButtonDown: (in category 'event handling') -----
- handlerForYellowButtonDown: anEvent
- "Return the (prospective) handler for a mouse down event with the yellow button pressed.
- The handler is temporarily installed and can be used for morphs further
- down the hierarchy to negotiate whether the inner or the outer
- morph should finally handle the event."
-
- (self hasYellowButtonMenu or: [ self handlesMouseDown: anEvent ])
- ifFalse: [ ^ nil]. "Not interested."
-
- anEvent handler
- ifNil: [^ self]. "Nobody else was interested"
-
- "Same priority but I am innermost."
- ^ self mouseDownPriority >= anEvent handler mouseDownPriority
- ifFalse: [nil ]
- ifTrue: [self]!
Item was removed:
- ----- Method: Morph>>handlesDisplayScaleChangedBy: (in category 'display scale') -----
- handlesDisplayScaleChangedBy: factor
- "Answer whether the receiver wants to be informed about a changed display scale so that it can update pixel-based measures or invalidate caches."
-
- ^ false!
Item was removed:
- ----- Method: Morph>>handlesKeyboard: (in category 'event handling') -----
- handlesKeyboard: evt
- "Return true if the receiver wishes to handle the given keyboard event"
- self eventHandler ifNotNil: [^ self eventHandler handlesKeyboard: evt].
- ^ false
- !
Item was removed:
- ----- Method: Morph>>handlesKeyboardOnlyOnFocus (in category 'event handling') -----
- handlesKeyboardOnlyOnFocus
- "If set, reject every keyboard event until the receiver has received the keyboard focus in another way, i.e. a mouse click (see #mouseDown:) or programmatic focusing (see HandMorph >> #newKeyboardFocus:). This allows sending keyboard events to any owner of the receiver while the receiver is hovered by the hand. See senders.
- A particular user is DialogWindow which looks for Enter and Escape presses and should not loose these events to the content morph unless it is explicitly focused. For the full discussion, see http://forum.world.st/The-Inbox-Morphic-cbc-1665-mcz-td5117905.html."
-
- ^ self valueOfProperty: #handlesKeyboardOnlyOnFocus ifAbsent: [false]!
Item was removed:
- ----- Method: Morph>>handlesKeyboardOnlyOnFocus: (in category 'event handling') -----
- handlesKeyboardOnlyOnFocus: aBoolean
-
- ^ self setProperty: #handlesKeyboardOnlyOnFocus toValue: aBoolean!
Item was removed:
- ----- Method: Morph>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: evt
- "Do I want to receive mouseDown events (mouseDown:, mouseMove:, mouseUp:)?"
- "NOTE: The default response is false, except if you have added sensitivity to mouseDown events using the on:send:to: mechanism. Subclasses that implement these messages directly should override this one to return true."
-
- self eventHandler ifNotNil: [^ self eventHandler handlesMouseDown: evt].
- ^ false!
Item was removed:
- ----- Method: Morph>>handlesMouseMove: (in category 'event handling') -----
- handlesMouseMove: anEvent
- "Do I want to receive mouseMove: when the hand passes over the receiver? Rules say that by default a morph gets #mouseMove iff
- * the hand is not dragging anything,
- + and some button is down,
- + and the receiver is the current mouse focus."
- self eventHandler ifNotNil: [^ self eventHandler handlesMouseMove: anEvent].
- self wantsEveryMouseMove ifTrue: [^ true].
- anEvent hand hasSubmorphs ifTrue: [ ^ false ].
- (anEvent anyButtonPressed and: [ anEvent hand mouseFocus == self ]) ifFalse: [ ^ false ].
- ^ true!
Item was removed:
- ----- Method: Morph>>handlesMouseOver: (in category 'event handling') -----
- handlesMouseOver: evt
- "Do I want to receive mouseEnter: and mouseLeave: when the button is up and the hand is empty? The default response is false, except if you have added sensitivity to mouseEnter: or mouseLeave:, using the on:send:to: mechanism."
-
- self eventHandler ifNotNil: [^ self eventHandler handlesMouseOver: evt].
- ^ false!
Item was removed:
- ----- Method: Morph>>handlesMouseOverDragging: (in category 'event handling') -----
- handlesMouseOverDragging: evt
- "Return true if I want to receive mouseEnterDragging: and mouseLeaveDragging: when the hand drags something over me (button up or button down), or when the mouse button is down but there is no mouseDown recipient. The default response is false, except if you have added sensitivity to mouseEnterLaden: or mouseLeaveLaden:, using the on:send:to: mechanism."
- "NOTE: If the hand state matters in these cases, it may be tested by constructs such as
- event anyButtonPressed
- event hand hasSubmorphs"
-
- self eventHandler ifNotNil: [^ self eventHandler handlesMouseOverDragging: evt].
- ^ false!
Item was removed:
- ----- Method: Morph>>handlesMouseStillDown: (in category 'event handling') -----
- handlesMouseStillDown: evt
- "Return true if the receiver wants to get repeated #mouseStillDown: messages between #mouseDown: and #mouseUp"
- self eventHandler ifNotNil: [^ self eventHandler handlesMouseStillDown: evt].
- ^ false
- !
Item was removed:
- ----- Method: Morph>>handlesMouseWheel: (in category 'event handling') -----
- handlesMouseWheel: evt
- "Do I want to receive mouseWheel events? The default response is false, except if you have added sensitivity to mouseWheel events using the on:send:to: mechanism. Subclasses that implement these messages directly should override this one to return true."
-
- self eventHandler ifNotNil: [^ self eventHandler handlesMouseWheel: evt].
- ^ false!
Item was removed:
- ----- Method: Morph>>hasClipLayoutCellsString (in category 'layout-menu') -----
- hasClipLayoutCellsString
- ^ (self clipLayoutCells
- ifTrue: ['<on>']
- ifFalse: ['<off>']), 'clip to cell size' translated!
Item was removed:
- ----- Method: Morph>>hasClipSubmorphsString (in category 'drawing') -----
- hasClipSubmorphsString
- "Answer a string that represents the clip-submophs checkbox"
- ^ (self clipSubmorphs
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'provide clipping' translated!
Item was removed:
- ----- Method: Morph>>hasDirectionHandlesString (in category 'menus') -----
- hasDirectionHandlesString
- ^ (self wantsDirectionHandles
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'direction handles' translated!
Item was removed:
- ----- Method: Morph>>hasDisableTableLayoutString (in category 'layout-menu') -----
- hasDisableTableLayoutString
- ^ (self disableTableLayout
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'disable layout in tables' translated!
Item was removed:
- ----- Method: Morph>>hasDragAndDropEnabledString (in category 'menus') -----
- hasDragAndDropEnabledString
- "Answer a string to characterize the drag & drop status of the
- receiver"
- ^ (self dragNDropEnabled
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'drag and drop enabled' translated!
Item was removed:
- ----- Method: Morph>>hasDragEnabledString (in category 'menus') -----
- hasDragEnabledString
-
- ^ (self dragEnabled
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'drag out' translated!
Item was removed:
- ----- Method: Morph>>hasDropEnabledString (in category 'menus') -----
- hasDropEnabledString
-
- ^ (self dropEnabled
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'drop in' translated!
Item was removed:
- ----- Method: Morph>>hasDropShadow (in category 'drop shadows') -----
- hasDropShadow
- "answer whether the receiver has DropShadow"
- ^ self
- valueOfProperty: #hasDropShadow
- ifAbsent: [false]!
Item was removed:
- ----- Method: Morph>>hasDropShadow: (in category 'drop shadows') -----
- hasDropShadow: aBool
-
- self hasDropShadow = aBool ifTrue: [^ self].
- self changed.
- aBool
- ifTrue:[self setProperty: #hasDropShadow toValue: true]
- ifFalse:[self removeProperty: #hasDropShadow].
-
- self layoutChanged.
- self changed.!
Item was removed:
- ----- Method: Morph>>hasDropShadowString (in category 'drop shadows') -----
- hasDropShadowString
- ^ (self hasDropShadow
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'show shadow' translated!
Item was removed:
- ----- Method: Morph>>hasExtension (in category 'accessing - extension') -----
- hasExtension
- "answer whether the receiver has extention"
- ^ extension notNil!
Item was removed:
- ----- Method: Morph>>hasFocus (in category 'event handling') -----
- hasFocus
-
- self flag: #obsolete. "mt: Use #hasKeyboardFocus instead, which reads live hand information and no cache."
- ^ false!
Item was removed:
- ----- Method: Morph>>hasHalo (in category 'halos and balloon help') -----
- hasHalo
- ^self hasProperty: #hasHalo.!
Item was removed:
- ----- Method: Morph>>hasHalo: (in category 'halos and balloon help') -----
- hasHalo: aBool
- aBool
- ifTrue:[self setProperty: #hasHalo toValue: true]
- ifFalse:[self removeProperty: #hasHalo]!
Item was removed:
- ----- Method: Morph>>hasKeyboardFocus (in category 'event handling') -----
- hasKeyboardFocus
-
- ^ self activeHand
- ifNil: [false]
- ifNotNil: [:hand | self hasKeyboardFocus: hand]!
Item was removed:
- ----- Method: Morph>>hasKeyboardFocus: (in category 'event handling') -----
- hasKeyboardFocus: aHand
-
- ^ aHand keyboardFocus == self keyboardFocusDelegate!
Item was removed:
- ----- Method: Morph>>hasMouseFocus (in category 'event handling') -----
- hasMouseFocus
-
- ^ self activeHand
- ifNil: [false]
- ifNotNil: [:hand | self hasMouseFocus: hand]!
Item was removed:
- ----- Method: Morph>>hasMouseFocus: (in category 'event handling') -----
- hasMouseFocus: aHand
-
- ^ aHand mouseFocus == self!
Item was removed:
- ----- Method: Morph>>hasNoLayoutString (in category 'layout-menu') -----
- hasNoLayoutString
- ^ (self layoutPolicy isNil
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'no layout' translated!
Item was removed:
- ----- Method: Morph>>hasOwner: (in category 'structure') -----
- hasOwner: aMorph
- "Return true if the receiver has aMorph in its owner chain"
- aMorph ifNil:[^true].
- self allOwnersDo:[:m| m = aMorph ifTrue:[^true]].
- ^false!
Item was removed:
- ----- Method: Morph>>hasProperty: (in category 'accessing - properties') -----
- hasProperty: aSymbol
- "Answer whether the receiver has the property named aSymbol"
- extension ifNil: [^ false].
- ^extension hasProperty: aSymbol!
Item was removed:
- ----- Method: Morph>>hasProportionalLayoutString (in category 'layout-menu') -----
- hasProportionalLayoutString
- | layout |
- ^ (((layout := self layoutPolicy) notNil
- and: [layout isProportionalLayout])
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'proportional layout' translated!
Item was removed:
- ----- Method: Morph>>hasReverseCellsString (in category 'layout-menu') -----
- hasReverseCellsString
- ^ (self reverseTableCells
- ifTrue: ['<on>']
- ifFalse: ['<off>']), 'reverse table cells' translated!
Item was removed:
- ----- Method: Morph>>hasRolloverBorder (in category 'drop shadows') -----
- hasRolloverBorder
- "answer whether the receiver has RolloverBorder"
- ^ self
- valueOfProperty: #hasRolloverBorder
- ifAbsent: [false]!
Item was removed:
- ----- Method: Morph>>hasRolloverBorder: (in category 'drop shadows') -----
- hasRolloverBorder: aBool
- aBool
- ifTrue:[self setProperty: #hasRolloverBorder toValue: true]
- ifFalse:[self removeProperty: #hasRolloverBorder]!
Item was removed:
- ----- Method: Morph>>hasRubberBandCellsString (in category 'layout-menu') -----
- hasRubberBandCellsString
- ^ (self rubberBandCells
- ifTrue: ['<on>']
- ifFalse: ['<off>']), 'rubber band cells' translated!
Item was removed:
- ----- Method: Morph>>hasStrings (in category 'debug and other') -----
- hasStrings
-
- self allStringsAfter: nil do: [:string | ^ true].
- ^ false!
Item was removed:
- ----- Method: Morph>>hasSubmorphWithProperty: (in category 'submorphs - misc') -----
- hasSubmorphWithProperty: aSymbol
- ^submorphs anySatisfy: [:m | m hasProperty: aSymbol]!
Item was removed:
- ----- Method: Morph>>hasSubmorphs (in category 'submorphs - testing') -----
- hasSubmorphs
- ^submorphs notEmpty!
Item was removed:
- ----- Method: Morph>>hasTableLayoutString (in category 'layout-menu') -----
- hasTableLayoutString
- | layout |
- ^ (((layout := self layoutPolicy) notNil
- and: [layout isTableLayout])
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'table layout' translated!
Item was removed:
- ----- Method: Morph>>hasTranslucentColor (in category 'accessing') -----
- hasTranslucentColor
- "Answer true if this any of this morph is translucent but not transparent."
-
- ^ color isColor and: [color isTranslucentColor]
- !
Item was removed:
- ----- Method: Morph>>hasYellowButtonMenu (in category 'menu') -----
- hasYellowButtonMenu
- "Answer true if I have any items at all for a context (yellow
- button) menu."
- ^ self wantsYellowButtonMenu
- or: [self models anySatisfy: [:each | each hasModelYellowButtonMenuItems]]!
Item was removed:
- ----- Method: Morph>>heading (in category 'rotate scale and flex') -----
- heading
- "Answer the current heading, which is #rotationDegrees relative to the #forwardDirection."
-
- ^ self rotationDegrees + self forwardDirection!
Item was removed:
- ----- Method: Morph>>heading: (in category 'rotate scale and flex') -----
- heading: newHeading
-
- self rotationDegrees: (newHeading - self forwardDirection).!
Item was removed:
- ----- Method: Morph>>height (in category 'geometry') -----
- height
-
- ^ bounds height!
Item was removed:
- ----- Method: Morph>>height: (in category 'geometry') -----
- height: aNumber
- " Set my height; my position (top-left corner) and width will remain the same "
-
- self extent: self width at aNumber asInteger.
- !
Item was removed:
- ----- Method: Morph>>helpButton (in category 'menus') -----
- helpButton
- "Answer a button whose action would be to put up help concerning the receiver"
-
- | aButton |
- aButton := SimpleButtonMorph new.
- aButton
- target: self;
- color: Color lightGreen;
- borderColor: Color lightGreen muchDarker;
- borderWidth: 1;
- label: '?' translated font: Preferences standardButtonFont;
- actionSelector: #presentHelp;
- setBalloonText: 'click here for help' translated.
- ^ aButton!
Item was removed:
- ----- Method: Morph>>hide (in category 'drawing') -----
- hide
-
- self visible ifTrue: [self visible: false].!
Item was removed:
- ----- Method: Morph>>highlight (in category 'accessing') -----
- highlight
- "The receiver is being asked to appear in a highlighted state. Mostly used for textual morphs"
- self color: self highlightColor!
Item was removed:
- ----- Method: Morph>>highlightColor (in category 'accessing') -----
- highlightColor
-
- | val |
- ^ (val := self valueOfProperty: #highlightColor)
- ifNotNil:
- [val ifNil: [self error: 'nil highlightColor']]
- ifNil:
- [owner ifNil: [self color] ifNotNil: [owner highlightColor]]!
Item was removed:
- ----- Method: Morph>>highlightColor: (in category 'accessing') -----
- highlightColor: aColor
- self setProperty: #highlightColor toValue: aColor!
Item was removed:
- ----- Method: Morph>>highlightForDrop (in category 'dropping/grabbing') -----
- highlightForDrop
- self highlightForDrop: true!
Item was removed:
- ----- Method: Morph>>highlightForDrop: (in category 'dropping/grabbing') -----
- highlightForDrop: aBoolean
- self setProperty: #highlightedForDrop toValue: aBoolean.
- self changed!
Item was removed:
- ----- Method: Morph>>highlightForMouseDown (in category 'drawing') -----
- highlightForMouseDown
- self highlightForMouseDown: true!
Item was removed:
- ----- Method: Morph>>highlightForMouseDown: (in category 'drawing') -----
- highlightForMouseDown: aBoolean
- aBoolean
- ifTrue:[self setProperty: #highlightedForMouseDown toValue: aBoolean]
- ifFalse:[self removeProperty: #highlightedForMouseDown. self resetExtension].
- self changed!
Item was removed:
- ----- Method: Morph>>highlightedForDrop (in category 'dropping/grabbing') -----
- highlightedForDrop
- ^(self valueOfProperty: #highlightedForDrop) == true!
Item was removed:
- ----- Method: Morph>>highlightedForMouseDown (in category 'drawing') -----
- highlightedForMouseDown
- ^(self valueOfProperty: #highlightedForMouseDown) == true!
Item was removed:
- ----- Method: Morph>>icon (in category 'thumbnail') -----
- icon
- "Answer a form with an icon to represent the receiver"
- ^ self valueOfProperty: #icon!
Item was removed:
- ----- Method: Morph>>iconOrThumbnail (in category 'thumbnail') -----
- iconOrThumbnail
-
- ^ self icon ifNil: [self thumbnail]!
Item was removed:
- ----- Method: Morph>>iconOrThumbnailOfSize: (in category 'thumbnail') -----
- iconOrThumbnailOfSize: aNumberOrPoint
- "Answer an appropiate form to represent the receiver"
-
- ^ self iconOrThumbnail scaledIntoFormOfSize: aNumberOrPoint
- !
Item was removed:
- ----- Method: Morph>>imageForm (in category 'drawing') -----
- imageForm
-
- ^ self imageFormForRectangle: self fullBounds
- !
Item was removed:
- ----- Method: Morph>>imageForm:backgroundColor:forRectangle: (in category 'drawing') -----
- imageForm: depth backgroundColor: aColor forRectangle: rect
- | canvas |
- canvas := Display defaultCanvasClass extent: rect extent depth: depth.
- canvas translateBy: rect topLeft negated
- during:[:tempCanvas|
- tempCanvas fillRectangle: rect color: aColor.
- tempCanvas fullDrawMorph: self].
- ^ canvas form offset: rect topLeft!
Item was removed:
- ----- Method: Morph>>imageForm:forRectangle: (in category 'drawing') -----
- imageForm: depth forRectangle: rect
- | canvas |
- canvas := Display defaultCanvasClass extent: rect extent depth: depth.
- canvas translateBy: rect topLeft negated
- during:[:tempCanvas| tempCanvas fullDrawMorph: self].
- ^ canvas form offset: rect topLeft!
Item was removed:
- ----- Method: Morph>>imageFormDepth: (in category 'drawing') -----
- imageFormDepth: depth
-
- ^ self imageForm: depth forRectangle: self fullBounds
- !
Item was removed:
- ----- Method: Morph>>imageFormForRectangle: (in category 'drawing') -----
- imageFormForRectangle: rect
-
- ^ self imageForm: Display depth forRectangle: rect
- !
Item was removed:
- ----- Method: Morph>>imageFormWithout:andStopThere: (in category 'drawing') -----
- imageFormWithout: stopMorph andStopThere: stopThere
- "Like imageForm, except it does not display stopMorph,
- and it will not display anything above it if stopThere is true.
- Returns a pair of the imageForm and a boolean that is true
- if it has hit stopMorph, and display should stop."
- | canvas rect |
- rect := self fullBounds.
- canvas := ColorPatchCanvas extent: rect extent depth: Display depth.
- canvas stopMorph: stopMorph.
- canvas doStop: stopThere.
- canvas translateBy: rect topLeft negated during:[:tempCanvas| tempCanvas fullDrawMorph: self].
- ^ Array with: (canvas form offset: rect topLeft)
- with: canvas foundMorph!
Item was removed:
- ----- Method: Morph>>inAScrollPane (in category 'initialization') -----
- inAScrollPane
- "Answer a scroll pane that allows the user to scroll the receiver in either direction. It will have permanent scroll bars unless you take some special action."
-
- | widget |
- widget := ScrollPane new.
- widget borderWidth: 0.
-
- widget scroller addMorph: self.
- self position: 0 at 0.
-
- widget
- hScrollBarPolicy: #whenNeeded;
- vScrollBarPolicy: #whenNeeded;
- fit;
- extent: (widget width min: 300 max: 100) @ (widget height min: 150 max: 100).
-
- widget color: self color darker darker.
- ^ widget!
Item was removed:
- ----- Method: Morph>>inPartsBin (in category 'parts bin') -----
- inPartsBin
-
- self isPartsDonor ifTrue: [^ true].
- self allOwnersDo: [:m | m isPartsBin ifTrue: [^ true]].
- ^ false
- !
Item was removed:
- ----- Method: Morph>>indexOfMorphAbove: (in category 'submorphs - misc') -----
- indexOfMorphAbove: aPoint
- "Return index of lowest morph whose bottom is above aPoint.
- Will return 0 if the first morph is not above aPoint."
-
- submorphs withIndexDo: [:mm :ii |
- mm fullBounds bottom >= aPoint y ifTrue: [^ ii - 1]].
- ^ submorphs size!
Item was removed:
- ----- Method: Morph>>indicateAllSiblings (in category 'meta-actions') -----
- indicateAllSiblings
- "Indicate all the receiver and all its siblings by flashing momentarily."
-
- | aPlayer allBoxes |
- (aPlayer := self topRendererOrSelf player) belongsToUniClass ifFalse: [^ self "error: 'not uniclass'"].
- allBoxes := aPlayer class allInstances
- select: [:m | m costume world == self currentWorld]
- thenCollect: [:m | m costume boundsInWorld].
-
- 5 timesRepeat:
- [Display flashAll: allBoxes andWait: 120].!
Item was removed:
- ----- Method: Morph>>indicateKeyboardFocus (in category 'testing') -----
- indicateKeyboardFocus
-
- ^ (self valueOfProperty: #indicateKeyboardFocus ifAbsent: nil)
- ifNil: [self class indicateKeyboardFocus]
- ifNotNil: [:symbol | symbol ~~ #never]!
Item was removed:
- ----- Method: Morph>>initString (in category 'printing') -----
- initString
-
- ^ String streamContents: [:s | self fullPrintOn: s]!
Item was removed:
- ----- Method: Morph>>initialExtent (in category 'user interface') -----
- initialExtent
- | ext |
- (ext := self valueOfProperty: #initialExtent)
- ifNotNil:
- [^ ext].
- ^ super initialExtent!
Item was removed:
- ----- Method: Morph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- owner := nil.
- submorphs := Array empty.
- bounds := self defaultBounds.
- color := self defaultColor!
Item was removed:
- ----- Method: Morph>>initializeExtension (in category 'accessing - extension') -----
- initializeExtension
- "private - initializes the receiver's extension"
- extension := MorphExtension new!
Item was removed:
- ----- Method: Morph>>initializeToStandAlone (in category 'parts bin') -----
- initializeToStandAlone
- "Set up the receiver, created by a #basicNew and now ready to be initialized, as a fully-formed morph suitable for providing a graphic for a parts bin surrogate, and, when such a parts-bin surrogate is clicked on, for attaching to the hand as a viable stand-alone morph. Because of historical precedent, #initialize has been expected to handle this burden, though a great number of morphs actually cannot stand alone. In any case, by default we call the historical #initialize, though unhappily, so that all existing morphs will work no worse than before when using this protocol."
-
- self initialize!
Item was removed:
- ----- Method: Morph>>innerBounds (in category 'geometry - layout') -----
- innerBounds
- "Return the inner rectangle enclosed by the bounds of this morph excluding the space taken by its borders. For an unbordered morph, this is just its bounds."
-
- ^ self bounds insetBy: self borderStyle inset!
Item was removed:
- ----- Method: Morph>>innerBounds: (in category 'geometry - layout') -----
- innerBounds: aRectangle
- "Set the bounds for laying out children of the receiver.
- Note: written so that #innerBounds can be changed without touching this method"
- | outer inner |
- outer := self bounds.
- inner := self innerBounds.
- self bounds: (aRectangle origin + (outer origin - inner origin) corner:
- aRectangle corner + (outer corner - inner corner)).!
Item was removed:
- ----- Method: Morph>>innerExtent (in category 'geometry - layout') -----
- innerExtent
-
- ^ self innerBounds extent!
Item was removed:
- ----- Method: Morph>>innerExtent: (in category 'geometry - layout') -----
- innerExtent: aPoint
-
- self innerBounds: (self innerPosition extent: aPoint).!
Item was removed:
- ----- Method: Morph>>innerPosition (in category 'geometry - layout') -----
- innerPosition
-
- ^ self innerBounds topLeft!
Item was removed:
- ----- Method: Morph>>innerPosition: (in category 'geometry - layout') -----
- innerPosition: aPoint
-
- | prior delta |
- prior := self innerBounds.
- delta := (aPoint - prior topLeft) rounded.
- self innerBounds: (prior translateBy: delta).!
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>>insetColor (in category 'accessing') -----
- insetColor
- owner ifNil:[^self color].
- ^ self colorForInsets!
Item was removed:
- ----- Method: Morph>>inspectArgumentsPlayerInMorphic: (in category 'debug and other') -----
- inspectArgumentsPlayerInMorphic: evt
- evt hand attachMorph: ((Inspector openOn: self player) extent: 300 at 200)!
Item was removed:
- ----- Method: Morph>>inspectAt:event: (in category 'meta-actions') -----
- inspectAt: aPoint event: evt
- | morphs target |
- morphs := self morphsAt: aPoint.
- (morphs includes: self) ifFalse:[morphs := morphs copyWith: self].
- target := UIManager default
- chooseFrom: (morphs collect: [:m | m knownName ifNil:[m class name asString]])
- values: morphs
- title: ('inspect whom?
- (deepest at top)').
- target ifNil:[^self].
- target inspectInMorphic: evt!
Item was removed:
- ----- Method: Morph>>inspectInMorphic (in category 'menus') -----
- inspectInMorphic
-
- ToolSet inspect: self.!
Item was removed:
- ----- Method: Morph>>inspectInMorphic: (in category 'menus') -----
- inspectInMorphic: evt
-
- ToolSet inspect: self.
- !
Item was removed:
- ----- Method: Morph>>inspectOwnerChain (in category 'debug and other') -----
- inspectOwnerChain
- self ownerChain inspectWithLabel: 'Owner chain for ', self printString!
Item was removed:
- ----- Method: Morph>>installModelIn: (in category 'debug and other') -----
- installModelIn: ignored
- "Simple morphs have no model"
- "See MorphicApp for other behavior"!
Item was removed:
- ----- Method: Morph>>intersects: (in category 'geometry - local/global') -----
- intersects: aRectangle
- "Answer whether aRectangle, which is in World coordinates, intersects me."
-
- ^self fullBoundsInWorld intersects: aRectangle!
Item was removed:
- ----- Method: Morph>>intoWorld: (in category 'submorphs - callbacks') -----
- intoWorld: aWorld
- "The receiver has just appeared in a new world. Note:
- * aWorld can be nil (due to optimizations in other places)
- * owner is already set
- * owner's submorphs may not include receiver yet.
- Important: Keep this method fast - it is run whenever morphs are added."
- aWorld ifNil:[^self].
- self wantsSteps ifTrue:[aWorld startStepping: self].
- self submorphsDo:[:m| m intoWorld: aWorld].
- !
Item was removed:
- ----- Method: Morph>>invalidRect: (in category 'change reporting') -----
- invalidRect: damageRect
- ^self invalidRect: damageRect from: self!
Item was removed:
- ----- Method: Morph>>invalidRect:from: (in category 'change reporting') -----
- invalidRect: aRectangle from: aMorph
- | damageRect |
- self visible ifFalse: [ ^self ].
- aRectangle hasPositiveExtent ifFalse: [ ^self ].
- damageRect := aRectangle.
- aMorph == self ifFalse:[
- "Clip to receiver's clipping bounds if the damage came from a child"
- self clipSubmorphs
- ifTrue:[damageRect := aRectangle intersect: self clippingBounds]].
- owner ifNotNil: [owner invalidRect: damageRect from: self].!
Item was removed:
- ----- Method: Morph>>invokeMetaMenu: (in category 'meta-actions') -----
- invokeMetaMenu: evt
-
- | menu |
- menu := self buildMetaMenu: evt.
- menu addTitle: self externalName.
- menu popUpEvent: evt in: self world!
Item was removed:
- ----- Method: Morph>>invokeMetaMenuAt:event: (in category 'meta-actions') -----
- invokeMetaMenuAt: aPoint event: evt
- | morphs target |
- morphs := self morphsAt: aPoint.
- (morphs includes: self) ifFalse:[morphs := morphs copyWith: self].
- morphs size = 1 ifTrue:[morphs first invokeMetaMenu: evt].
- target := UIManager default
- chooseFrom: (morphs collect: [:m | m knownName ifNil:[m class name asString]])
- values: morphs.
- target ifNil:[^self].
- target invokeMetaMenu: evt!
Item was removed:
- ----- Method: Morph>>isAViewer (in category 'e-toy support') -----
- isAViewer
- ^ false!
Item was removed:
- ----- Method: Morph>>isAlignmentMorph (in category 'classification') -----
- isAlignmentMorph
-
- ^ false!
Item was removed:
- ----- Method: Morph>>isBalloonHelp (in category 'classification') -----
- isBalloonHelp
- ^false!
Item was removed:
- ----- Method: Morph>>isButton (in category 'classification') -----
- isButton
- "Answers whether this morph acts like a button, which usually entails a mouse-click handler. Originally used in the projects 'Connectors' and 'Etoys', receivers that claim to be a button need to answer to #actionSelector as well."
-
- ^ false!
Item was removed:
- ----- Method: Morph>>isCompoundTileMorph (in category 'classification') -----
- isCompoundTileMorph
- ^false!
Item was removed:
- ----- Method: Morph>>isDockingBar (in category 'testing') -----
- isDockingBar
- "Return true if the receiver is a docking bar"
- ^ false!
Item was removed:
- ----- Method: Morph>>isFlap (in category 'accessing') -----
- isFlap
- "Answer whether the receiver claims to be a flap"
-
- ^ self hasProperty: #flap!
Item was removed:
- ----- Method: Morph>>isFlapOrTab (in category 'classification') -----
- isFlapOrTab
- ^self isFlap or:[self isFlapTab]!
Item was removed:
- ----- Method: Morph>>isFlapTab (in category 'classification') -----
- isFlapTab
- ^false!
Item was removed:
- ----- Method: Morph>>isFlexMorph (in category 'classification') -----
- isFlexMorph
-
- ^ false
- !
Item was removed:
- ----- Method: Morph>>isFlexed (in category 'testing') -----
- isFlexed
- "Return true if the receiver is currently flexed"
- owner ifNil:[^false].
- ^owner isFlexMorph!
Item was removed:
- ----- Method: Morph>>isFullOnScreen (in category 'testing') -----
- isFullOnScreen
- "Answer if the receiver is full contained in the owner visible
- area."
- owner isInMemory
- ifFalse: [^ true].
- owner isNil
- ifTrue: [^ true].
- self visible
- ifFalse: [^ true].
- ^ owner clearArea containsRect: self fullBounds!
Item was removed:
- ----- Method: Morph>>isGestureStart: (in category 'geniestubs') -----
- isGestureStart: anEvent
- "This mouse down could be the start of a gesture, or the end of a gesture focus"
-
- anEvent hand isGenieEnabled
- ifFalse: [ ^false ].
-
- (self allowsGestureStart: anEvent)
- ifTrue: [^ true ]. "could be the start of a gesture"
-
- "otherwise, check for whether it's time to disable the Genie auto-focus"
- (anEvent hand isGenieFocused
- and: [anEvent whichButton ~= anEvent hand focusStartEvent whichButton])
- ifTrue: [anEvent hand disableGenieFocus].
-
- ^false!
Item was removed:
- ----- Method: Morph>>isHandMorph (in category 'classification') -----
- isHandMorph
-
- ^ false!
Item was removed:
- ----- Method: Morph>>isImageMorph (in category 'testing') -----
- isImageMorph
- ^false!
Item was removed:
- ----- Method: Morph>>isInDockingBar (in category 'structure') -----
- isInDockingBar
- "answer if the receiver is in a menu bar"
- ^ (owner notNil) and: [owner isDockingBar]!
Item was removed:
- ----- Method: Morph>>isInSystemWindow (in category 'structure') -----
- isInSystemWindow
- "answer if the receiver is in a system window"
- ^ owner isMorph and:[owner isSystemWindow or:[owner isInSystemWindow]]!
Item was removed:
- ----- Method: Morph>>isInWorld (in category 'structure') -----
- isInWorld
- "Return true if this morph is in a world."
-
- ^self world notNil!
Item was removed:
- ----- Method: Morph>>isKedamaMorph (in category 'classification') -----
- isKedamaMorph
- ^false!
Item was removed:
- ----- Method: Morph>>isLikelyRecipientForMouseOverHalos (in category 'halos and balloon help') -----
- isLikelyRecipientForMouseOverHalos
- ^self player notNil!
Item was removed:
- ----- Method: Morph>>isLineMorph (in category 'testing') -----
- isLineMorph
- ^false!
Item was removed:
- ----- Method: Morph>>isLocked (in category 'accessing') -----
- isLocked
- "answer whether the receiver is Locked"
- extension ifNil: [^ false].
- ^ extension locked!
Item was removed:
- ----- Method: Morph>>isMenuItemMorph (in category 'testing') -----
- isMenuItemMorph
- ^false!
Item was removed:
- ----- Method: Morph>>isModalShell (in category 'classification') -----
- isModalShell
- ^false!
Item was removed:
- ----- Method: Morph>>isMorph (in category 'testing') -----
- isMorph
-
- ^ true!
Item was removed:
- ----- Method: Morph>>isNumericReadoutTile (in category 'classification') -----
- isNumericReadoutTile
- ^false!
Item was removed:
- ----- Method: Morph>>isPartsBin (in category 'parts bin') -----
- isPartsBin
- ^ false!
Item was removed:
- ----- Method: Morph>>isPartsDonor (in category 'parts bin') -----
- isPartsDonor
- "answer whether the receiver is PartsDonor"
- extension ifNil: [^ false].
- ^ extension isPartsDonor!
Item was removed:
- ----- Method: Morph>>isPartsDonor: (in category 'parts bin') -----
- isPartsDonor: aBoolean
- "change the receiver's isPartDonor property"
- (extension isNil and: [aBoolean not]) ifTrue: [^ self].
- self assureExtension isPartsDonor: aBoolean!
Item was removed:
- ----- Method: Morph>>isPhraseTileMorph (in category 'classification') -----
- isPhraseTileMorph
- ^false!
Item was removed:
- ----- Method: Morph>>isPlayfieldLike (in category 'classification') -----
- isPlayfieldLike
- ^ false!
Item was removed:
- ----- Method: Morph>>isRenderer (in category 'classification') -----
- isRenderer
- "A *renderer* morph transforms the appearance of its submorph in some manner. For example, it might supply a drop shadow or scale and rotate the morph it encases. Answer true if this morph acts as a renderer. This default implementation returns false."
- "Details: A renderer is assumed to have a single submorph. Renderers may be nested to concatenate their transformations. It is useful to be able to find the outer-most renderer. This can be done by ascending the owner chain from the rendered morph. To find the morph being rendered, one can descend through the (singleton) submorph lists of the renderer chain until a non-renderer is encountered."
-
- ^ false
- !
Item was removed:
- ----- Method: Morph>>isSafeToServe (in category 'testing') -----
- isSafeToServe
- "Return true if it is safe to serve this Morph using Nebraska."
- ^true!
Item was removed:
- ----- Method: Morph>>isSelectionMorph (in category 'testing') -----
- isSelectionMorph
- ^false!
Item was removed:
- ----- Method: Morph>>isShared (in category 'accessing') -----
- isShared
- "Answer whether the receiver has the #shared property. This property allows it to be treated as a 'background' item"
-
- ^ self hasProperty: #shared!
Item was removed:
- ----- Method: Morph>>isSketchMorph (in category 'testing') -----
- isSketchMorph
- ^self class isSketchMorphClass!
Item was removed:
- ----- Method: Morph>>isSoundTile (in category 'classification') -----
- isSoundTile
- ^false!
Item was removed:
- ----- Method: Morph>>isStandardViewer (in category 'classification') -----
- isStandardViewer
- ^false!
Item was removed:
- ----- Method: Morph>>isStepping (in category 'stepping and presenter') -----
- isStepping
- "Return true if the receiver is currently stepping in its world"
- | aWorld |
- ^ (aWorld := self world)
- ifNil: [false]
- ifNotNil: [aWorld isStepping: self]!
Item was removed:
- ----- Method: Morph>>isSteppingSelector: (in category 'stepping and presenter') -----
- isSteppingSelector: aSelector
- "Return true if the receiver is currently stepping in its world"
- | aWorld |
- ^ (aWorld := self world)
- ifNil: [false]
- ifNotNil: [aWorld isStepping: self selector: aSelector]!
Item was removed:
- ----- Method: Morph>>isSticky (in category 'accessing') -----
- isSticky
- "answer whether the receiver is Sticky"
- extension ifNil: [^ false].
- ^ extension sticky!
Item was removed:
- ----- Method: Morph>>isStickySketchMorph (in category 'classification') -----
- isStickySketchMorph
- ^false!
Item was removed:
- ----- Method: Morph>>isSyntaxMorph (in category 'classification') -----
- isSyntaxMorph
- ^false!
Item was removed:
- ----- Method: Morph>>isTextMorph (in category 'classification') -----
- isTextMorph
- ^false!
Item was removed:
- ----- Method: Morph>>isTileEditor (in category 'e-toy support') -----
- isTileEditor
- "No, I'm not"
- ^false!
Item was removed:
- ----- Method: Morph>>isTileMorph (in category 'classification') -----
- isTileMorph
- ^false!
Item was removed:
- ----- Method: Morph>>isTilePadMorph (in category 'classification') -----
- isTilePadMorph
- ^false!
Item was removed:
- ----- Method: Morph>>isTransferMorph (in category 'testing') -----
- isTransferMorph
-
- ^ false!
Item was removed:
- ----- Method: Morph>>isViewer (in category 'classification') -----
- isViewer
- ^false!
Item was removed:
- ----- Method: Morph>>isWorldMorph (in category 'classification') -----
- isWorldMorph
-
- ^ false!
Item was removed:
- ----- Method: Morph>>isWorldOrHandMorph (in category 'classification') -----
- isWorldOrHandMorph
-
- ^ self isWorldMorph or: [self isHandMorph]!
Item was removed:
- ----- Method: Morph>>justDroppedInto:event: (in category 'dropping/grabbing') -----
- justDroppedInto: aMorph event: anEvent
- "This message is sent to a dropped morph after it has been dropped on -- and been accepted by -- a drop-sensitive morph"
-
- | partsBinCase cmd |
- (self formerOwner notNil and: [self formerOwner ~~ aMorph])
- ifTrue: [self removeHalo].
- self formerOwner: nil.
- self formerPosition: nil.
- cmd := self valueOfProperty: #undoGrabCommand.
- cmd ifNotNil:[aMorph rememberCommand: cmd.
- self removeProperty: #undoGrabCommand].
- (partsBinCase := aMorph isPartsBin) ifFalse:
- [self isPartsDonor: false].
- (self isInWorld and: [partsBinCase not]) ifTrue:
- [self world startSteppingSubmorphsOf: self].
- "Note an unhappy inefficiency here: the startStepping... call will often have already been called in the sequence leading up to entry to this method, but unfortunately the isPartsDonor: call often will not have already happened, with the result that the startStepping... call will not have resulted in the startage of the steppage."
-
- "An object launched by certain parts-launcher mechanisms should end up fully visible..."
- (self hasProperty: #beFullyVisibleAfterDrop) ifTrue:
- [aMorph == self currentWorld ifTrue:
- [self goHome].
- self removeProperty: #beFullyVisibleAfterDrop].!
Item was removed:
- ----- Method: Morph>>justDroppedIntoPianoRoll:event: (in category '*Morphic-Sound-piano rolls') -----
- justDroppedIntoPianoRoll: pianoRoll event: evt
-
- | ambientEvent startTimeInScore |
- startTimeInScore := pianoRoll timeForX: self left.
-
- ambientEvent := AmbientEvent new
- morph: self;
- time: startTimeInScore.
-
- pianoRoll score addAmbientEvent: ambientEvent.
-
- "self endTime > pianoRoll scorePlayer durationInTicks ifTrue:
- [pianoRoll scorePlayer updateDuration]"
- !
Item was removed:
- ----- Method: Morph>>justGrabbedFrom: (in category 'dropping/grabbing') -----
- justGrabbedFrom: formerOwner
- "The receiver was just grabbed from its former owner and is now attached to the hand. By default, we pass this message on if we're a renderer."
- (self isRenderer and:[self hasSubmorphs])
- ifTrue:[self firstSubmorph justGrabbedFrom: formerOwner].!
Item was removed:
- ----- Method: Morph>>keepsTransform (in category 'rotate scale and flex') -----
- keepsTransform
- "Return true if the receiver will keep it's transform while being grabbed by a hand."
- ^false!
Item was removed:
- ----- Method: Morph>>keyDown: (in category 'event handling') -----
- keyDown: anEvent
- "Handle a key down event. The default response is to let my eventHandler, if any, handle it."
-
- self eventHandler ifNotNil:
- [self eventHandler keyDown: anEvent fromMorph: self].
- !
Item was removed:
- ----- Method: Morph>>keyStroke: (in category 'event handling') -----
- keyStroke: anEvent
- "Handle a keystroke event. The default response is to let my eventHandler, if any, handle it."
-
- self eventHandler ifNotNil:
- [self eventHandler keyStroke: anEvent fromMorph: self].
- !
Item was removed:
- ----- Method: Morph>>keyUp: (in category 'event handling') -----
- keyUp: anEvent
- "Handle a key up event. The default response is to let my eventHandler, if any, handle it."
-
- self eventHandler ifNotNil:
- [self eventHandler keyUp: anEvent fromMorph: self].
- !
Item was removed:
- ----- Method: Morph>>keyboardBubbleFilters (in category 'events-filtering-bubbling') -----
- keyboardBubbleFilters
- ^ self valueOfProperty: #keyboardBubbleFilters!
Item was removed:
- ----- Method: Morph>>keyboardBubbleFilters: (in category 'events-filtering-bubbling') -----
- keyboardBubbleFilters: anArrayOrNil
- ^ self setProperty: #keyboardBubbleFilters toValue: anArrayOrNil!
Item was removed:
- ----- Method: Morph>>keyboardCaptureFilters (in category 'events-filtering-capturing') -----
- keyboardCaptureFilters
- ^ self valueOfProperty: #keyboardCaptureFilters!
Item was removed:
- ----- Method: Morph>>keyboardCaptureFilters: (in category 'events-filtering-capturing') -----
- keyboardCaptureFilters: anArrayOrNil
- ^ self setProperty: #keyboardCaptureFilters toValue: anArrayOrNil!
Item was removed:
- ----- Method: Morph>>keyboardFocusChange: (in category 'event handling') -----
- keyboardFocusChange: aBoolean
- "The message is sent to a morph when its keyboard focus change. The given argument indicates that the receiver is gaining keyboard focus (versus losing) the keyboard focus. Morphs that accept keystrokes should change their appearance in some way when they are the current keyboard focus."
-
- self eventHandler
- ifNotNil: [:h | h keyboardFocusChange: aBoolean fromMorph: self].
-
- self indicateKeyboardFocus
- ifTrue: [self changed].!
Item was removed:
- ----- Method: Morph>>keyboardFocusColor (in category 'drawing') -----
- keyboardFocusColor
-
- ^ self
- valueOfProperty: #keyboardFocusColor
- ifAbsentPut: [self userInterfaceTheme keyboardFocusColor ifNil: [TranslucentColor r: 0.3 g: 0.5 b: 0.5 alpha: 0.5]]!
Item was removed:
- ----- Method: Morph>>keyboardFocusDelegate (in category 'event handling') -----
- keyboardFocusDelegate
- "If this morph ever tries to acquire the keyboard focus, this can be delegate to, for example, a submorph."
-
- ^ self!
Item was removed:
- ----- Method: Morph>>keyboardFocusWidth (in category 'drawing') -----
- keyboardFocusWidth
-
- ^ self
- valueOfProperty: #keyboardFocusWidth
- ifAbsentPut: [((self userInterfaceTheme keyboardFocusWidth ifNil: [2])
- * RealEstateAgent scaleFactor) truncated]!
Item was removed:
- ----- Method: Morph>>knownName (in category 'testing') -----
- knownName
- "answer a name by which the receiver is known, or nil if none"
- ^ extension ifNotNil: [extension externalName]!
Item was removed:
- ----- Method: Morph>>lastSubmorph (in category 'submorphs - accessing') -----
- lastSubmorph
- ^submorphs last!
Item was removed:
- ----- Method: Morph>>layoutBounds (in category 'geometry - layout') -----
- layoutBounds
- "Return the bounds for laying out children of the receiver"
- | inset box |
- inset := self layoutInset.
- box := self innerBounds.
- inset isZero ifTrue:[^box].
- ^box insetBy: inset.!
Item was removed:
- ----- Method: Morph>>layoutBounds: (in category 'geometry - layout') -----
- layoutBounds: aRectangle
- "Set the bounds for laying out children of the receiver.
- Note: written so that #layoutBounds can be changed without touching this method"
- | outer inner |
- outer := self bounds.
- inner := self layoutBounds.
- self bounds: (aRectangle origin + (outer origin - inner origin) corner:
- aRectangle corner + (outer corner - inner corner)).!
Item was removed:
- ----- Method: Morph>>layoutChanged (in category 'layout') -----
- layoutChanged
- "Notify my dependents (such as owner and submorphs) about a possible layout change after, for example, a change in position or extent. As a result, the layout will be re-computed for this morph and all its submorphs on the next #fullBounds call."
-
- "0) Skip duplicate notifications. Only once after every successful layout computation."
- fullBounds ifNil: [^self].
-
- "1) Clear layout caches."
- fullBounds := nil.
- self layoutPolicy ifNotNil:[:layout | layout flushLayoutCache].
-
- "2) Notify all dependents. Note that we do not send #ownerChanged to our submorphs now because we have to ensure that each submorph gets notified *exactly once* right before layout computation. See #doLayoutIn:."
- self owner ifNotNil: [:o | self disableLayout ifFalse: [o layoutChanged]].!
Item was removed:
- ----- Method: Morph>>layoutComputed (in category 'layout') -----
- layoutComputed
-
- ^ fullBounds notNil!
Item was removed:
- ----- Method: Morph>>layoutExtent (in category 'geometry - layout') -----
- layoutExtent
-
- ^ self layoutBounds extent!
Item was removed:
- ----- Method: Morph>>layoutExtent: (in category 'geometry - layout') -----
- layoutExtent: aPoint
-
- self layoutBounds: (self layoutPosition extent: aPoint).!
Item was removed:
- ----- Method: Morph>>layoutFrame (in category 'layout properties - proportional') -----
- layoutFrame
- "Layout specific. Return the layout frame describing where the
- receiver should appear in a proportional layout"
- ^ extension ifNotNil: [extension layoutFrame]!
Item was removed:
- ----- Method: Morph>>layoutFrame: (in category 'layout properties - proportional') -----
- layoutFrame: aLayoutFrame
- "Layout specific. Return the layout frame describing where the receiver should appear in a proportional layout"
- self layoutFrame == aLayoutFrame ifTrue:[^self].
- self assureExtension layoutFrame: aLayoutFrame.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>layoutInBounds: (in category 'layout') -----
- layoutInBounds: cellBounds
-
- self flag: #deprecated. "No actual deprecation warning because of debugging hazards."
- self
- layoutInBounds: cellBounds
- positioning: (self owner ifNil: [#center] ifNotNil: [:o | o cellPositioning]).!
Item was removed:
- ----- Method: Morph>>layoutInBounds:positioning: (in category 'layout') -----
- layoutInBounds: cellBounds positioning: cellPositioning
- "Layout specific. Apply the given bounds to the receiver after being layed out in its owner."
-
- | box |
- "1) We are getting new bounds here but we haven't computed the receiver's layout yet."
- self layoutComputed ifFalse:[
- "Although the receiver has reported its #minExtent before the actual size it has may differ from what would be after the layout. Normally, this isn't a real problem, but if we have #shrinkWrap constraints (see #adjustLayoutBounds) then the receiver's bounds may be larger than the cellBounds. THAT is a problem because the centering may not work correctly if the receiver shrinks after the owner layout has been computed. To avoid this problem, we compute the receiver's layout now. Note that the layout computation is based on the new cell bounds rather than the receiver's current bounds."
-
- "1.1) Adjust the box for #rigid receiver. Both #spaceFill and #shrinkWrap can use the cellBounds for now, which is important for many space-fills in a row or column to have the same widths (or heights) such as all MenuMorphItems in our MenuMorph."
- box := cellBounds origin extent:
- (self hResizing == #rigid ifTrue: [self bounds extent x] ifFalse: [cellBounds extent x]) @
- (self vResizing == #rigid ifTrue: [self bounds extent y] ifFalse: [cellBounds extent y]).
-
- "1.2) Move and resize the receiver to get started."
- self
- setPositionFromLayout: box origin;
- setExtentFromLayout: box extent.
-
- "1.3) Adjust to layout bounds and do the layout."
- box := box origin - (self bounds origin - self layoutBounds origin) corner:
- box corner - (self bounds corner - self layoutBounds corner).
- self doLayoutIn: box].
-
- " self assert: self layoutComputed.
- self assert: self owner layoutComputed not.
- "
- "2) Are we done already?"
- cellBounds extent = self bounds extent
- "Nice fit. I usually am done here if #minExtent did already trigger layout update (via #fullBounds) while my owner's layout was calculating the cell sizes."
- ifTrue:[^ self setPositionFromLayout: cellBounds origin].
-
- "3) We have the receiver's layout. Maybe we just computed it or we did not invalidate it in this run. The latter happens if our owner invalidates without telling us. The user dragging size grips in windows, for example. Now we have to consider #spaceFill constraints, which may trigger re-computation of the receiver's layout."
- box := self bounds.
- self hResizing == #spaceFill
- ifTrue: [
- "Support dynamic width-for-height due to space-fill constraint -- another layout run needed?"
- (box width ~= cellBounds width and: [self vResizing == #shrinkWrap])
- ifTrue: [self owner ifNotNil: [:o | o setProperty: #doLayoutAgain toValue: true]].
- "Fill the cell."
- box := box origin extent: cellBounds width @ box height].
-
- self vResizing == #spaceFill
- ifTrue: [
- "Support dynamic height-for-width due to space-fill constraint -- another layout run needed?"
- (box height ~= cellBounds height and: [self hResizing == #shrinkWrap])
- ifTrue: [self owner ifNotNil: [:o | o setProperty: #doLayoutAgain toValue: true]].
- "Fill the cell."
- box := box origin extent: box width @ cellBounds height].
-
- "4) We have the receiver's layout. Align in the cell according o the owners layout properties."
- box := box align: (box perform: cellPositioning) with: (cellBounds perform: cellPositioning).
-
- " self assert: self layoutComputed.
- self assert: self owner layoutComputed not.
- "
- "5) Install the new bounds. This may invalidate my layout again, which is okay because my owner will ask about my fullBounds in #doLayoutIn: (and #privateFullBounds). My layout will be re-computed then."
- self bounds: box.!
Item was removed:
- ----- Method: Morph>>layoutInset (in category 'layout properties') -----
- layoutInset
- "Return the extra inset for layouts"
- | props |
- props := self layoutProperties.
- ^props ifNil:[0] ifNotNil:[props layoutInset].!
Item was removed:
- ----- Method: Morph>>layoutInset: (in category 'layout properties') -----
- layoutInset: aNumber
- "Return the extra inset for layouts"
-
- self flag: #todo. "mt: Change to #assureLayoutProperties."
- self assureTableLayoutProperties layoutInset: aNumber.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>layoutMenuPropertyString:from: (in category 'layout-menu') -----
- layoutMenuPropertyString: aSymbol from: currentSetting
- | onOff wording |
- onOff := aSymbol == currentSetting
- ifTrue: ['<on>']
- ifFalse: ['<off>'].
- ""
- wording := String
- streamContents: [:stream |
- | index |
- index := 1.
- aSymbol
- keysAndValuesDo: [:idx :ch | ch isUppercase
- ifTrue: [""stream nextPutAll: (aSymbol copyFrom: index to: idx - 1) asLowercase.
- stream nextPutAll: ' '.
- index := idx]].
- index < aSymbol size
- ifTrue: [stream nextPutAll: (aSymbol copyFrom: index to: aSymbol size) asLowercase]].
- ""
- ^ onOff , wording translated!
Item was removed:
- ----- Method: Morph>>layoutPolicy (in category 'layout properties') -----
- layoutPolicy
- "Layout specific. Return the layout policy describing how children
- of the receiver should appear."
- ^ extension ifNotNil: [ extension layoutPolicy]!
Item was removed:
- ----- Method: Morph>>layoutPolicy: (in category 'layout properties') -----
- layoutPolicy: aLayoutPolicy
- "Layout specific. Return the layout policy describing how children of the receiver should appear."
- self layoutPolicy == aLayoutPolicy ifTrue:[^self].
- self assureExtension layoutPolicy: aLayoutPolicy.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>layoutPosition (in category 'geometry - layout') -----
- layoutPosition
-
- ^ self layoutBounds topLeft!
Item was removed:
- ----- Method: Morph>>layoutPosition: (in category 'geometry - layout') -----
- layoutPosition: aPoint
-
- | prior delta |
- prior := self layoutBounds.
- delta := (aPoint - prior topLeft) rounded.
- self layoutBounds: (prior translateBy: delta).!
Item was removed:
- ----- Method: Morph>>layoutProperties (in category 'layout properties') -----
- layoutProperties
- "Return the current layout properties associated with the
- receiver"
- ^ extension ifNotNil: [ extension layoutProperties]!
Item was removed:
- ----- Method: Morph>>layoutProperties: (in category 'layout properties') -----
- layoutProperties: newProperties
- "Return the current layout properties associated with the receiver"
- self layoutProperties == newProperties ifTrue:[^self].
- self assureExtension layoutProperties: newProperties.
- !
Item was removed:
- ----- Method: Morph>>layoutProportionallyIn: (in category 'layout') -----
- layoutProportionallyIn: newBounds
-
- self flag: #deprecated. "No actual deprecation warning because of debugging hazards."
- self
- layoutProportionallyInBounds: newBounds
- positioning: (self owner ifNil: [#center] ifNotNil: [:o | o cellPositioning]).!
Item was removed:
- ----- Method: Morph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
- layoutProportionallyInBounds: layoutBounds positioning: cellPositioning
- "Layout specific. Apply the given bounds to the receiver."
- | cellBounds frame |
- frame := self layoutFrame ifNil:[^self].
- "compute the cell size the receiver has given its layout frame"
-
- cellBounds := frame layout: self bounds in: layoutBounds.
- cellBounds := cellBounds topLeft extent: (cellBounds extent max: self minExtent).
-
- ^self layoutInBounds: cellBounds positioning: cellPositioning!
Item was removed:
- ----- Method: Morph>>left (in category 'geometry') -----
- left
- " Return the x-coordinate of my left side "
-
- ^ bounds left!
Item was removed:
- ----- Method: Morph>>left: (in category 'geometry') -----
- left: aNumber
- " Move me so that my left side is at the x-coordinate aNumber. My extent (width & height) are unchanged "
-
- self position: (aNumber @ bounds top)!
Item was removed:
- ----- Method: Morph>>leftCenter (in category 'geometry') -----
- leftCenter
-
- ^ bounds leftCenter!
Item was removed:
- ----- Method: Morph>>listCentering (in category 'layout properties - table') -----
- listCentering
- "Layout specific. This property describes how the rows/columns in a list-like layout should be centered.
- #topLeft - center at start of primary direction
- #bottomRight - center at end of primary direction
- #center - center in the middle of primary direction
- #justified - insert extra space inbetween rows/columns
- "
- | props |
- props := self layoutProperties.
- ^props ifNil:[#topLeft] ifNotNil:[props listCentering].!
Item was removed:
- ----- Method: Morph>>listCentering: (in category 'layout properties - table') -----
- listCentering: aSymbol
- "Layout specific. This property describes how the rows/columns in a list-like layout should be centered.
- #topLeft - center at start of primary direction
- #bottomRight - center at end of primary direction
- #center - center in the middle of primary direction
- #justified - insert extra space inbetween rows/columns
- "
- self assureTableLayoutProperties listCentering: aSymbol.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>listCenteringString: (in category 'layout-menu') -----
- listCenteringString: aSymbol
- ^self layoutMenuPropertyString: aSymbol from: self listCentering!
Item was removed:
- ----- Method: Morph>>listDirection (in category 'layout properties - table') -----
- listDirection
- "Layout specific. This property describes the direction in which a list-like layout should be applied. Possible values are:
- #leftToRight
- #rightToLeft
- #topToBottom
- #bottomToTop
- indicating the direction in which any layout should take place"
- | props |
- props := self layoutProperties.
- ^props ifNil:[#topToBottom] ifNotNil:[props listDirection].!
Item was removed:
- ----- Method: Morph>>listDirection: (in category 'layout properties - table') -----
- listDirection: aSymbol
- "Layout specific. This property describes the direction in which a list-like layout should be applied. Possible values are:
- #leftToRight
- #rightToLeft
- #topToBottom
- #bottomToTop
- indicating the direction in which any layout should take place"
- self assureTableLayoutProperties listDirection: aSymbol.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>listDirectionString: (in category 'layout-menu') -----
- listDirectionString: aSymbol
- ^self layoutMenuPropertyString: aSymbol from: self listDirection!
Item was removed:
- ----- Method: Morph>>listSpacing (in category 'layout properties - table') -----
- listSpacing
- "Layout specific. This property describes how the heights for different rows in a table layout should be handled.
- #equal - all rows have the same height
- #none - all rows may have different heights
- "
- | props |
- props := self layoutProperties.
- ^props ifNil:[#none] ifNotNil:[props listSpacing].!
Item was removed:
- ----- Method: Morph>>listSpacing: (in category 'layout properties - table') -----
- listSpacing: aSymbol
- "Layout specific. This property describes how the heights for different rows in a table layout should be handled.
- #equal - all rows have the same height
- #none - all rows may have different heights
- "
- self checkListSpacingProperty: aSymbol.
- self assureTableLayoutProperties listSpacing: aSymbol.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>listSpacingString: (in category 'layout-menu') -----
- listSpacingString: aSymbol
- ^self layoutMenuPropertyString: aSymbol from: self listSpacing!
Item was removed:
- ----- Method: Morph>>loadCachedState (in category 'caching') -----
- loadCachedState
- "Load the cached state of this morph. This method may be called to pre-load the cached state of a morph to avoid delays when it is first used. (Cached state can always be recompued on demand, so a morph should not rely on this method being called.) Implementations of this method should do 'super loadCachedState'. This default implementation does nothing."
- !
Item was removed:
- ----- Method: Morph>>localPointToGlobal: (in category 'geometry - local/global') -----
- localPointToGlobal: aPoint
- ^self point: aPoint in: nil!
Item was removed:
- ----- Method: Morph>>lock (in category 'accessing') -----
- lock
- self lock: true!
Item was removed:
- ----- Method: Morph>>lock: (in category 'accessing') -----
- lock: aBoolean
- "change the receiver's lock property"
- (extension isNil and: [aBoolean not]) ifTrue: [^ self].
- self assureExtension locked: aBoolean!
Item was removed:
- ----- Method: Morph>>lockUnlockMorph (in category 'menus') -----
- lockUnlockMorph
- "If the receiver is locked, unlock it; if unlocked, lock it"
-
- self isLocked ifTrue: [self unlock] ifFalse: [self lock]!
Item was removed:
- ----- Method: Morph>>lockedString (in category 'menus') -----
- lockedString
- "Answer the string to be shown in a menu to represent the
- 'locked' status"
- ^ (self isLocked
- ifTrue: ['<on>']
- ifFalse: ['<off>']), 'be locked' translated!
Item was removed:
- ----- Method: Morph>>mainDockingBars (in category 'submorphs - misc') -----
- mainDockingBars
- "Answer the receiver's main dockingBars"
- ^ self dockingBars
- select: [:each | each hasProperty: #mainDockingBarTimeStamp]!
Item was removed:
- ----- Method: Morph>>makeGraphPaper (in category 'e-toy support') -----
- makeGraphPaper
- | smallGrid backColor lineColor |
- smallGrid := Compiler evaluate: (UIManager default request: 'Enter grid size' translated initialAnswer: '16').
- smallGrid ifNil: [^ self].
- UIManager default informUser: 'Choose a background color' translated during: [backColor := Color fromUser].
- UIManager default informUser: 'Choose a line color' translated during: [lineColor := Color fromUser].
- self makeGraphPaperGrid: smallGrid background: backColor line: lineColor.!
Item was removed:
- ----- Method: Morph>>makeGraphPaperGrid:background:line: (in category 'e-toy support') -----
- makeGraphPaperGrid: smallGrid background: backColor line: lineColor
-
- | gridForm |
- gridForm := self gridFormOrigin: 0 at 0 grid: smallGrid asPoint background: backColor line: lineColor.
- self color: gridForm.
- self world ifNotNil: [self world fullRepaintNeeded].
- self changed: #newColor. "propagate to view"
- !
Item was removed:
- ----- Method: Morph>>makeMultipleSiblings: (in category 'meta-actions') -----
- makeMultipleSiblings: evt
- "Make multiple siblings, first prompting the user for how many"
-
- | result |
- self topRendererOrSelf couldMakeSibling ifFalse: [^ Beeper beep].
- result := UIManager default request: 'how many siblings do you want?' translated initialAnswer: '2'.
- result isEmptyOrNil ifTrue: [^ self].
- result first isDigit ifFalse: [^ Beeper beep].
- self topRendererOrSelf makeSiblings: result asInteger.!
Item was removed:
- ----- Method: Morph>>makeNascentScript (in category 'menus') -----
- makeNascentScript
- ^ self notYetImplemented!
Item was removed:
- ----- Method: Morph>>makeNewPlayerInstance: (in category 'meta-actions') -----
- makeNewPlayerInstance: evt
- "Make a duplicate of the receiver's argument. This is called only where the argument has an associated Player as its costumee, and the intent here is to make another instance of the same uniclass as the donor Player itself. Much works, but there are flaws so this shouldn't be used without recognizing the risks"
-
- evt hand attachMorph: self usableSiblingInstance!
Item was removed:
- ----- Method: Morph>>makeSiblings: (in category 'meta-actions') -----
- makeSiblings: count
- "Make multiple sibling, and return the list"
-
- | listOfNewborns aPosition |
- aPosition := self position.
- listOfNewborns := (1 to: count asInteger) asArray collect:
- [:anIndex | | anInstance |
- anInstance := self usableSiblingInstance.
- owner addMorphFront: anInstance.
- aPosition := aPosition + (10 at 10).
- anInstance position: aPosition.
- anInstance].
- self currentWorld startSteppingSubmorphsOf: self topRendererOrSelf owner.
- ^ listOfNewborns!
Item was removed:
- ----- Method: Morph>>makeSiblingsLookLikeMe: (in category 'meta-actions') -----
- makeSiblingsLookLikeMe: evt
- "Make all my siblings wear the same costume that I am wearing."
-
- | aPlayer |
- (aPlayer := self topRendererOrSelf player) belongsToUniClass ifFalse: [self error: 'not uniclass'].
- aPlayer class allInstancesDo:
- [:anInstance | anInstance == aPlayer ifFalse:
- [anInstance wearCostumeOf: aPlayer]]!
Item was removed:
- ----- Method: Morph>>markAsPartsDonor (in category 'parts bin') -----
- markAsPartsDonor
- "Mark the receiver specially so that mouse actions on it are interpreted as 'tearing off a copy'"
-
- self isPartsDonor: true!
Item was removed:
- ----- Method: Morph>>maxCellSize (in category 'layout properties - table') -----
- maxCellSize
- "Layout specific. This property specifies the maximum size of a table cell."
- | props |
- props := self layoutProperties.
- ^props ifNil:[SmallInteger maxVal] ifNotNil:[props maxCellSize].!
Item was removed:
- ----- Method: Morph>>maxCellSize: (in category 'layout properties - table') -----
- maxCellSize: aPoint
- "Layout specific. This property specifies the maximum size of a table cell."
- self assureTableLayoutProperties maxCellSize: aPoint.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>maybeAddCollapseItemTo: (in category 'menus') -----
- maybeAddCollapseItemTo: aMenu
- "If appropriate, add a collapse item to the given menu"
-
- | anOwner |
- (anOwner := self topRendererOrSelf owner) ifNotNil:
- [anOwner isWorldMorph ifTrue:
- [aMenu add: 'collapse' translated target: self action: #collapse]]!
Item was removed:
- ----- Method: Morph>>maybeDuplicateMorph (in category 'meta-actions') -----
- maybeDuplicateMorph
- "Maybe duplicate the morph"
-
- self okayToDuplicate ifTrue:
- [self topRendererOrSelf duplicate openInHand]!
Item was removed:
- ----- Method: Morph>>maybeDuplicateMorph: (in category 'meta-actions') -----
- maybeDuplicateMorph: evt
- self okayToDuplicate ifTrue:[^self duplicateMorph: evt]!
Item was removed:
- ----- Method: Morph>>menuButtonMouseEnter: (in category 'other events') -----
- menuButtonMouseEnter: event
- "The mouse entered a menu-button area; show the menu cursor temporarily"
-
- event hand showTemporaryCursor: Cursor menu!
Item was removed:
- ----- Method: Morph>>menuButtonMouseLeave: (in category 'other events') -----
- menuButtonMouseLeave: event
- "The mouse left a menu-button area; restore standard cursor"
-
- event hand showTemporaryCursor: nil!
Item was removed:
- ----- Method: Morph>>menuItemAfter: (in category 'menus') -----
- menuItemAfter: menuString
- | allWordings |
- allWordings := self allMenuWordings.
- ^ allWordings atWrap: ((allWordings indexOf: menuString) + 1)!
Item was removed:
- ----- Method: Morph>>menuItemBefore: (in category 'menus') -----
- menuItemBefore: menuString
- | allWordings |
- allWordings := self allMenuWordings.
- ^ allWordings atWrap: ((allWordings indexOf: menuString) - 1)!
Item was removed:
- ----- Method: Morph>>methodCommentAsBalloonHelp (in category 'accessing') -----
- methodCommentAsBalloonHelp
- "Given that I am a morph that is associated with an object and a method, answer a suitable method comment relating to that object & method if possible"
-
- | inherentSelector actual |
- (inherentSelector := self valueOfProperty: #inherentSelector)
- ifNotNil:
- [(actual := (self firstOwnerSuchThat:[:m| m isPhraseTileMorph or:[m isSyntaxMorph]]) actualObject) ifNotNil:
- [^ actual class precodeCommentOrInheritedCommentFor: inherentSelector]].
- ^ nil!
Item was removed:
- ----- Method: Morph>>minCellSize (in category 'layout properties - table') -----
- minCellSize
- "Layout specific. This property specifies the minimal size of a table cell."
- | props |
- props := self layoutProperties.
- ^props ifNil:[0] ifNotNil:[props minCellSize].!
Item was removed:
- ----- Method: Morph>>minCellSize: (in category 'layout properties - table') -----
- minCellSize: aPoint
- "Layout specific. This property specifies the minimal size of a table cell."
- self assureTableLayoutProperties minCellSize: aPoint.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>minExtent (in category 'layout') -----
- minExtent
- "Layout specific. Return the minimum size the receiver can be represented in.
- Implementation note: When this message is sent from an owner trying to lay out its children it will traverse down the morph tree and recompute the minimal arrangement of the morphs based on which the minimal extent is returned. When a morph with some layout strategy is encountered, the morph will ask its strategy to compute the new arrangement. However, since the final size given to the receiver is unknown at the point of the query, the assumption is made that the current bounds of the receiver are the base on which the layout should be computed. This scheme prevents strange layout changes when for instance, a table is contained in another table. Unless the inner table has been resized manually (which means its bounds are already enlarged) the arrangement of the inner table will not change here. Thus the entire layout computation is basically an iterative process which may have different results depending on the incremental changes applied."
-
- | layout minExtent extra hFit vFit |
- hFit := self hResizing.
- vFit := self vResizing.
-
- (self owner isNil or: [self owner layoutPolicy isNil])
- ifTrue: [
- hFit == #spaceFill ifTrue: [hFit := #rigid].
- vFit == #spaceFill ifTrue: [vFit := #rigid]].
-
- "0) The receiver will not adjust to parents layout by growing or shrinking, which means that an accurate layout defines the minimum size. So, compute the layout and return its bounds as minimal extent. DO NOT return fullBounds because the morph itself is being layed out."
- (hFit == #spaceFill or: [vFit == #spaceFill])
- ifFalse: [self fullBounds. ^ self bounds extent].
-
- "1) Ask the layout policy to compute the minimum extent."
- layout := self layoutPolicy.
- layout isNil
- ifTrue: [minExtent := 0 at 0]
- ifFalse: [minExtent := layout minExtentOf: self in: self layoutBounds].
-
- "2) #rigid fitting has to stay as is."
- hFit == #rigid
- ifTrue: [minExtent := self width @ minExtent y].
- vFit == #rigid
- ifTrue: [minExtent := minExtent x @ self height].
-
- "3) #spaceFill fitting has to account for layout inset."
- hFit == #spaceFill
- ifTrue: [
- (vFit == #shrinkWrap and: [self wrapDirection ~= #none])
- ifTrue: [minExtent := 1 @ minExtent y "Give h-space a chance to v-wrap and v-shrink."]
- ifFalse: [
- extra := self bounds width - self layoutBounds width.
- minExtent := (minExtent x + extra) @ minExtent y]].
- vFit == #spaceFill
- ifTrue: [
- (hFit == #shrinkWrap and: [self wrapDirection ~= #none])
- ifTrue: [minExtent := minExtent x @ 1 "Give v-space a chance to h-wrap and h-shrink."]
- ifFalse: [
- extra := self bounds height - self layoutBounds height.
- minExtent := minExtent x @ (minExtent y + extra)]].
-
- "4) #shrinkWrap fitting has to support height-for-width (or width-for-height)."
- hFit == #shrinkWrap
- ifTrue: [
- self fullBounds. "Compute layout now to get shrink-wrapped width."
- minExtent := self width @ minExtent y].
- vFit == #shrinkWrap
- ifTrue: [
- self fullBounds. "Compute layout now to get shrink-wrapped height."
- minExtent := minExtent x @ self height].
-
- "5) For morphs without submorphs (or without a layout policy), be sure to overwrite #doLayoutIn: and use #minWidth and #minHeight to implement #shrinkWrap such as in MenuItemMorph."
- ^ minExtent max: self minWidth @ self minHeight!
Item was removed:
- ----- Method: Morph>>minExtent: (in category 'layout') -----
- minExtent: aPoint
-
- self error: 'Use #minimumExtent: if you want to set a minimum extent. #minExtent is a layout policy-specific callback.'!
Item was removed:
- ----- Method: Morph>>minHeight (in category 'layout') -----
- minHeight
- "Layout specific. If you don't use a layout policy but claim to be #shrinkWrap on the vertical axis, use #minHeight to answer that shrink-wrapped height. See MenuItemMorph."
-
- ^ self
- valueOfProperty: #minHeight
- ifAbsent: [1]!
Item was removed:
- ----- Method: Morph>>minHeight: (in category 'layout') -----
- minHeight: aNumber
- aNumber isNil
- ifTrue: [self removeProperty: #minHeight]
- ifFalse: [self setProperty: #minHeight toValue: aNumber].
- self layoutChanged!
Item was removed:
- ----- Method: Morph>>minWidth (in category 'layout') -----
- minWidth
- "Layout specific. If you don't use a layout policy but claim to be #shrinkWrap on the horizontal axis, use #minWidth to answer that shrink-wrapped width."
-
- ^ self
- valueOfProperty: #minWidth
- ifAbsent: [1]!
Item was removed:
- ----- Method: Morph>>minWidth: (in category 'layout') -----
- minWidth: aNumber
- aNumber isNil
- ifTrue: [self removeProperty: #minWidth]
- ifFalse: [self setProperty: #minWidth toValue: aNumber].
- self layoutChanged!
Item was removed:
- ----- Method: Morph>>minimumExtent (in category 'geometry - layout') -----
- minimumExtent
-
- ^ self minWidth @ self minHeight!
Item was removed:
- ----- Method: Morph>>minimumExtent: (in category 'geometry - layout') -----
- minimumExtent: aPoint
- "Do not shrink below this extent."
-
- self
- minWidth: aPoint x;
- minHeight: aPoint y.!
Item was removed:
- ----- Method: Morph>>minimumHeight (in category 'geometry - layout') -----
- minimumHeight
- "Wrapper for layout-specific function to avoid confusion. Please configure through #minimumHeight: or #minHeight: or by overriding #minHeight. Please do not override #minimumHeight since the layout mechanism will not call it."
-
- ^ self minHeight!
Item was removed:
- ----- Method: Morph>>minimumHeight: (in category 'geometry - layout') -----
- minimumHeight: aNumber
- "Wrapper for layout-specific function to avoid confusion."
-
- self minHeight: aNumber.!
Item was removed:
- ----- Method: Morph>>minimumWidth (in category 'geometry - layout') -----
- minimumWidth
- "Wrapper for layout-specific function to avoid confusion. Please configure through #minimumWidth: or #minWidth: or by overriding #minWidth. Please do not override #minimumWidth since the layout mechanism will not call it."
-
- ^ self minWidth!
Item was removed:
- ----- Method: Morph>>minimumWidth: (in category 'geometry - layout') -----
- minimumWidth: aNumber
- "Wrapper for layout-specific function to avoid confusion."
-
- self minWidth: aNumber.!
Item was removed:
- ----- Method: Morph>>modalLockTo: (in category 'polymorph') -----
- modalLockTo: aSystemWindow
- "Lock the receiver as a modal owner of the given window."
-
- self lock!
Item was removed:
- ----- Method: Morph>>modalUnlockFrom: (in category 'polymorph') -----
- modalUnlockFrom: aSystemWindow
- "Unlock the receiver as a modal owner of the given window."
-
- self unlock!
Item was removed:
- ----- Method: Morph>>model (in category 'menus') -----
- model
- ^ nil !
Item was removed:
- ----- Method: Morph>>modelOrNil (in category 'accessing') -----
- modelOrNil
- ^ nil!
Item was removed:
- ----- Method: Morph>>models (in category 'model access') -----
- models
- "Answer a collection of whatever models I may have."
- ^ self modelOrNil
- ifNil: [ Array empty ]
- ifNotNil: [ Array with: self modelOrNil ]!
Item was removed:
- ----- Method: Morph>>modificationHash (in category 'testing') -----
- modificationHash
-
- ^String
- streamContents: [ :strm |
- self longPrintOn: strm
- ]
- limitedTo: 25
- !
Item was removed:
- ----- Method: Morph>>morphPreceding: (in category 'structure') -----
- morphPreceding: aSubmorph
- "Answer the morph immediately preceding aSubmorph, or nil if none"
-
- | index |
- (index := submorphs indexOf: aSubmorph) > 1 ifTrue: [
- ^submorphs at: index - 1 ].
- ^nil!
Item was removed:
- ----- Method: Morph>>morphReport (in category 'printing') -----
- morphReport
-
- ^self morphReportFor: #(hResizing vResizing bounds)!
Item was removed:
- ----- Method: Morph>>morphReportFor: (in category 'printing') -----
- morphReportFor: attributeList
-
- | s |
-
- s := WriteStream on: String new.
- self
- morphReportFor: attributeList
- on: s
- indent: 0.
- StringHolder new contents: s contents; openLabel: 'morph report'!
Item was removed:
- ----- Method: Morph>>morphReportFor:on:indent: (in category 'printing') -----
- morphReportFor: attributeList on: aStream indent: anInteger
-
- anInteger timesRepeat: [aStream tab].
- aStream print: self; space.
- attributeList do: [ :a | aStream print: (self perform: a); space].
- aStream cr.
- submorphs do: [ :sub |
- sub morphReportFor: attributeList on: aStream indent: anInteger + 1
- ].!
Item was removed:
- ----- Method: Morph>>morphRepresented (in category 'thumbnail') -----
- morphRepresented
- "If the receiver is an alias, answer the morph it represents; else answer self"
-
- ^ self!
Item was removed:
- ----- Method: Morph>>morphToDropInPasteUp: (in category 'dropping/grabbing') -----
- morphToDropInPasteUp: aPasteUp
- ^ self!
Item was removed:
- ----- Method: Morph>>morphicLayerNumber (in category 'submorphs - layers') -----
- morphicLayerNumber
- "Hint the preferred position in the owner's list of submorphs. Smaller layer numbers are in front of larger ones. If not specified, go up the owner chain if possible."
-
- ^ self
- valueOfProperty: #morphicLayerNumber
- ifAbsent: [self topRendererOrSelf owner
- ifNil: [self class defaultLayer]
- ifNotNil: [:m | m morphicLayerNumber]]!
Item was removed:
- ----- Method: Morph>>morphicLayerNumber: (in category 'submorphs - layers') -----
- morphicLayerNumber: aNumber
- "Changes the receiver's layer. If it is already part of a hierarchy, make sure that the owner's submorphs are in layer order. This can happen if you mix the use of, for example, #addMorph: and #addMorphInLayer:."
-
- self setProperty: #morphicLayerNumber toValue: aNumber.
- self owner ifNotNil: [:o | o reorderSubmorphsInLayers].!
Item was removed:
- ----- Method: Morph>>morphsAt: (in category 'submorphs - accessing') -----
- morphsAt: aPoint
- "Return a collection of all morphs in this morph structure that contain the given point, possibly including the receiver itself. The order is deepest embedding first."
- ^self morphsAt: aPoint unlocked: false!
Item was removed:
- ----- Method: Morph>>morphsAt:behind:unlocked: (in category 'submorphs - misc') -----
- morphsAt: aPoint behind: aMorph unlocked: aBool
- "Return all morphs at aPoint that are behind frontMorph; if aBool is true return only unlocked, visible morphs."
-
- | isBack all tfm |
- all := (aMorph isNil or: [owner isNil])
- ifTrue:
- ["Traverse down"
-
- (self fullBounds containsPoint: aPoint) ifFalse: [^#()].
- (aBool and: [self isLocked or: [self visible not]]) ifTrue: [^#()].
- nil]
- ifFalse:
- ["Traverse up"
-
- tfm := self transformedFrom: owner.
- all := owner
- morphsAt: (tfm localPointToGlobal: aPoint)
- behind: self
- unlocked: aBool.
- WriteStream with: all].
- isBack := aMorph isNil.
- self submorphsDo:
- [:m | | found |
- isBack
- ifTrue:
- [tfm := m transformedFrom: self.
- found := m
- morphsAt: (tfm globalPointToLocal: aPoint)
- behind: nil
- unlocked: aBool.
- found notEmpty
- ifTrue:
- [all ifNil: [all := WriteStream on: #()].
- all nextPutAll: found]].
- m == aMorph ifTrue: [isBack := true]].
- (isBack and: [self containsPoint: aPoint])
- ifTrue:
- [all ifNil: [^Array with: self].
- all nextPut: self].
- ^all ifNil: [#()] ifNotNil: [all contents]!
Item was removed:
- ----- Method: Morph>>morphsAt:unlocked: (in category 'submorphs - accessing') -----
- morphsAt: aPoint unlocked: aBool
-
- ^ self morphsAt: aPoint unlocked: aBool useFullBounds: false!
Item was removed:
- ----- Method: Morph>>morphsAt:unlocked:do: (in category 'submorphs - enumerating') -----
- morphsAt: aPoint unlocked: aBool do: aBlock
-
- ^ self morphsAt: aPoint unlocked: aBool useFullBounds: false do: aBlock!
Item was removed:
- ----- Method: Morph>>morphsAt:unlocked:useFullBounds: (in category 'submorphs - accessing') -----
- morphsAt: aPoint unlocked: unlocked useFullBounds: useFullBounds
- "Return a collection of all morphs in this morph structure that contain the given point, possibly including the receiver itself. The order is deepest embedding first."
-
- ^ Array streamContents: [:stream |
- self
- morphsAt: aPoint
- unlocked: unlocked
- useFullBounds: useFullBounds
- do: [:morph | stream nextPut: morph]]!
Item was removed:
- ----- Method: Morph>>morphsAt:unlocked:useFullBounds:do: (in category 'submorphs - enumerating') -----
- morphsAt: aPoint unlocked: unlocked useFullBounds: useFullBounds do: aBlock
- "Evaluate aBlock with all the morphs starting at the receiver which appear at aPoint, honoring its #fullBounds if useFullBounds is true. If unlocked is true take only visible, unlocked morphs into account."
-
- (self fullBounds containsPoint: aPoint) ifFalse: [^ self]. "Quick exit. Do not use slower #fullContainsPoint: here."
- (unlocked and: [self isLocked or: [self visible not]]) ifTrue: [^ self].
-
- self submorphsDo: [:morph | | tfm |
- tfm := morph transformedFrom: self.
- morph
- morphsAt: (tfm globalPointToLocal: aPoint)
- unlocked: unlocked
- useFullBounds: useFullBounds
- do: aBlock].
-
- (useFullBounds
- ifTrue: [self fullContainsPoint: aPoint]
- ifFalse: [self containsPoint: aPoint])
- ifTrue: [aBlock value: self].!
Item was removed:
- ----- Method: Morph>>morphsInFrontOf:overlapping:do: (in category 'submorphs - misc') -----
- morphsInFrontOf: someMorph overlapping: aRectangle do: aBlock
- "Evaluate aBlock with all top-level morphs in front of someMorph that overlap with the given rectangle. someMorph is either an immediate child of the receiver or nil (in which case all submorphs of the receiver are enumerated)."
- self submorphsDo:[:m|
- m == someMorph ifTrue:["Try getting out quickly"
- owner ifNil:[^self].
- ^owner morphsInFrontOf: self overlapping: aRectangle do: aBlock].
- (m fullBoundsInWorld intersects: aRectangle)
- ifTrue:[aBlock value: m]].
- owner ifNil:[^self].
- ^owner morphsInFrontOf: self overlapping: aRectangle do: aBlock.!
Item was removed:
- ----- Method: Morph>>morphsInFrontOverlapping: (in category 'submorphs - misc') -----
- morphsInFrontOverlapping: aRectangle
- "Return all top-level morphs in front of someMorph that overlap with the given rectangle."
- | morphList |
- morphList := WriteStream on: Array new.
- self morphsInFrontOf: nil overlapping: aRectangle do:[:m | morphList nextPut: m].
- ^morphList contents!
Item was removed:
- ----- Method: Morph>>morphsInFrontOverlapping:do: (in category 'submorphs - misc') -----
- morphsInFrontOverlapping: aRectangle do: aBlock
- "Evaluate aBlock with all top-level morphs in front of someMorph that overlap with the given rectangle."
- ^self morphsInFrontOf: nil overlapping: aRectangle do: aBlock!
Item was removed:
- ----- Method: Morph>>mouseBubbleFilters (in category 'events-filtering-bubbling') -----
- mouseBubbleFilters
- ^ self valueOfProperty: #mouseBubbleFilters!
Item was removed:
- ----- Method: Morph>>mouseBubbleFilters: (in category 'events-filtering-bubbling') -----
- mouseBubbleFilters: anArrayOrNil
- ^ self setProperty: #mouseBubbleFilters toValue: anArrayOrNil!
Item was removed:
- ----- Method: Morph>>mouseCaptureFilters (in category 'events-filtering-capturing') -----
- mouseCaptureFilters
- ^ self valueOfProperty: #mouseCaptureFilters!
Item was removed:
- ----- Method: Morph>>mouseCaptureFilters: (in category 'events-filtering-capturing') -----
- mouseCaptureFilters: anArrayOrNil
- ^ self setProperty: #mouseCaptureFilters toValue: anArrayOrNil!
Item was removed:
- ----- Method: Morph>>mouseDown: (in category 'event handling') -----
- mouseDown: evt
- "Handle a mouse down event. The default response is to let my
- eventHandler, if any, handle it."
-
- self eventHandler
- ifNotNil: [self eventHandler mouseDown: evt fromMorph: self].
-
- "Check for option (menu) click"
- evt yellowButtonPressed
- ifTrue: [^ self yellowButtonActivity: evt shiftPressed].
- !
Item was removed:
- ----- Method: Morph>>mouseDownOnHelpHandle: (in category 'halos and balloon help') -----
- mouseDownOnHelpHandle: anEvent
- "The mouse went down in the show-balloon handle"
-
- | str |
- anEvent shiftPressed ifTrue: [^ self editBalloonHelpText].
- str := self balloonText.
- str ifNil: [str := self noHelpString].
- self showBalloon: str hand: anEvent hand.
- !
Item was removed:
- ----- Method: Morph>>mouseDownPriority (in category 'events-processing') -----
- mouseDownPriority
- "Return the default mouse down priority for the receiver. This supports a morph to get mouse down before one of its children."
-
- ^ self
- valueOfProperty: #mouseDownPriority
- ifAbsent: [(self isPartsDonor or: [self isPartsBin])
- ifTrue: [50]
- ifFalse: [0]].
-
- "The above is a workaround for the complete confusion between parts donors and parts bins. Morphs residing in a parts bin may or may not have the parts donor property set; if they have they may or may not actually handle events. To work around this, parts bins get an equal priority to parts donors so that when a morph in the parts bin does have the property set but does not handle the event we still get a copy from picking it up through the parts bin. Argh. This just *cries* for a cleanup."
- "And the above comment is Andreas's from 10/2000, which was formerly retrievable by a #flag: call which however caused a problem when trying to recompile the method from decompiled source."!
Item was removed:
- ----- Method: Morph>>mouseDownPriority: (in category 'events-processing') -----
- mouseDownPriority: anInteger
-
- anInteger = 0 ifTrue: [^ self removeProperty: #mouseDownPriority].
-
- self
- setProperty: #mouseDownPriority
- toValue: anInteger.!
Item was removed:
- ----- Method: Morph>>mouseEnter: (in category 'event handling') -----
- mouseEnter: evt
- "Handle a mouseEnter event, meaning the mouse just entered my bounds with no button pressed. The default response is to let my eventHandler, if any, handle it."
-
- self eventHandler ifNotNil:
- [self eventHandler mouseEnter: evt fromMorph: self].
- !
Item was removed:
- ----- Method: Morph>>mouseEnterDragging: (in category 'event handling') -----
- mouseEnterDragging: evt
- "Handle a mouseEnterDragging event, meaning the mouse just entered my bounds with a button pressed or laden with submorphs. The default response is to let my eventHandler, if any, handle it, or else to do nothing."
-
- self eventHandler ifNotNil:
- [^ self eventHandler mouseEnterDragging: evt fromMorph: self].
- !
Item was removed:
- ----- Method: Morph>>mouseLeave: (in category 'event handling') -----
- mouseLeave: evt
- "Handle a mouseLeave event, meaning the mouse just left my bounds with no button pressed. The default response is to let my eventHandler, if any, handle it."
-
- self eventHandler ifNotNil:
- [self eventHandler mouseLeave: evt fromMorph: self].
- !
Item was removed:
- ----- Method: Morph>>mouseLeaveDragging: (in category 'event handling') -----
- mouseLeaveDragging: evt
- "Handle a mouseLeaveLaden event, meaning the mouse just left my bounds with a button pressed or laden with submorphs. The default response is to let my eventHandler, if any, handle it; else to do nothing."
-
- self eventHandler ifNotNil:
- [self eventHandler mouseLeaveDragging: evt fromMorph: self]!
Item was removed:
- ----- Method: Morph>>mouseMove: (in category 'event handling') -----
- mouseMove: evt
- "Handle a mouse move event. The default response is to let my eventHandler, if any, handle it."
- self eventHandler ifNotNil:
- [self eventHandler mouseMove: evt fromMorph: self].
- !
Item was removed:
- ----- Method: Morph>>mouseStillDown: (in category 'event handling') -----
- mouseStillDown: evt
- "Handle a mouse move event. The default response is to let my eventHandler, if any, handle it."
-
- self eventHandler ifNotNil:
- [self eventHandler mouseStillDown: evt fromMorph: self].
- !
Item was removed:
- ----- Method: Morph>>mouseStillDownStepRate (in category 'geniestubs') -----
- mouseStillDownStepRate
- "At what rate do I want to receive #mouseStillDown: notifications?"
- ^1!
Item was removed:
- ----- Method: Morph>>mouseStillDownThreshold (in category 'event handling') -----
- mouseStillDownThreshold
- "Return the number of milliseconds after which mouseStillDown: should be sent"
- ^200!
Item was removed:
- ----- Method: Morph>>mouseUp: (in category 'event handling') -----
- mouseUp: evt
- "Handle a mouse up event. The default response is to let my eventHandler, if any, handle it."
-
- self eventHandler ifNotNil:
- [self eventHandler mouseUp: evt fromMorph: self].
- !
Item was removed:
- ----- Method: Morph>>mouseUpCodeOrNil (in category 'debug and other') -----
- mouseUpCodeOrNil
- "If the receiver has a mouseUpCodeToRun, return it, else return nil"
-
- ^ self valueOfProperty: #mouseUpCodeToRun ifAbsent: [nil]!
Item was removed:
- ----- Method: Morph>>mouseWheel: (in category 'event handling') -----
- mouseWheel: anEvent
- "Handle a mouse wheel event. The default response is to let my eventHandler, if any, handle it."
-
- self eventHandler ifNotNil: [:handler |
- handler mouseWheel: anEvent fromMorph: self].!
Item was removed:
- ----- Method: Morph>>moveOrResizeFromKeystroke: (in category 'event handling') -----
- moveOrResizeFromKeystroke: anEvent
- "move or resize the receiver based on a keystroke"
- | dir |
-
- anEvent keyValue = 28 ifTrue: [dir := -1 @ 0].
- anEvent keyValue = 29 ifTrue: [dir := 1 @ 0].
- anEvent keyValue = 30 ifTrue: [dir := 0 @ -1].
- anEvent keyValue = 31 ifTrue: [dir := 0 @ 1].
-
- dir notNil
- ifTrue:[
- anEvent controlKeyPressed ifTrue: [dir := dir * 10].
-
- anEvent shiftPressed
- ifTrue: [self extent: self extent + dir]
- ifFalse: [self position: self position + dir].
-
- "anEvent wasHandled: true."
- ]
- !
Item was removed:
- ----- Method: Morph>>mustBeBackmost (in category 'e-toy support') -----
- mustBeBackmost
- "Answer whether the receiver needs to be the backmost morph in its owner's submorph list"
-
- ^ false!
Item was removed:
- ----- Method: Morph>>name: (in category 'naming') -----
- name: aName
- (aName isString) ifTrue: [self setNameTo: aName]!
Item was removed:
- ----- Method: Morph>>nameForFindWindowFeature (in category 'naming') -----
- nameForFindWindowFeature
- "Answer the name to show in a list of windows-and-morphs to represent the receiver"
-
- ^ self knownName ifNil: [self class name]!
Item was removed:
- ----- Method: Morph>>nameForUndoWording (in category 'dropping/grabbing') -----
- nameForUndoWording
- "Return wording appropriate to the receiver for use in an undo-related menu item (and perhaps elsewhere)"
-
- | aName |
- aName := self knownName ifNil: [self renderedMorph class name].
- ^ aName truncateTo: 24!
Item was removed:
- ----- Method: Morph>>nameInModel (in category 'naming') -----
- nameInModel
- "Return the name for this morph in the underlying model or nil."
-
- | w |
- w := self world.
- w isNil ifTrue: [^nil] ifFalse: [^w model nameFor: self]!
Item was removed:
- ----- Method: Morph>>nameOfObjectRepresented (in category 'naming') -----
- nameOfObjectRepresented
- "Answer the external name of the object represented"
-
- ^ self externalName!
Item was removed:
- ----- Method: Morph>>nearestOwnerThat: (in category 'structure') -----
- nearestOwnerThat: conditionBlock
- "Return the first enclosing morph for which aBlock evaluates to true, or nil if none"
-
- ^ self firstOwnerSuchThat: conditionBlock
- !
Item was removed:
- ----- Method: Morph>>newTransformationMorph (in category 'rotate scale and flex') -----
- newTransformationMorph
- ^TransformationMorph new!
Item was removed:
- ----- Method: Morph>>noHelpString (in category 'halos and balloon help') -----
- noHelpString
- ^ 'Help not yet supplied' translated!
Item was removed:
- ----- Method: Morph>>noteDecimalPlaces:forGetter: (in category 'e-toy support') -----
- noteDecimalPlaces: aNumber forGetter: aGetter
- "Make a mental note of the user's preference for a particular number of decimal places to be associated with the slot with the given getter"
-
- (self renderedMorph valueOfProperty: #decimalPlacePreferences ifAbsentPut: [IdentityDictionary new])
- at: aGetter put: aNumber!
Item was removed:
- ----- Method: Morph>>noteNewOwner: (in category 'submorphs - callbacks') -----
- noteNewOwner: aMorph
- "I have just been added as a submorph of aMorph"!
Item was removed:
- ----- Method: Morph>>objectForDataStream: (in category 'objects from disk') -----
- objectForDataStream: refStrm
- "I am being written out on an object file"
-
- | dp |
- self sqkPage ifNotNil:
- [refStrm rootObject == self | (refStrm rootObject == self sqkPage)
- ifFalse:
- [self url notEmpty
- ifTrue:
- [dp := self sqkPage copyForSaving. "be careful touching this object!!"
- refStrm replace: self with: dp.
- ^dp]]].
- self prepareToBeSaved. "Amen"
- ^self!
Item was removed:
- ----- Method: Morph>>objectViewed (in category 'e-toy support') -----
- objectViewed
- "Answer the morph associated with the player that the structure the receiver currently finds itself within represents."
-
- ^ (self outermostMorphThat: [:o | o isViewer or:[ o isScriptEditorMorph]]) objectViewed
- !
Item was removed:
- ----- Method: Morph>>obtrudesBeyondContainer (in category 'geometry testing') -----
- obtrudesBeyondContainer
- "Answer whether the receiver obtrudes beyond the bounds of its container"
-
- | top formerOwner |
- top := self topRendererOrSelf.
- top owner ifNil: [^ false].
- ^ top owner isHandMorph
- ifTrue:
- [((formerOwner := top formerOwner) notNil and: [formerOwner isInWorld])
- ifFalse:
- [false]
- ifTrue:
- [(formerOwner boundsInWorld containsRect: top boundsInWorld) not]]
- ifFalse:
- [(top owner bounds containsRect: top bounds) not]!
Item was removed:
- ----- Method: Morph>>offerCostumeViewerMenu: (in category 'menu') -----
- offerCostumeViewerMenu: aMenu
- "do nothing"!
Item was removed:
- ----- Method: Morph>>okayToAddDismissHandle (in category 'halos and balloon help') -----
- okayToAddDismissHandle
- "Answer whether a halo on the receiver should offer a dismiss handle. This provides a hook for making it harder to disassemble some strucures even momentarily"
-
- ^ self resistsRemoval not!
Item was removed:
- ----- Method: Morph>>okayToAddGrabHandle (in category 'halos and balloon help') -----
- okayToAddGrabHandle
- "Answer whether a halo on the receiver should offer a grab handle. This provides a hook for making it harder to deconstruct some strucures even momentarily"
-
- ^ true!
Item was removed:
- ----- Method: Morph>>okayToBrownDragEasily (in category 'halos and balloon help') -----
- okayToBrownDragEasily
- "Answer whether it it okay for the receiver to be brown-dragged easily -- i.e. repositioned within its container without extracting it. At present this is just a hook -- nobody declines."
-
- ^ true
-
-
-
- "
- ^ (self topRendererOrSelf owner isKindOf: PasteUpMorph) and:
- [self layoutPolicy isNil]"!
Item was removed:
- ----- Method: Morph>>okayToDuplicate (in category 'player') -----
- okayToDuplicate
- "Formerly this protocol was used to guard against awkward situations when there were anonymous scripts in the etoy system. Nowadays we just always allow duplication"
-
- ^ true!
Item was removed:
- ----- Method: Morph>>okayToExtractEasily (in category 'halos and balloon help') -----
- okayToExtractEasily
- "Answer whether it it okay for the receiver to be extracted easily. Not yet hooked up to the halo-permissions mechanism."
-
- ^ self topRendererOrSelf owner dragNDropEnabled!
Item was removed:
- ----- Method: Morph>>okayToResizeEasily (in category 'halos and balloon help') -----
- okayToResizeEasily
- "Answer whether it is appropriate to have the receiver be easily resized by the user from the halo"
-
- ^ true
-
- "This one was too jarring, not that it didn't most of the time do the right thing but because some of the time it didn't, such as in a holder. If we pursue this path, the test needs to be airtight, obviously...
- ^ (self topRendererOrSelf owner isKindOf: PasteUpMorph) and:
- [self layoutPolicy isNil]"!
Item was removed:
- ----- Method: Morph>>okayToRotateEasily (in category 'halos and balloon help') -----
- okayToRotateEasily
- "Answer whether it is appropriate for a rotation handle to be shown for the receiver. This is a hook -- at present nobody declines."
-
- ^ true!
Item was removed:
- ----- Method: Morph>>on:send:to: (in category 'event handling') -----
- on: eventName send: selector to: recipient
- self eventHandler ifNil: [self eventHandler: EventHandler new].
- self eventHandler on: eventName send: selector to: recipient!
Item was removed:
- ----- Method: Morph>>on:send:to:withValue: (in category 'event handling') -----
- on: eventName send: selector to: recipient withValue: value
- "NOTE: selector must take 3 arguments, of which value will be the *** FIRST ***"
-
- self eventHandler ifNil: [self eventHandler: EventHandler new].
- self eventHandler on: eventName send: selector to: recipient withValue: value
- !
Item was removed:
- ----- Method: Morph>>openAPropertySheet (in category 'meta-actions') -----
- openAPropertySheet
-
- Smalltalk at: #ObjectPropertiesMorph ifPresent:[:aClass|
- ^aClass basicNew
- targetMorph: self;
- initialize;
- openNearTarget
- ].
- Beeper beep.!
Item was removed:
- ----- Method: Morph>>openATextPropertySheet (in category 'meta-actions') -----
- openATextPropertySheet
-
- "should only be sent to morphs that are actually supportive"
-
- Smalltalk at: #TextPropertiesMorph ifPresent:[:aClass|
- ^aClass basicNew
- targetMorph: self;
- initialize;
- openNearTarget
- ].
- Beeper beep.!
Item was removed:
- ----- Method: Morph>>openCenteredInWorld (in category 'initialization') -----
- openCenteredInWorld
-
- self
- fullBounds;
- position: Display extent - self extent // 2;
- openInWorld.!
Item was removed:
- ----- Method: Morph>>openInHand (in category 'initialization') -----
- openInHand
- "Attach the receiver to the current hand in the current morphic world"
-
- self currentHand attachMorph: self!
Item was removed:
- ----- Method: Morph>>openInWindow (in category 'initialization') -----
- openInWindow
-
- ^self openInWindowLabeled: self defaultLabelForInspector
- !
Item was removed:
- ----- Method: Morph>>openInWindowLabeled: (in category 'initialization') -----
- openInWindowLabeled: aString
-
- ^self openInWindowLabeled: aString inWorld: self currentWorld!
Item was removed:
- ----- Method: Morph>>openInWindowLabeled:inWorld: (in category 'initialization') -----
- openInWindowLabeled: aString inWorld: aWorld
-
- | window extent |
-
- window := (SystemWindow labelled: aString) model: nil.
- window
- " guess at initial extent"
- bounds: (RealEstateAgent initialFrameFor: window initialExtent: self fullBounds extent world: aWorld);
- addMorph: self frame: (0 at 0 extent: 1 at 1);
- updatePaneColors.
- " calculate extent after adding in case any size related attributes were changed. Use
- fullBounds in order to trigger re-layout of layout morphs"
- extent := self fullBounds extent
- + (window extent - window layoutBounds extent).
- window extent: extent.
- aWorld addMorph: window.
- window beKeyWindow.
- aWorld startSteppingSubmorphsOf: window.
- ^window
- !
Item was removed:
- ----- Method: Morph>>openInWorld (in category 'initialization') -----
- openInWorld
- "Add this morph to the world."
-
- self openInWorld: self currentWorld.!
Item was removed:
- ----- Method: Morph>>openInWorld: (in category 'initialization') -----
- openInWorld: aWorld
- "Add this morph to the requested World."
- (aWorld visibleClearArea origin ~= (0 at 0) and: [self position = (0 at 0)]) ifTrue:
- [self position: aWorld visibleClearArea origin].
- aWorld addMorph: self.
- aWorld startSteppingSubmorphsOf: self!
Item was removed:
- ----- Method: Morph>>openModal: (in category 'polymorph') -----
- openModal: aSystemWindow
- "Open the given window locking the receiver until it is dismissed.
- Answer the system window.
- Restore the original keyboard focus when closed."
-
- | hand priorFocus mySysWin |
- mySysWin := self isSystemWindow
- ifTrue: [ self ]
- ifFalse: [ (self ownerThatIsA: SystemWindow) ifNil: [ self ] ].
- hand := self currentHand.
- priorFocus := hand keyboardFocus.
- [ mySysWin modalLockTo: aSystemWindow.
- ToolBuilder default runModal: aSystemWindow openAsIs ]
- ensure:
- [ mySysWin modalUnlockFrom: aSystemWindow.
- hand newKeyboardFocus: priorFocus ].
- ^aSystemWindow!
Item was removed:
- ----- Method: Morph>>openNear: (in category 'initialization') -----
- openNear: aRectangle
- self
- openNear: aRectangle
- in: self currentWorld!
Item was removed:
- ----- Method: Morph>>openNear:in: (in category 'initialization') -----
- openNear: aRectangle in: aWorld
- | wb leftOverlap rightOverlap topOverlap bottomOverlap best |
- wb := aWorld bounds.
- self fullBounds.
- leftOverlap := self width - (aRectangle left - wb left).
- rightOverlap := self width - (wb right - aRectangle right).
- topOverlap := self height - (aRectangle top - wb top).
- bottomOverlap := self height - (wb bottom - aRectangle bottom).
- best := nil.
- {
- {leftOverlap. #topRight:. #topLeft}.
- {rightOverlap. #topLeft:. #topRight}.
- {topOverlap. #bottomLeft:. #topLeft}.
- {bottomOverlap. #topLeft:. #bottomLeft}.
- } do: [ :tuple |
- (best isNil or: [tuple first < best first]) ifTrue: [best := tuple].
- ].
- self perform: best second with: (aRectangle perform: best third).
- self bottom: (self bottom min: wb bottom) rounded.
- self right: (self right min: wb right) rounded.
- self top: (self top max: wb top) rounded.
- self left: (self left max: wb left) rounded.
- self openInWorld: aWorld.!
Item was removed:
- ----- Method: Morph>>openNearMorph: (in category 'initialization') -----
- openNearMorph: aMorph
- self
- openNear: aMorph boundsInWorld
- in: (aMorph world
- ifNil: [self world
- ifNil: [Project current world]])!
Item was removed:
- ----- Method: Morph>>openViewerForArgument (in category 'player viewer') -----
- openViewerForArgument
- "Open up a viewer for a player associated with the morph in question. "
- self presenter viewMorph: self!
Item was removed:
- ----- Method: Morph>>orOwnerSuchThat: (in category 'structure') -----
- orOwnerSuchThat: conditionBlock
-
- (conditionBlock value: self) ifTrue: [^ self].
- self allOwnersDo: [:m | (conditionBlock value: m) ifTrue: [^ m]].
- ^ nil
-
- !
Item was removed:
- ----- Method: Morph>>otherProperties (in category 'accessing - properties') -----
- otherProperties
- "answer the receiver's otherProperties"
- ^ extension ifNotNil: [extension otherProperties]!
Item was removed:
- ----- Method: Morph>>outOfWorld: (in category 'submorphs - callbacks') -----
- outOfWorld: aWorld
- "The receiver has just appeared in a new world. Notes:
- * aWorld can be nil (due to optimizations in other places)
- * owner is still valid
- Important: Keep this method fast - it is run whenever morphs are removed."
- aWorld ifNil:[^self].
- "ar 1/31/2001: We could explicitly stop stepping the receiver here but for the sake of speed I'm for now relying on the lazy machinery in the world itself."
- "aWorld stopStepping: self."
- self submorphsDo:[:m| m outOfWorld: aWorld].
- !
Item was removed:
- ----- Method: Morph>>outerBounds (in category 'geometry - layout') -----
- outerBounds
- "Return the 'outer' bounds of the receiver, e.g., the bounds that need to be invalidated when the receiver changes."
- | box |
- box := self bounds.
- self hasDropShadow ifTrue:[box := self expandFullBoundsForDropShadow: box].
- self hasRolloverBorder ifTrue:[box := self expandFullBoundsForRolloverBorder: box].
- ^box!
Item was removed:
- ----- Method: Morph>>outerBounds: (in category 'geometry - layout') -----
- outerBounds: aRectangle
- "Set the bounds for laying out children of the receiver.
- Note: written so that #outerBounds can be changed without touching this method"
- | outer inner |
- outer := self bounds.
- inner := self outerBounds.
- self bounds: (aRectangle origin + (outer origin - inner origin) corner:
- aRectangle corner + (outer corner - inner corner)).!
Item was removed:
- ----- Method: Morph>>outerExtent (in category 'geometry - layout') -----
- outerExtent
-
- ^ self outerBounds extent!
Item was removed:
- ----- Method: Morph>>outerExtent: (in category 'geometry - layout') -----
- outerExtent: aPoint
-
- self outerBounds: (self outerPosition extent: aPoint).!
Item was removed:
- ----- Method: Morph>>outerPosition (in category 'geometry - layout') -----
- outerPosition
-
- ^ self outerBounds topLeft!
Item was removed:
- ----- Method: Morph>>outerPosition: (in category 'geometry - layout') -----
- outerPosition: aPoint
-
- | prior delta |
- prior := self outerBounds.
- delta := (aPoint - prior topLeft) rounded.
- self outerBounds: (prior translateBy: delta).!
Item was removed:
- ----- Method: Morph>>outermostMorphThat: (in category 'structure') -----
- outermostMorphThat: conditionBlock
- "Return the outermost containing morph for which aBlock is true, or nil if none"
-
- | outermost |
- self allOwnersDo: [:m | (conditionBlock value: m) ifTrue: [outermost := m]].
- ^ outermost!
Item was removed:
- ----- Method: Morph>>outermostOwnerWithYellowButtonMenu (in category 'menu') -----
- outermostOwnerWithYellowButtonMenu
- "Answer me or my outermost owner that is willing to contribute menu items to a context menu.
- Don't include the world."
-
- | outermost |
- outermost := self outermostMorphThat: [ :ea |
- ea isWorldMorph not and: [ ea hasYellowButtonMenu ]].
- ^outermost ifNil: [ self hasYellowButtonMenu ifTrue: [ self ] ifFalse: []] !
Item was removed:
- ----- Method: Morph>>outermostWorldMorph (in category 'structure') -----
- outermostWorldMorph
-
- | outer |
- self world ifNotNil: [ :world |^world].
- self flag: #arNote. "stuff below is really only for MVC"
- outer := self outermostMorphThat: [ :x | x isWorldMorph].
- outer ifNotNil: [^outer].
- self isWorldMorph ifTrue: [^self].
- ^nil!
Item was removed:
- ----- Method: Morph>>overlapsShadowForm:bounds: (in category 'geometry - etoys') -----
- overlapsShadowForm: itsShadow bounds: itsBounds
- "Answer true if itsShadow and my shadow overlap at all"
- | overlapExtent overlap myRect myShadow goalRect goalShadow bb |
- overlap := self fullBounds intersect: itsBounds.
- overlapExtent := overlap extent.
- overlapExtent > (0 @ 0)
- ifFalse: [^ false].
- myRect := overlap translateBy: 0 @ 0 - self topLeft.
- myShadow := (self imageForm contentsOfArea: myRect) stencil.
- goalRect := overlap translateBy: 0 @ 0 - itsBounds topLeft.
- goalShadow := (itsShadow contentsOfArea: goalRect) stencil.
-
- "compute a pixel-by-pixel AND of the two stencils. Result will be black
- (pixel value = 1) where black parts of the stencils overlap"
- bb := BitBlt toForm: myShadow.
- bb
- copyForm: goalShadow
- to: 0 @ 0
- rule: Form and.
-
- ^(bb destForm tallyPixelValues second) > 0 !
Item was removed:
- ----- Method: Morph>>owner (in category 'structure') -----
- owner
- "Returns the owner of this morph, which may be nil."
-
- ^ owner!
Item was removed:
- ----- Method: Morph>>ownerChain (in category 'debug and other') -----
- ownerChain
- "Answer a list of objects representing the receiver and all of its owners. The first element is the receiver, and the last one is typically the world in which the receiver resides"
-
- | c next |
- c := OrderedCollection with: self.
- next := self.
- [(next := next owner) notNil] whileTrue: [c add: next].
- ^c asArray!
Item was removed:
- ----- Method: Morph>>ownerChanged (in category 'layout') -----
- ownerChanged
- "This morph's owner has changed its geometry and is about to update its layout. This is a simple layout hook to update this morph's geometry according to its owner.
-
- For more advanced strategies, use a LayoutPolicy with some LayoutProperties. See #layoutPolicy: and maybe also #doLayoutIn:."
-
- self snapToEdgeIfAppropriate.
-
- self ownerChangedHandler
- ifNotNil: [:handler | handler cull: self].!
Item was removed:
- ----- Method: Morph>>ownerChangedHandler (in category 'layout') -----
- ownerChangedHandler
-
- ^ self valueOfProperty: #ownerChangedHandler!
Item was removed:
- ----- Method: Morph>>ownerChangedHandler: (in category 'layout') -----
- ownerChangedHandler: aHandler
-
- self
- setProperty: #ownerChangedHandler
- toValue: aHandler.
-
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>ownerThatIsA: (in category 'structure') -----
- ownerThatIsA: aClass
- "Return the first enclosing morph that is a kind of aClass, or nil if none"
-
- ^ self firstOwnerSuchThat: [:m | m isKindOf: aClass]!
Item was removed:
- ----- Method: Morph>>ownerThatIsA:orA: (in category 'structure') -----
- ownerThatIsA: firstClass orA: secondClass
- "Return the first enclosing morph that is a kind of one of the two classes given, or nil if none"
-
- ^ self firstOwnerSuchThat: [:m | (m isKindOf: firstClass) or: [m isKindOf: secondClass]]!
Item was removed:
- ----- Method: Morph>>pagesHandledAutomatically (in category 'printing') -----
- pagesHandledAutomatically
-
- ^false!
Item was removed:
- ----- Method: Morph>>partRepresented (in category 'parts bin') -----
- partRepresented
- ^self!
Item was removed:
- ----- Method: Morph>>pasteUpMorph (in category 'structure') -----
- pasteUpMorph
- "Answer the closest containing morph that is a PasteUp morph"
- ^ self ownerThatIsA: PasteUpMorph!
Item was removed:
- ----- Method: Morph>>pasteUpMorphHandlingTabAmongFields (in category 'structure') -----
- pasteUpMorphHandlingTabAmongFields
- "Answer the nearest PasteUpMorph in my owner chain that has the tabAmongFields property, or nil if none"
-
- | aPasteUp |
- aPasteUp := self owner.
- [aPasteUp notNil] whileTrue:
- [aPasteUp tabAmongFields ifTrue:
- [^ aPasteUp].
- aPasteUp := aPasteUp owner].
- ^ nil!
Item was removed:
- ----- Method: Morph>>pauseFrom: (in category '*Morphic-Sound-piano rolls') -----
- pauseFrom: scorePlayer
-
- "subclasses should take five"!
Item was removed:
- ----- Method: Morph>>permitsThumbnailing (in category 'thumbnail') -----
- permitsThumbnailing
- ^ true!
Item was removed:
- ----- Method: Morph>>playSoundNamed: (in category 'player commands') -----
- playSoundNamed: soundName
- "Play the sound with the given name.
- Does nothing if this image lacks sound playing facilities."
-
- SoundService default playSoundNamed: soundName asString!
Item was removed:
- ----- Method: Morph>>player (in category 'accessing') -----
- player
- "answer the receiver's player"
- ^ extension ifNotNil: [extension player]!
Item was removed:
- ----- Method: Morph>>player: (in category 'accessing') -----
- player: anObject
- "change the receiver's player"
- self assureExtension player: anObject!
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>>point:from: (in category 'geometry - local/global') -----
- point: aPoint from: aReferenceMorph
-
- owner ifNil: [^ aPoint].
- ^ (owner transformFrom: aReferenceMorph) globalPointToLocal: aPoint.
- !
Item was removed:
- ----- Method: Morph>>point:in: (in category 'geometry - local/global') -----
- point: aPoint in: aReferenceMorph
-
- owner ifNil: [^ aPoint].
- ^ (owner transformFrom: aReferenceMorph) localPointToGlobal: aPoint.
- !
Item was removed:
- ----- Method: Morph>>pointAtFraction: (in category 'geometry') -----
- pointAtFraction: relativePoint
- "For values between 0.0 and 1.0, answers a point that lies within the receiver's bounds. This method is a more general form of #center (meaning 0.5 at 0.5), #topLeft (meaning 0.0 at 0.0), #bottomCenter (meaning 0.5 at 1.0), etc. If can be useful for layout policies that want to position or resize their submorphs by fraction."
-
- ^ self bounds pointAtFraction: relativePoint!
Item was removed:
- ----- Method: Morph>>pointFromWorld: (in category 'geometry - local/global') -----
- pointFromWorld: aPoint
- ^self point: aPoint from: self world!
Item was removed:
- ----- Method: Morph>>pointInWorld: (in category 'geometry - local/global') -----
- pointInWorld: aPoint
- ^self point: aPoint in: self world!
Item was removed:
- ----- Method: Morph>>position (in category 'geometry') -----
- position
-
- ^ bounds topLeft!
Item was removed:
- ----- Method: Morph>>position: (in category 'geometry') -----
- position: aPoint
- "Change the position of this morph, which is the top left corner of its bounds."
-
- | delta box |
- delta := (aPoint - self bounds topLeft) rounded.
-
- "Skip drawing and layout updates for null changes."
- (delta x = 0 and: [delta y = 0])
- ifTrue: [^ self].
-
- "Optimize drawing. Record one damage rectangle for short distance and two damage rectangles for large distances."
- box := fullBounds ifNil: [self outerBounds]. "Avoid premature layout computation. Like in #extent: and #changed."
- (delta dotProduct: delta) > 100 "More than 10 pixels?"
- ifTrue: [self
- invalidRect: box;
- invalidRect: (box translateBy: delta)]
- ifFalse: [self
- invalidRect: (box merge: (box translateBy: delta))].
-
- "Move this morph and *all* of its submorphs."
- self privateFullMoveBy: delta.
-
- "For all known layout policies, my layout and the layout of my children is fine. Only the layout of my owner might be affected. So, tell about it."
- self owner ifNotNil: [:o |
- self flag: #todo. "mt: Maybe we can save a lot of effort and troubles by only calling #layoutChanged if the owner has a layout policy installed? Take the thumbs of scroll-bars as an example..."
- o layoutChanged].!
Item was removed:
- ----- Method: Morph>>positionInWorld (in category 'geometry - local/global') -----
- positionInWorld
-
- ^ self pointInWorld: self position.
- !
Item was removed:
- ----- Method: Morph>>positionSubmorphs (in category 'geometry - misc') -----
- positionSubmorphs
- self submorphsDo:
- [:aMorph | aMorph snapToEdgeIfAppropriate]!
Item was removed:
- ----- Method: Morph>>potentialEmbeddingTargets (in category 'meta-actions') -----
- potentialEmbeddingTargets
- "Return the potential targets for embedding the receiver"
-
- | oneUp topRend |
- (oneUp := (topRend := self topRendererOrSelf) owner) ifNil:[^#()].
- ^ (oneUp morphsAt: topRend referencePosition behind: topRend unlocked: true) select:
- [:m | m isFlexMorph not]!
Item was removed:
- ----- Method: Morph>>potentialTargets (in category 'meta-actions') -----
- potentialTargets
- "Return the potential targets for the receiver.
- This is derived from Morph>>potentialEmbeddingTargets."
- owner ifNil:[^#()].
- ^owner morphsAt: self referencePosition behind: self unlocked: true not!
Item was removed:
- ----- Method: Morph>>potentialTargetsAt: (in category 'meta-actions') -----
- potentialTargetsAt: aPoint
- "Return the potential targets for the receiver.
- This is derived from Morph>>potentialEmbeddingTargets."
- | realOwner |
- realOwner := self topRendererOrSelf
- owner
- ifNil: [^ #()].
- ^ realOwner
- morphsAt: aPoint
- !
Item was removed:
- ----- Method: Morph>>preferredDuplicationHandleSelector (in category 'halos and balloon help') -----
- preferredDuplicationHandleSelector
- "Answer the selector, either #addMakeSiblingHandle: or addDupHandle:, to be offered as the default in a halo open on me"
-
- Preferences oliveHandleForScriptedObjects ifFalse:
- [^ #addDupHandle:].
- ^ self renderedMorph valueOfProperty: #preferredDuplicationHandleSelector ifAbsent:
- [self player class isUniClass
- ifTrue:
- [#addMakeSiblingHandle:]
- ifFalse:
- [#addDupHandle:]]!
Item was removed:
- ----- Method: Morph>>preferredKeyboardBounds (in category 'Multilingual-ImmPlugin') -----
- preferredKeyboardBounds
-
- self flag: #ImmPlugin.
- ^ self bounds: self bounds in: self world.
- !
Item was removed:
- ----- Method: Morph>>preferredKeyboardPosition (in category 'Multilingual-ImmPlugin') -----
- preferredKeyboardPosition
-
- self flag: #ImmPlugin.
- ^ (self bounds: self bounds in: self world) topLeft.
- !
Item was removed:
- ----- Method: Morph>>prepareToBeSaved (in category 'fileIn/out') -----
- prepareToBeSaved
- "Prepare this morph to be saved to disk. Subclasses should nil out any instance variables that holds state that should not be saved, such as cached Forms. Note that this operation may take more drastic measures than releaseCachedState; for example, it might discard the transcript of an interactive chat session."
-
- self releaseCachedState.
- self formerOwner: nil.
- self formerPosition: nil.
- self removeProperty: #undoGrabCommand.
- fullBounds := nil!
Item was removed:
- ----- Method: Morph>>presentHelp (in category 'menus') -----
- presentHelp
- "Present a help message if there is one available"
-
- self inform: 'Sorry, no help has been
- provided here yet.'!
Item was removed:
- ----- Method: Morph>>presenter (in category 'accessing') -----
- presenter
- ^ owner ifNotNil: [owner presenter] ifNil: [self currentWorld presenter]!
Item was removed:
- ----- Method: Morph>>primaryHand (in category 'structure') -----
- primaryHand
-
- ^ self currentWorld primaryHand!
Item was removed:
- ----- Method: Morph>>printConstructorOn:indent: (in category 'printing') -----
- printConstructorOn: aStream indent: level
-
- ^ self printConstructorOn: aStream indent: level nodeDict: IdentityDictionary new
- !
Item was removed:
- ----- Method: Morph>>printConstructorOn:indent:nodeDict: (in category 'printing') -----
- printConstructorOn: aStream indent: level nodeDict: nodeDict
- | nodeString |
- (nodeString := nodeDict at: self ifAbsent: [nil])
- ifNotNil: [^ aStream nextPutAll: nodeString].
- submorphs isEmpty ifFalse: [aStream nextPutAll: '('].
- aStream nextPutAll: '('.
- self fullPrintOn: aStream.
- aStream nextPutAll: ')'.
- submorphs isEmpty ifTrue: [^ self].
- submorphs size <= 4
- ifTrue:
- [aStream crtab: level+1;
- nextPutAll: 'addAllMorphs: (Array'.
- 1 to: submorphs size do:
- [:i | aStream crtab: level+1; nextPutAll: 'with: '.
- (submorphs at: i) printConstructorOn: aStream indent: level+1 nodeDict: nodeDict].
- aStream nextPutAll: '))']
- ifFalse:
- [aStream crtab: level+1;
- nextPutAll: 'addAllMorphs: ((Array new: ', submorphs size printString, ')'.
- 1 to: submorphs size do:
- [:i |
- aStream crtab: level+1; nextPutAll: 'at: ', i printString, ' put: '.
- (submorphs at: i) printConstructorOn: aStream indent: level+1 nodeDict: nodeDict.
- aStream nextPutAll: ';'].
- aStream crtab: level+1; nextPutAll: 'yourself))']!
Item was removed:
- ----- Method: Morph>>printOn: (in category 'printing') -----
- printOn: aStream
- | aName |
- super printOn: aStream.
- (aName := self knownName) notNil
- ifTrue: [aStream nextPutAll: '<' , aName , '>'].
- aStream nextPutAll: '('.
- aStream
- print: self identityHash;
- nextPutAll: ')'!
Item was removed:
- ----- Method: Morph>>printPSToFile (in category '*morphic-Postscript Canvases') -----
- printPSToFile
-
- self printPSToFileNamed: self externalName!
Item was removed:
- ----- Method: Morph>>printSpecs (in category 'printing') -----
- printSpecs
-
- | printSpecs |
-
- printSpecs := self valueOfProperty: #PrintSpecifications.
- printSpecs ifNil: [
- printSpecs := PrintSpecifications defaultSpecs.
- self printSpecs: printSpecs.
- ].
- ^printSpecs!
Item was removed:
- ----- Method: Morph>>printSpecs: (in category 'printing') -----
- printSpecs: aPrintSecification
-
- self setProperty: #PrintSpecifications toValue: aPrintSecification.
- !
Item was removed:
- ----- Method: Morph>>printStructureOn:indent: (in category 'printing') -----
- printStructureOn: aStream indent: tabCount
-
- tabCount timesRepeat: [aStream tab].
- self printOn: aStream.
- aStream cr.
- self submorphsDo: [:m | m printStructureOn: aStream indent: tabCount + 1].
- !
Item was removed:
- ----- Method: Morph>>privateAddAllMorphs:atIndex: (in category 'private') -----
- privateAddAllMorphs: aCollection atIndex: index
- "Private. Add aCollection of morphs to the receiver"
- | myWorld otherSubmorphs offset |
- (index between: 1 and: submorphs size+1)
- ifFalse: [^ self error: 'index out of range'].
- (aCollection anySatisfy: [:newMorph | self hasOwner: newMorph])
- ifTrue: [^ self error: 'tried to add your (indirect) owner as new submorph'].
- myWorld := self world.
- otherSubmorphs := submorphs copyWithoutAll: aCollection.
- offset := aCollection count: [:m | (submorphs indexOf: m) between: 1 and: index - 1].
- submorphs := otherSubmorphs copyReplaceFrom: index-offset to: index-offset-1 with: aCollection.
- aCollection do: [:m | | itsOwner itsWorld |
- itsOwner := m owner.
- itsOwner ifNotNil: [
- itsWorld := m world.
- (itsWorld == myWorld) ifFalse: [
- itsWorld ifNotNil: [self privateInvalidateMorph: m].
- m outOfWorld: itsWorld].
- (itsOwner ~~ self) ifTrue: [
- m owner privateRemove: m.
- m owner removedMorph: m ]].
- m privateOwner: self.
- myWorld ifNotNil: [self privateInvalidateMorph: m].
- (myWorld == itsWorld) ifFalse: [m intoWorld: myWorld].
- itsOwner == self ifFalse: [
- self addedMorph: m.
- m noteNewOwner: self ].
- ].
- self layoutChanged.
- !
Item was removed:
- ----- Method: Morph>>privateAddMorph:atIndex: (in category 'private') -----
- privateAddMorph: aMorph atIndex: index
-
- | oldIndex myWorld itsWorld oldOwner |
-
- ((index >= 1) and: [index <= (submorphs size + 1)])
- ifFalse: [^ self error: 'index out of range'].
- (self hasOwner: aMorph)
- ifTrue: [^ self error: 'tried to add your (indirect) owner as new submorph'].
- myWorld := self world.
- oldOwner := aMorph owner.
- (oldOwner == self and: [(oldIndex := submorphs indexOf: aMorph) > 0]) ifTrue:[
- "aMorph's position changes within in the submorph chain"
- oldIndex < index ifTrue:[
- "moving aMorph to back"
- submorphs replaceFrom: oldIndex to: index-2 with: submorphs startingAt: oldIndex+1.
- submorphs at: index-1 put: aMorph.
- ] ifFalse:[
- "moving aMorph to front"
- oldIndex-1 to: index by: -1 do:[:i|
- submorphs at: i+1 put: (submorphs at: i)].
- submorphs at: index put: aMorph.
- ].
- ] ifFalse:[
- "adding a new morph"
- oldOwner ifNotNil:[
- itsWorld := aMorph world.
- itsWorld ifNotNil: [self privateInvalidateMorph: aMorph].
- (itsWorld == myWorld) ifFalse: [aMorph outOfWorld: itsWorld].
- oldOwner privateRemove: aMorph.
- oldOwner removedMorph: aMorph.
- ].
- aMorph privateOwner: self.
- submorphs := submorphs copyReplaceFrom: index to: index-1 with: (Array with: aMorph).
- (itsWorld == myWorld) ifFalse: [aMorph intoWorld: myWorld].
- ].
- myWorld ifNotNil:[self privateInvalidateMorph: aMorph].
- self layoutChanged.
- oldOwner == self ifFalse: [
- self addedMorph: aMorph.
- aMorph noteNewOwner: self ].
- !
Item was removed:
- ----- Method: Morph>>privateBounds: (in category 'private') -----
- privateBounds: boundsRect
- "Private!! Use position: and/or extent: instead."
-
- fullBounds := nil.
- bounds := boundsRect.!
Item was removed:
- ----- Method: Morph>>privateColor: (in category 'private') -----
- privateColor: aColor
-
- color := aColor.
- !
Item was removed:
- ----- Method: Morph>>privateDelete (in category 'submorphs - add/remove') -----
- privateDelete
- "Remove the receiver as a submorph of its owner"
- owner ifNotNil:[owner removeMorph: self].!
Item was removed:
- ----- Method: Morph>>privateDeleteWithAbsolutelyNoSideEffects (in category 'private') -----
- privateDeleteWithAbsolutelyNoSideEffects
- "Private!! Should only be used by methods that maintain the ower/submorph invariant."
- "used to delete a morph from an inactive world"
-
- owner ifNil: [^self].
- owner privateRemoveMorphWithAbsolutelyNoSideEffects: self.
- owner := nil.
-
- !
Item was removed:
- ----- Method: Morph>>privateExtension: (in category 'accessing - extension') -----
- privateExtension: aMorphExtension
- "private - change the receiver's extension"
- extension := aMorphExtension!
Item was removed:
- ----- Method: Morph>>privateFullBounds (in category 'layout') -----
- privateFullBounds
- "Private. Compute the actual full bounds of the receiver"
-
- | box |
- submorphs isEmpty ifTrue: [^self outerBounds].
- box := self outerBounds copy.
- box := box quickMerge: (self clipSubmorphs
- ifTrue: [self submorphBounds intersect: self clippingBounds]
- ifFalse: [self submorphBounds]).
- ^box origin asIntegerPoint corner: box corner asIntegerPoint!
Item was removed:
- ----- Method: Morph>>privateFullBounds: (in category 'private') -----
- privateFullBounds: boundsRect
- "Private!! Computed automatically."
-
- fullBounds := boundsRect.!
Item was removed:
- ----- Method: Morph>>privateFullBoundsForRedraw (in category 'layout') -----
- privateFullBoundsForRedraw
- "Private. Compute the current submorph bounds *all the way down* to trigger re-draw. Implementation is based on #privateFullBounds and #submorphBounds. Avoid triggering layout computation but return bounds as is."
-
- | box |
- self hasSubmorphs ifFalse: [^ self outerBounds].
- box := self outerBounds copy.
- box := box quickMerge: (self clipSubmorphs
- ifTrue: [self submorphBoundsForShrinkWrap intersect: self clippingBounds]
- ifFalse: [self submorphBoundsForShrinkWrap]).
- ^box origin asIntegerPoint corner: box corner asIntegerPoint!
Item was removed:
- ----- Method: Morph>>privateFullMoveBy: (in category 'private') -----
- privateFullMoveBy: delta
- "Private!! Relocate me and all of my subMorphs by recursion. Subclasses that implement different coordinate systems may override this method."
-
- self privateMoveBy: delta.
- 1 to: submorphs size do: [:i |
- (submorphs at: i) privateFullMoveBy: delta].
- owner ifNotNil:[
- owner isTextMorph ifTrue:[owner adjustTextAnchor: self]].!
Item was removed:
- ----- Method: Morph>>privateInvalidateMorph: (in category 'change reporting') -----
- privateInvalidateMorph: aMorph
- "Private. Invalidate the given morph after adding or removing.
- This method is private because a) we're invalidating the morph 'remotely'
- and b) it forces a fullBounds computation which should not be necessary
- for a general morph c) the morph may or may not actually invalidate
- anything (if it's not in the world nothing will happen) and d) the entire
- mechanism should be rewritten."
- aMorph fullBounds.
- aMorph changed!
Item was removed:
- ----- Method: Morph>>privateMoveBy: (in category 'private') -----
- privateMoveBy: delta
- "Private!! Use 'position:' instead."
- | fill |
- self player ifNotNil: ["Most cases eliminated fast by above test"
- self getPenDown ifTrue: [
- "If this is a costume for a player with its
- pen down, draw a line."
- self moveWithPenDownBy: delta]].
- bounds := bounds translateBy: delta.
- fullBounds ifNotNil: [fullBounds := fullBounds translateBy: delta].
- fill := self fillStyle.
- fill isOrientedFill ifTrue: [fill origin: fill origin + delta]!
Item was removed:
- ----- Method: Morph>>privateOwner: (in category 'private') -----
- privateOwner: aMorph
- "Private!! Should only be used by methods that maintain the ower/submorph invariant."
-
- owner := aMorph.!
Item was removed:
- ----- Method: Morph>>privateRemove: (in category 'private') -----
- privateRemove: aMorph
- "Private!! Should only be used by methods that maintain the ower/submorph invariant."
-
- submorphs := submorphs copyWithout: aMorph.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>privateRemoveMorphWithAbsolutelyNoSideEffects: (in category 'private') -----
- privateRemoveMorphWithAbsolutelyNoSideEffects: aMorph
- "Private!! Should only be used by methods that maintain the ower/submorph invariant."
- "used to delete a morph from an inactive world"
-
- submorphs := submorphs copyWithout: aMorph.
-
- !
Item was removed:
- ----- Method: Morph>>privateSubmorphs (in category 'private') -----
- privateSubmorphs
- "Private!! Use 'submorphs' instead."
-
- ^ submorphs!
Item was removed:
- ----- Method: Morph>>privateSubmorphs: (in category 'private') -----
- privateSubmorphs: aCollection
- "Private!! Should only be used by methods that maintain the ower/submorph invariant."
-
- submorphs := aCollection.!
Item was removed:
- ----- Method: Morph>>processEvent: (in category 'events-processing') -----
- processEvent: anEvent
- "Process the given event using the default event dispatcher."
- ^self processEvent: anEvent using: self defaultEventDispatcher!
Item was removed:
- ----- Method: Morph>>processEvent:using: (in category 'events-processing') -----
- processEvent: anEvent using: defaultDispatcher
- "This is the central entry for dispatching events in morphic. Given some event and a default dispatch strategy, find the right receiver and let him handle it.
- WARNING: This is a powerful hook. If you want to use a different event dispatcher from the default, here is the place to hook it in. Depending on how the dispatcher is written (e.g., whether it calls simply #processEvent: or #processEvent:using:) you can change the dispatch strategy for entire trees of morphs. Similarly, you can disable entire trees of morphs from receiving any events whatsoever. Read the documentation in class MorphicEventDispatcher before playing with it.
- Event filters for this capture phase can both influence and overrule the way the receiver can reject the event. If the filter ignores the event, the whole event procecssing will stop. If the filtered event is still not ignored, the receiver can decide to still reject it end regular event dispatch will go on."
-
- | filteredEvent |
- filteredEvent := self sendFilterEventCapture: anEvent for: self.
- filteredEvent wasIgnored ifTrue: [^ filteredEvent].
-
- (self rejectsEvent: filteredEvent) ifTrue:[^#rejected].
- ^defaultDispatcher dispatchEvent: filteredEvent with: self!
Item was removed:
- ----- Method: Morph>>processFocusEvent: (in category 'events-processing') -----
- processFocusEvent: anEvent
-
- ^self processFocusEvent: anEvent using: self defaultEventDispatcher!
Item was removed:
- ----- Method: Morph>>processFocusEvent:using: (in category 'events-processing') -----
- processFocusEvent: anEvent using: defaultDispatcher
- "Event dispatching shortcut."
-
- ^ defaultDispatcher dispatchFocusEvent: anEvent with: self!
Item was removed:
- ----- Method: Morph>>programmedMouseDown:for: (in category 'debug and other') -----
- programmedMouseDown: anEvent for: aMorph
-
- aMorph addMouseActionIndicatorsWidth: 15 color: (Color blue alpha: 0.7).
-
- !
Item was removed:
- ----- Method: Morph>>programmedMouseEnter:for: (in category 'debug and other') -----
- programmedMouseEnter: anEvent for: aMorph
-
- aMorph addMouseActionIndicatorsWidth: 10 color: (Color blue alpha: 0.3).
-
- !
Item was removed:
- ----- Method: Morph>>programmedMouseLeave:for: (in category 'debug and other') -----
- programmedMouseLeave: anEvent for: aMorph
-
- self deleteAnyMouseActionIndicators.
- !
Item was removed:
- ----- Method: Morph>>programmedMouseUp:for: (in category 'debug and other') -----
- programmedMouseUp: anEvent for: aMorph
- | aCodeString |
- self deleteAnyMouseActionIndicators.
- aCodeString := self valueOfProperty: #mouseUpCodeToRun ifAbsent: [^self].
- (self fullBounds containsPoint: anEvent cursorPoint) ifFalse: [^self].
-
- [(aCodeString isMessageSend)
- ifTrue: [aCodeString value]
- ifFalse:
- [Compiler
- evaluate: aCodeString
- for: self
- notifying: nil]]
- on: ProgressTargetRequestNotification
- do: [:ex | ex resume: self] "in case a save/load progress display needs a home"!
Item was removed:
- ----- Method: Morph>>raisedColor (in category 'accessing') -----
- raisedColor
- "Return the color to be used for shading raised borders. The
- default is my own color, but it might want to be, eg, my
- owner's color. Whoever's color ends up prevailing, the color
- itself gets the last chance to determine, so that when, for
- example, an InfiniteForm serves as the color, callers won't choke
- on some non-Color object being returned"
- (color isColor
- and: [color isTransparent
- and: [owner notNil]])
- ifTrue: [^ owner raisedColor].
- ^ color asColor raisedColor!
Item was removed:
- ----- Method: Morph>>randomBoundsFor: (in category 'WiW support') -----
- randomBoundsFor: aMorph
-
- | trialRect |
- trialRect := (
- self topLeft +
- ((self width * (15 + 75 atRandom/100)) rounded @
- (self height * (15 + 75 atRandom/100)) rounded)
- ) extent: aMorph extent.
- ^trialRect translateBy: (trialRect amountToTranslateWithin: self bounds)
- !
Item was removed:
- ----- Method: Morph>>readoutForField: (in category 'thumbnail') -----
- readoutForField: fieldSym
- "Provide a readout that will show the value of the slot/pseudoslot of the receiver generated by sending fieldSym to the receiver"
-
- | aContainer |
- "still need to get this right"
- aContainer := AlignmentMorph newColumn.
- aContainer layoutInset: 0; hResizing: #rigid; vResizing: #shrinkWrap.
- aContainer addMorphBack: (StringMorph new contents: (self perform: fieldSym) asString).
- ^ aContainer!
Item was removed:
- ----- Method: Morph>>reasonableBitmapFillForms (in category 'menus') -----
- 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!
Item was removed:
- ----- Method: Morph>>reasonableForms (in category 'menus') -----
- 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!
Item was removed:
- ----- Method: Morph>>redButtonGestureDictionaryOrName: (in category 'geniestubs') -----
- redButtonGestureDictionaryOrName: aSymbolOrDictionary!
Item was removed:
- ----- Method: Morph>>referencePlayfield (in category 'e-toy support') -----
- referencePlayfield
- "Answer the PasteUpMorph to be used for cartesian-coordinate reference"
-
- | former |
- owner ifNotNil:
- [(self topRendererOrSelf owner isHandMorph and: [(former := self formerOwner) notNil])
- ifTrue:
- [former := former renderedMorph.
- ^ former isPlayfieldLike
- ifTrue: [former]
- ifFalse: [former referencePlayfield]]].
-
- self allOwnersDo: [:o | o isPlayfieldLike ifTrue: [^ o]].
- ^ Project current world!
Item was removed:
- ----- Method: Morph>>referencePosition (in category 'rotate scale and flex') -----
- referencePosition
- "Return the current reference position of the receiver"
- | box |
- box := self bounds.
- ^box origin + (self rotationCenter * box extent).
- !
Item was removed:
- ----- Method: Morph>>referencePosition: (in category 'rotate scale and flex') -----
- referencePosition: aPosition
- "Move the receiver to match its reference position with aPosition"
- | newPos intPos |
- newPos := self position + (aPosition - self referencePosition).
- intPos := newPos asIntegerPoint.
- newPos = intPos
- ifTrue:[self position: intPos]
- ifFalse:[self position: newPos].!
Item was removed:
- ----- Method: Morph>>referencePositionInWorld (in category 'rotate scale and flex') -----
- referencePositionInWorld
-
- ^ self pointInWorld: self referencePosition
- !
Item was removed:
- ----- Method: Morph>>referencePositionInWorld: (in category 'rotate scale and flex') -----
- referencePositionInWorld: aPoint
- | localPosition |
- localPosition := owner
- ifNil: [aPoint]
- ifNotNil: [(owner transformFrom: self world) globalPointToLocal: aPoint].
-
- self referencePosition: localPosition
- !
Item was removed:
- ----- Method: Morph>>refreshWorld (in category 'drawing') -----
- refreshWorld
- "If this morph is in a world, refresh the world. This can be used to immediately redraw a morph after it changed. Note that you should use this call rather sparsely because it bypasses Morphics damage recording mechanism."
-
- self world ifNotNil: [:w | w displayWorldSafely].!
Item was removed:
- ----- Method: Morph>>regularColor (in category 'accessing') -----
- regularColor
-
- | val |
- ^ (val := self valueOfProperty: #regularColor)
- ifNotNil:
- [val ifNil: [self error: 'nil regularColor']]
- ifNil:
- [owner ifNil: [self color] ifNotNil: [owner regularColor]]!
Item was removed:
- ----- Method: Morph>>regularColor: (in category 'accessing') -----
- regularColor: aColor
- self setProperty: #regularColor toValue: aColor!
Item was removed:
- ----- Method: Morph>>rejectDropEvent: (in category 'events-processing') -----
- rejectDropEvent: anEvent
- "This hook allows the receiver to repel a drop operation currently executed. The method is called prior to checking children so the receiver must validate that the event was really designated for it.
- Note that the ordering of the tests below is designed to avoid a (possibly expensive) #fullContainsPoint: test. If the receiver doesn't want to repel the morph anyways we don't need to check after all."
- (self repelsMorph: anEvent contents event: anEvent) ifFalse:[^self]. "not repelled"
- (self fullContainsPoint: anEvent position) ifFalse:[^self]. "not for me"
- "Throw it away"
- anEvent wasHandled: true.
- anEvent contents rejectDropMorphEvent: anEvent.!
Item was removed:
- ----- Method: Morph>>rejectDropMorphEvent: (in category 'dropping/grabbing') -----
- rejectDropMorphEvent: evt
- "The receiver has been rejected, and must be put back somewhere. There are three cases:
- (1) It remembers its former owner and position, and goes right back there
- (2) It remembers its former position only, in which case it was torn off from a parts bin, and the UI is that it floats back to its donor position and then vanishes.
- (3) Neither former owner nor position is remembered, in which case it is whisked to the Trash"
-
- self removeProperty: #undoGrabCommand.
- (self formerOwner notNil and: [self formerOwner isPartsBin not]) ifTrue:
- [^ self slideBackToFormerSituation: evt].
-
- self formerPosition ifNotNil: "Position but no owner -- can just make it vanish"
- [^ self vanishAfterSlidingTo: self formerPosition event: evt].
-
- self slideToTrash: evt!
Item was removed:
- ----- Method: Morph>>rejectsEvent: (in category 'events-processing') -----
- rejectsEvent: anEvent
- "Return true to reject the given event. Rejecting an event means neither the receiver nor any of it's submorphs will be given any chance to handle it."
- ^self isLocked or:[self visible not]!
Item was removed:
- ----- Method: Morph>>releaseActionMap (in category 'events-removing') -----
- releaseActionMap
- "Release the action map"
-
- self removeProperty: #actionMap!
Item was removed:
- ----- Method: Morph>>releaseCachedState (in category 'caching') -----
- releaseCachedState
- "Release any state that can be recomputed on demand, such as the pixel values for a color gradient or the editor state for a TextMorph. This method may be called to save space when a morph becomes inaccessible. Implementations of this method should do 'super releaseCachedState'."
- self borderStyle releaseCachedState.
- !
Item was removed:
- ----- Method: Morph>>rememberedColor (in category 'accessing') -----
- rememberedColor
- "Answer a rememberedColor, or nil if none"
-
- ^ self valueOfProperty: #rememberedColor ifAbsent: [nil]!
Item was removed:
- ----- Method: Morph>>rememberedColor: (in category 'accessing') -----
- rememberedColor: aColor
- "Place aColor in a property so I can retrieve it later. A tortuous but expedient flow of data"
-
- ^ self setProperty: #rememberedColor toValue: aColor!
Item was removed:
- ----- Method: Morph>>removeAlarm: (in category 'events-alarms') -----
- removeAlarm: aSelector
- "Remove the given alarm"
- | scheduler |
- scheduler := self alarmScheduler.
- scheduler ifNotNil:[scheduler removeAlarm: aSelector for: self].!
Item was removed:
- ----- Method: Morph>>removeAlarm:at: (in category 'events-alarms') -----
- removeAlarm: aSelector at: scheduledTime
- "Remove the given alarm"
- | scheduler |
- scheduler := self alarmScheduler.
- scheduler ifNotNil:[scheduler removeAlarm: aSelector at: scheduledTime for: self].!
Item was removed:
- ----- Method: Morph>>removeAllButFirstSubmorph (in category 'other') -----
- removeAllButFirstSubmorph
- "Remove all of the receiver's submorphs other than the first one."
-
- self submorphs allButFirst do: [:m | m delete]!
Item was removed:
- ----- Method: Morph>>removeAllMorphs (in category 'submorphs - add/remove') -----
- removeAllMorphs
- | oldMorphs myWorld |
- myWorld := self world.
- (fullBounds notNil or: [ myWorld notNil ]) ifTrue: [ self invalidRect: self fullBounds ].
- submorphs do:
- [ : m | myWorld ifNotNil: [ m outOfWorld: myWorld ].
- m privateOwner: nil ].
- oldMorphs := submorphs.
- submorphs := Array empty.
- oldMorphs do: [ : m | self removedMorph: m ].
- self layoutChanged!
Item was removed:
- ----- Method: Morph>>removeAllMorphsIn: (in category 'submorphs - add/remove') -----
- removeAllMorphsIn: aCollection
- "greatly speeds up the removal of *lots* of submorphs"
- | set myWorld |
- set := IdentitySet new: aCollection size * 4 // 3.
- aCollection do: [:each | each owner == self ifTrue: [ set add: each]].
- myWorld := self world.
- (fullBounds notNil or:[myWorld notNil]) ifTrue:[self invalidRect: self fullBounds].
- set do: [:m | myWorld ifNotNil: [ m outOfWorld: myWorld ]. m privateOwner: nil].
- submorphs := submorphs reject: [ :each | set includes: each].
- set do: [ :m | self removedMorph: m ].
- self layoutChanged.
- !
Item was removed:
- ----- Method: Morph>>removeDropShadow (in category 'drop shadows') -----
- removeDropShadow
- self hasDropShadow ifFalse:[^self].
- self changed.
- self hasDropShadow: false.
- fullBounds ifNotNil:[fullBounds := self privateFullBounds].
- self changed.!
Item was removed:
- ----- Method: Morph>>removeEventBubbleFilter: (in category 'events-filtering-bubbling') -----
- removeEventBubbleFilter: anObject
- self eventBubbleFilters: (self removeFilter: anObject from: self eventBubbleFilters).!
Item was removed:
- ----- Method: Morph>>removeEventCaptureFilter: (in category 'events-filtering-capturing') -----
- removeEventCaptureFilter: anObject
- self eventCaptureFilters: (self removeFilter: anObject from: self eventCaptureFilters).!
Item was removed:
- ----- Method: Morph>>removeFilter:from: (in category 'events-filtering') -----
- removeFilter: anObject from: aFilterGroup
- "Remove anObject from the given listener group. Return the new group."
-
- | filters |
- aFilterGroup ifNil: [^nil].
- filters := aFilterGroup.
- filters := filters copyWithout: anObject.
- filters := filters copyWithout: nil. "obsolete entries"
- filters isEmpty ifTrue: [filters := nil].
- ^filters!
Item was removed:
- ----- Method: Morph>>removeFlexShell (in category 'rotate scale and flex') -----
- removeFlexShell
- self isFlexed
- ifTrue: [self owner removeFlexShell]!
Item was removed:
- ----- Method: Morph>>removeHalo (in category 'halos and balloon help') -----
- removeHalo
- "remove the surrounding halo (if any)"
-
- self halo ifNotNil: [ self currentHand removeHalo ]!
Item was removed:
- ----- Method: Morph>>removeKeyboardBubbleFilter: (in category 'events-filtering-bubbling') -----
- removeKeyboardBubbleFilter: anObject
- self keyboardBubbleFilters: (self removeFilter: anObject from: self keyboardBubbleFilters).!
Item was removed:
- ----- Method: Morph>>removeKeyboardCaptureFilter: (in category 'events-filtering-capturing') -----
- removeKeyboardCaptureFilter: anObject
- self keyboardCaptureFilters: (self removeFilter: anObject from: self keyboardCaptureFilters).!
Item was removed:
- ----- Method: Morph>>removeLink: (in category 'event handling') -----
- removeLink: actionCode
- self eventHandler ifNotNil:
- [self eventHandler on: actionCode send: nil to: nil]!
Item was removed:
- ----- Method: Morph>>removeMorph: (in category 'submorphs - add/remove') -----
- removeMorph: aMorph
- "Remove the given morph from my submorphs"
- | aWorld |
- aMorph owner == self ifFalse:[^self].
- aWorld := self world.
- aWorld ifNotNil:[
- aMorph outOfWorld: aWorld.
- self privateInvalidateMorph: aMorph.
- ].
- self privateRemove: aMorph.
- aMorph privateOwner: nil.
- self removedMorph: aMorph.
- !
Item was removed:
- ----- Method: Morph>>removeMouseBubbleFilter: (in category 'events-filtering-bubbling') -----
- removeMouseBubbleFilter: anObject
- self mouseBubbleFilters: (self removeFilter: anObject from: self mouseBubbleFilters).!
Item was removed:
- ----- Method: Morph>>removeMouseCaptureFilter: (in category 'events-filtering-capturing') -----
- removeMouseCaptureFilter: anObject
- self mouseCaptureFilters: (self removeFilter: anObject from: self mouseCaptureFilters).!
Item was removed:
- ----- Method: Morph>>removeMouseUpAction (in category 'debug and other') -----
- removeMouseUpAction
-
- self primaryHand showTemporaryCursor: nil.
- self removeProperty: #mouseUpCodeToRun.
- #(mouseUp mouseEnter mouseLeave mouseDown) do: [ :sym |
- self
- on: sym
- send: #yourself
- to: nil.
- ]
-
- !
Item was removed:
- ----- Method: Morph>>removeProperty: (in category 'accessing - properties') -----
- removeProperty: aSymbol
- "Remove the property named aSymbol if it exists. Answer the old value or nil."
- extension ifNil: [^ nil].
- ^ extension removeProperty: aSymbol!
Item was removed:
- ----- Method: Morph>>removedMorph: (in category 'submorphs - callbacks') -----
- removedMorph: aMorph
- "Notify the receiver that aMorph was just removed from its children"
- !
Item was removed:
- ----- Method: Morph>>renameInternal: (in category 'testing') -----
- renameInternal: aName
- "Change the internal name (because of a conflict) but leave the external name unchanged. Change Player class name, but do not change the names that appear in tiles. When coming in from disk, and have name conflict, References will already have the new name. "
-
- self knownName = aName ifTrue: [^ aName].
- self topRendererOrSelf setNameTo: aName.
-
- "References dictionary already has key aName"
-
- "If this player has a viewer flap, it will remain present"
-
- "Tiles in scripts all stay the same"
-
- "Compiled methods for scripts have been fixed up because the same association was reused"
-
- ^ aName!
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.
- oldName=aName ifTrue: [ ^aName ].
- (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>>renderedMorph (in category 'structure') -----
- renderedMorph
- "This now gets overridden by rendering morphs."
-
- ^self!
Item was removed:
- ----- Method: Morph>>reorderSubmorphsInLayers (in category 'submorphs - layers') -----
- reorderSubmorphsInLayers
- "Update submorph order to match their respective layer numbers."
-
- ((1 to: submorphs size - 1) allSatisfy: [:index |
- (submorphs at: index) morphicLayerNumber
- <= (submorphs at: index + 1) morphicLayerNumber])
- ifTrue: [^ self "No reordering needed"].
-
- self changed.
- submorphs := submorphs sorted: [:m1 :m2 |
- m1 morphicLayerNumber <= m2 morphicLayerNumber].
- self layoutChanged; changed.!
Item was removed:
- ----- Method: Morph>>repelsMorph:event: (in category 'dropping/grabbing') -----
- repelsMorph: aMorph event: ev
- ^ false!
Item was removed:
- ----- Method: Morph>>replaceSubmorph:by: (in category 'submorphs - misc') -----
- replaceSubmorph: oldMorph by: newMorph
- | index itsPosition w |
- oldMorph stopStepping.
- itsPosition := oldMorph referencePositionInWorld.
- index := submorphs indexOf: oldMorph.
- oldMorph privateDelete.
- self privateAddMorph: newMorph atIndex: index.
- newMorph referencePositionInWorld: itsPosition.
- (w := newMorph world) ifNotNil:
- [w startSteppingSubmorphsOf: newMorph]!
Item was removed:
- ----- Method: Morph>>reportableSize (in category 'printing') -----
- reportableSize
- "Answer a size worth reporting as the receiver's size in a list view"
-
- | total |
- total := super reportableSize.
- submorphs do:
- [:m | total := total + m reportableSize].
- ^ total!
Item was removed:
- ----- Method: Morph>>representativeNoTallerThan:norWiderThan:thumbnailHeight: (in category 'thumbnail') -----
- representativeNoTallerThan: maxHeight norWiderThan: maxWidth thumbnailHeight: thumbnailHeight
- "Return a morph representing the receiver but which is no taller than aHeight. If the receiver is already small enough, just return it, else return a MorphThumbnail companioned to the receiver, enforcing the maxWidth. If the receiver personally *demands* thumbnailing, do it even if there is no size-related reason to do it."
-
- self demandsThumbnailing ifFalse:
- [self permitsThumbnailing ifFalse: [^ self].
- (self fullBounds height <= maxHeight and: [self fullBounds width <= maxWidth]) ifTrue: [^ self]].
-
- ^ MorphThumbnail new extent: maxWidth @ (thumbnailHeight min: self fullBounds height); morphRepresented: self!
Item was removed:
- ----- Method: Morph>>reserveUrl: (in category 'fileIn/out') -----
- reserveUrl: urlString
- "Write a dummy object to the server to hold a name and place for this object."
-
- | dummy ext str |
- dummy := PasteUpMorph new.
- dummy borderWidth: 2.
- dummy setProperty: #initialExtent toValue: (ext := 300 at 100).
- dummy topLeft: 50 at 50; extent: ext. "reset when comes in"
- str := (TextMorph new) topLeft: dummy topLeft + (10 at 10);
- extent: dummy width - 15 @ 30.
- dummy addMorph: str.
- str contents: 'This is a place holder only. Please \find the original page and choose \"send this page to server"' withCRs.
- str extent: dummy width - 15 @ 30.
- dummy saveOnURL: urlString.
-
- "Claim that url myself"
- self setProperty: #SqueakPage toValue: dummy sqkPage.
- (dummy sqkPage) contentsMorph: self; dirty: true.
- ^ self url!
Item was removed:
- ----- Method: Morph>>resetExtension (in category 'accessing - extension') -----
- resetExtension
- "reset the extension slot if it is not needed"
- (extension notNil and: [extension isDefault]) ifTrue: [extension := nil] !
Item was removed:
- ----- Method: Morph>>resetForwardDirection (in category 'menus') -----
- resetForwardDirection
- self forwardDirection: 0.!
Item was removed:
- ----- Method: Morph>>resetFrom: (in category '*Morphic-Sound-piano rolls') -----
- resetFrom: scorePlayer
-
- "subclasses should revert to their initial state"!
Item was removed:
- ----- Method: Morph>>resetHighlightForDrop (in category 'dropping/grabbing') -----
- resetHighlightForDrop
- self highlightForDrop: false!
Item was removed:
- ----- Method: Morph>>residesInPartsBin (in category 'parts bin') -----
- residesInPartsBin
- "Answer true if the receiver is, or has some ancestor owner who is, a parts bin"
- ^ owner ifNotNil: [owner residesInPartsBin] ifNil: [false]!
Item was removed:
- ----- Method: Morph>>resistsRemoval (in category 'accessing') -----
- resistsRemoval
- "Answer whether the receiver is marked as resisting removal"
-
- ^ self hasProperty: #resistsRemoval!
Item was removed:
- ----- Method: Morph>>resistsRemoval: (in category 'accessing') -----
- resistsRemoval: aBoolean
- "Set the receiver's resistsRemoval property as indicated"
-
- aBoolean
- ifTrue:
- [self setProperty: #resistsRemoval toValue: true]
- ifFalse:
- [self removeProperty: #resistsRemoval]!
Item was removed:
- ----- Method: Morph>>resistsRemovalString (in category 'menus') -----
- resistsRemovalString
- "Answer the string to be shown in a menu to represent the
- 'resistsRemoval' status"
- ^ (self resistsRemoval
- ifTrue: ['<on>']
- ifFalse: ['<off>']), 'resist being deleted' translated!
Item was removed:
- ----- Method: Morph>>resizeFromMenu (in category 'meta-actions') -----
- resizeFromMenu
- "Commence an interaction that will resize the receiver"
-
- ^ self resizeMorph: self currentEvent!
Item was removed:
- ----- Method: Morph>>resizeMorph: (in category 'meta-actions') -----
- resizeMorph: evt
- | handle |
- handle := HandleMorph new forEachPointDo: [:newPoint |
- self extent: newPoint - self bounds topLeft].
- evt hand attachMorph: handle.
- handle startStepping.
- !
Item was removed:
- ----- Method: Morph>>resourceJustLoaded (in category 'initialization') -----
- resourceJustLoaded
- "In case resource relates to me"
- self releaseCachedState.!
Item was removed:
- ----- Method: Morph>>restoreSuspendedEventHandler (in category 'event handling') -----
- restoreSuspendedEventHandler
- | savedHandler |
- (savedHandler := self valueOfProperty: #suspendedEventHandler) ifNotNil:
- [self eventHandler: savedHandler].
- submorphs do: [:m | m restoreSuspendedEventHandler]
- !
Item was removed:
- ----- Method: Morph>>resumeAfterDrawError (in category 'debug and other') -----
- resumeAfterDrawError
-
- self changed.
- self removeProperty:#errorOnDraw.
- self changed.!
Item was removed:
- ----- Method: Morph>>resumeAfterLayoutError (in category 'debug and other') -----
- resumeAfterLayoutError
- "Resume layouting after an error has occured."
-
- self layoutPolicy: (self valueOfProperty: #errorOnLayout ifAbsent: [^ self]).
- self removeProperty:#errorOnLayout.!
Item was removed:
- ----- Method: Morph>>resumeAfterStepError (in category 'debug and other') -----
- resumeAfterStepError
- "Resume stepping after an error has occured."
-
- self startStepping. "Will #step"
- self removeProperty:#errorOnStep. "Will remove prop only if #step was okay"
- !
Item was removed:
- ----- Method: Morph>>resumeFrom: (in category '*Morphic-Sound-piano rolls') -----
- resumeFrom: scorePlayer
-
- "subclasses should continue from their current position"
- "a hack to allow for abitrary morphs to be dropped into piano roll"!
Item was removed:
- ----- Method: Morph>>reverseTableCells (in category 'layout properties - table') -----
- reverseTableCells
- "Layout specific. This property describes if the cells should be treated in reverse order of submorphs."
- | props |
- props := self layoutProperties.
- ^props ifNil:[false] ifNotNil:[props reverseTableCells].!
Item was removed:
- ----- Method: Morph>>reverseTableCells: (in category 'layout properties - table') -----
- reverseTableCells: aBool
- "Layout specific. This property describes if the cells should be treated in reverse order of submorphs."
- self assureTableLayoutProperties reverseTableCells: aBool.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>right (in category 'geometry') -----
- right
- " Return the x-coordinate of my right side "
- ^ bounds right!
Item was removed:
- ----- Method: Morph>>right: (in category 'geometry') -----
- right: aNumber
- " Move me so that my right side is at the x-coordinate aNumber. My extent (width & height) are unchanged "
-
- self position: ((aNumber - bounds width) @ bounds top)!
Item was removed:
- ----- Method: Morph>>rightCenter (in category 'geometry') -----
- rightCenter
-
- ^ bounds rightCenter!
Item was removed:
- ----- Method: Morph>>root (in category 'structure') -----
- root
- "Return the root of the composite morph containing the receiver. The owner of the root is either nil, a WorldMorph, or a HandMorph. If the receiver's owner is nil, the root is the receiver itself. This method always returns a morph."
-
- (owner isNil or: [owner isWorldOrHandMorph]) ifTrue: [^self].
- ^owner root!
Item was removed:
- ----- Method: Morph>>rootAt: (in category 'structure') -----
- rootAt: location
- "Just return myself, unless I am a WorldWindow.
- If so, then return the appropriate root in that world"
-
- ^ self!
Item was removed:
- ----- Method: Morph>>rootMorphsAt: (in category 'submorphs - misc') -----
- rootMorphsAt: aPoint
- "Return the list of root morphs containing the given point, excluding the receiver.
- ar 11/8/1999: Moved into morph for an incredibly ugly hack in 3D worlds"
- self flag: #arNote. "check this at some point"
- ^ self submorphs select:
- [:m | (m fullContainsPoint: aPoint) and: [m isLocked not]]!
Item was removed:
- ----- Method: Morph>>rootMorphsAtGlobal: (in category 'submorphs - misc') -----
- rootMorphsAtGlobal: aPoint
- "Return the list of root morphs containing the given point, excluding the receiver.
- ar 11/8/1999: Moved into morph for an incredibly ugly hack in 3D worlds"
-
- ^ self rootMorphsAt: (self pointFromWorld: aPoint)!
Item was removed:
- ----- Method: Morph>>rotationCenter (in category 'rotate scale and flex') -----
- 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."
- ^self valueOfProperty: #rotationCenter ifAbsent:[0.5 at 0.5]
- !
Item was removed:
- ----- Method: Morph>>rotationCenter: (in category 'rotate scale and flex') -----
- 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."
- aPointOrNil isNil
- ifTrue:[self removeProperty: #rotationCenter]
- ifFalse:[self setProperty: #rotationCenter toValue: aPointOrNil]
- !
Item was removed:
- ----- Method: Morph>>rotationDegrees (in category 'rotate scale and flex') -----
- rotationDegrees
-
- self isFlexed ifFalse: [^ 0.0].
- self owner in: [:flexShell | ^ flexShell rotationDegrees].!
Item was removed:
- ----- Method: Morph>>rotationDegrees: (in category 'rotate scale and flex') -----
- rotationDegrees: degrees
-
- self isFlexed ifFalse: [self addFlexShell].
- self owner in: [:flexShell | flexShell rotationDegrees: degrees].!
Item was removed:
- ----- Method: Morph>>rotationStyle (in category 'e-toy support') -----
- rotationStyle
- "Return the 'rotation style' of the receiver"
- ^#normal!
Item was removed:
- ----- Method: Morph>>rotationStyle: (in category 'e-toy support') -----
- rotationStyle: aSymbol
- "Set the 'rotation style' of the receiver; this is ignored for non-sketches"!
Item was removed:
- ----- Method: Morph>>roundUpStrays (in category 'miscellaneous') -----
- roundUpStrays
- "Bring submorphs of playfieldlike structures in the receiver's interior back within view."
-
- self submorphsDo:
- [:m | m isPlayfieldLike ifTrue: [m roundUpStrays]]!
Item was removed:
- ----- Method: Morph>>roundedCorners (in category 'rounding') -----
- roundedCorners
- "Return a list of those corners to round.
-
- 1-4
- | |
- 2-3
-
- Returned array contains `codes' of those corners, which should be rounded.
-
- 1 denotes top-left corner
- 2 denotes bottom-left corner
- 3 denotes bottom-right corner
- 4 denotes top-right corner.
-
- Thus, if this method returned #(2 3) that would mean that bottom (left and right)
- corners would be rounded whereas top (left and right) corners wouldn't be rounded.
-
- This method returns #(1 2 3 4) and that means that all the corners should be rounded."
-
- ^ #(1 2 3 4)!
Item was removed:
- ----- Method: Morph>>roundedCornersString (in category 'rounding') -----
- roundedCornersString
- "Answer the string to put in a menu that will invite the user to
- switch to the opposite corner-rounding mode"
- ^ (self wantsRoundedCorners
- ifTrue: ['<yes>']
- ifFalse: ['<no>'])
- , 'round corners' translated!
Item was removed:
- ----- Method: Morph>>rubberBandCells (in category 'layout properties - table') -----
- rubberBandCells
- "Layout specific. This property describes if a parent that is #shrinkWrapped around its children should ignore any #spaceFill children. E.g., when #rubberBandCells is true, the compound layout will always stay at the smallest available size, even though some child may be able to grow."
- | props |
- props := self layoutProperties.
- ^props ifNil:[false] ifNotNil:[props rubberBandCells].!
Item was removed:
- ----- Method: Morph>>rubberBandCells: (in category 'layout properties - table') -----
- rubberBandCells: aBool
- "Layout specific. This property describes if a parent that is #shrinkWrapped around its children should ignore any #spaceFill children. E.g., when #rubberBandCells is true, the compound layout will always stay at the smallest available size, even though some child may be able to grow."
- self assureTableLayoutProperties rubberBandCells: aBool.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>saveAsPrototype (in category 'meta-actions') -----
- saveAsPrototype
- (UIManager default confirm: 'Make this morph the prototype for ', self class printString, '?')
- ifFalse: [^ self].
- self class prototype: self.
- !
Item was removed:
- ----- Method: Morph>>saveAsResource (in category 'fileIn/out') -----
- saveAsResource
-
- | pathName |
- (self hasProperty: #resourceFilePath) ifFalse: [^ self].
- pathName := self valueOfProperty: #resourceFilePath.
- (pathName asLowercase endsWith: '.morph') ifFalse:
- [^ self error: 'Can only update morphic resources'].
- (FileStream newFileNamed: pathName) fileOutClass: nil andObject: self.!
Item was removed:
- ----- Method: Morph>>saveDocPane (in category 'fileIn/out') -----
- saveDocPane
-
- Smalltalk at: #DocLibrary ifPresent:[:dl| dl external saveDocCheck: self]!
Item was removed:
- ----- Method: Morph>>saveOnFile (in category 'fileIn/out') -----
- saveOnFile
- "Ask the user for a filename and save myself on a SmartRefStream file. Writes out the version and class structure. The file is fileIn-able. UniClasses will be filed out."
- | aFileName |
- aFileName := ('my {1}.morph' translated format: {self class name}) asFileName. "do better?"
- aFileName := UIManager default saveFilenameRequest: 'File name?' translated
- initialAnswer: aFileName.
- aFileName ifNil: [^ Beeper beep].
-
- self allMorphsDo: [:m | m prepareToBeSaved].
-
- self saveOnFileNamed: aFileName!
Item was removed:
- ----- Method: Morph>>saveOnURL (in category 'fileIn/out') -----
- saveOnURL
- "Ask the user for a url and save myself on a SmartReferenceStream file. Writes out the version and class structure. The file is fileIn-able. UniClasses will be filed out."
-
- | um pg |
- (pg := self saveOnURLbasic) == #cancel ifTrue: [^ self].
- um := URLMorph newForURL: pg url.
- um setURL: pg url page: pg.
- pg isContentsInMemory ifTrue: [pg computeThumbnail].
- um isBookmark: true.
- um removeAllMorphs.
- um color: Color transparent.
- self primaryHand attachMorph: um.!
Item was removed:
- ----- Method: Morph>>saveOnURL: (in category 'fileIn/out') -----
- saveOnURL: suggestedUrlString
- "Save myself on a SmartReferenceStream file. If I don't already have a url, use the suggested one. Writes out the version and class structure. The file is fileIn-able. UniClasses will be filed out."
- | url pg stamp pol |
- (pg := self valueOfProperty: #SqueakPage)
- ifNil: [ pg := SqueakPage new ]
- ifNotNil:
- [ pg contentsMorph ~~ self ifTrue:
- [ self inform: 'morph''s SqueakPage property is out of date'.
- pg := SqueakPage new ] ].
- (url := pg url) ifNil: [ url := pg urlNoOverwrite: suggestedUrlString ].
- stamp := Utilities authorInitialsPerSe.
- stamp isEmptyOrNil ifTrue: [ stamp := '*' ].
- pg
- saveMorph: self
- author: stamp.
- SqueakPageCache
- atURL: url
- put: pg.
- "setProperty: #SqueakPage"
- (pol := pg policy) ifNil: [ pol := #neverWrite ].
- pg
- policy: #now ;
- dirty: true.
- pg write.
- "force the write"
- pg policy: pol.
- ^pg!
Item was removed:
- ----- Method: Morph>>saveOnURLbasic (in category 'fileIn/out') -----
- saveOnURLbasic
- "Ask the user for a url and save myself on a SmartReferenceStream file. Writes out the version and class structure. The file is fileIn-able. UniClasses will be filed out."
-
- | url pg stamp pol |
- (pg := self valueOfProperty: #SqueakPage) ifNil: [pg := SqueakPage new]
- ifNotNil:
- [pg contentsMorph ~~ self
- ifTrue:
- [self inform: 'morph''s SqueakPage property is out of date'.
- pg := SqueakPage new]].
- (url := pg url) ifNil:
- [url := ServerDirectory defaultStemUrl , '1.sp'. "A new legal place"
- url := UIManager default
- request: 'url of a place to store this object.
- Must begin with file:// or ftp://'
- initialAnswer: url.
- url isEmpty ifTrue: [^#cancel]].
- stamp := Utilities authorInitialsPerSe.
- stamp isEmptyOrNil ifTrue: [ stamp := '*' ].
- pg saveMorph: self author: stamp.
- SqueakPageCache atURL: url put: pg. "setProperty: #SqueakPage"
- (pol := pg policy) ifNil: [pol := #neverWrite].
- pg
- policy: #now;
- dirty: true.
- pg write. "force the write"
- pg policy: pol.
- ^pg!
Item was removed:
- ----- Method: Morph>>scaleFactor (in category 'accessing') -----
- scaleFactor
- ^self valueOfProperty: #scaleFactor ifAbsent: [ 1.0 ]
- !
Item was removed:
- ----- Method: Morph>>screenLocation (in category 'geometry - etoys') -----
- screenLocation
- "For compatibility only"
-
- ^ self fullBounds origin!
Item was removed:
- ----- Method: Morph>>screenRectangle (in category 'geometry - etoys') -----
- screenRectangle
- "For compatibility only"
-
- ^ self fullBounds!
Item was removed:
- ----- Method: Morph>>selectedObject (in category 'selected object') -----
- selectedObject
- "answer the selected object for the hand or nil is none"
- ^ self primaryHand selectedObject!
Item was removed:
- ----- Method: Morph>>sendFilterEvent:for:to: (in category 'events-processing') -----
- sendFilterEvent: anEvent for: anObject to: filterGroup
- "An event gets filtered if some event filter wants to filter it."
-
- | filteredEvent |
- filterGroup ifNil: [^anEvent].
-
- filteredEvent := anEvent.
- filterGroup do: [:filterOrNil | filterOrNil ifNotNil: [:filter |
- filteredEvent := filter filterEvent: filteredEvent for: anObject]].
-
- ^ filteredEvent!
Item was removed:
- ----- Method: Morph>>sendFilterEventBubble:for: (in category 'events-processing') -----
- sendFilterEventBubble: anEvent for: anObject
- "Apply event bubbling filters."
-
- ^ self
- sendFilterEventBubbleAgain: (self sendFilterEvent: anEvent for: anObject to: self eventBubbleFilters)
- for: anObject!
Item was removed:
- ----- Method: Morph>>sendFilterEventBubbleAgain:for: (in category 'events-processing') -----
- sendFilterEventBubbleAgain: anEvent for: anObject
- "Apply keyboard-specific and mouse-specific bubbling filters. If a filter changes the event type, filter again. WARNING: This is a powerful mechanism. Filters can create endless loops, which are difficult to debug."
-
- | filteredEvent |
- filteredEvent := anEvent.
-
- filteredEvent isKeyboard ifTrue: [
- filteredEvent := self sendFilterEvent: filteredEvent for: anObject to: self keyboardBubbleFilters.
- filteredEvent isKeyboard not ifTrue: [^ self sendFilterEventBubbleAgain: filteredEvent for: anObject]].
-
- filteredEvent isMouse ifTrue: [
- filteredEvent := self sendFilterEvent: filteredEvent for: anObject to: self mouseBubbleFilters.
- filteredEvent isMouse not ifTrue: [^ self sendFilterEventBubbleAgain: filteredEvent for: anObject]].
-
- ^ filteredEvent!
Item was removed:
- ----- Method: Morph>>sendFilterEventCapture:for: (in category 'events-processing') -----
- sendFilterEventCapture: anEvent for: anObject
- "Apply event capturing filters."
-
- ^ self
- sendFilterEventCaptureAgain: (self sendFilterEvent: anEvent for: anObject to: self eventCaptureFilters)
- for: anObject!
Item was removed:
- ----- Method: Morph>>sendFilterEventCaptureAgain:for: (in category 'events-processing') -----
- sendFilterEventCaptureAgain: anEvent for: anObject
- "Apply keyboard-specific and mouse-specific capturing filters. If a filter changes the event type, filter again. WARNING: This is a powerful mechanism. Filters can create endless loops, which are difficult to debug."
-
- | filteredEvent |
- filteredEvent := anEvent.
-
- filteredEvent isKeyboard ifTrue: [
- filteredEvent := self sendFilterEvent: filteredEvent for: anObject to: self keyboardCaptureFilters.
- filteredEvent isKeyboard not ifTrue: [^ self sendFilterEventCaptureAgain: filteredEvent for: anObject]].
-
- filteredEvent isMouse ifTrue: [
- filteredEvent := self sendFilterEvent: filteredEvent for: anObject to: self mouseCaptureFilters.
- filteredEvent isMouse not ifTrue: [^ self sendFilterEventCaptureAgain: filteredEvent for: anObject]].
-
- ^ filteredEvent!
Item was removed:
- ----- Method: Morph>>separateDragAndDrop (in category 'dropping/grabbing') -----
- separateDragAndDrop
- "Conversion only. Separate the old #dragNDropEnabled into #dragEnabled and #dropEnabled and remove the old property."
- | dnd |
- (self hasProperty: #dragNDropEnabled) ifFalse:[^self].
- dnd := (self valueOfProperty: #dragNDropEnabled) == true.
- self dragEnabled: dnd.
- self dropEnabled: dnd.
- self removeProperty: #dragNDropEnabled.
- !
Item was removed:
- ----- Method: Morph>>setArrowheads (in category 'menus') -----
- setArrowheads
- "Let the user edit the size of arrowheads for this object"
-
- | aParameter result |
- aParameter := self renderedMorph valueOfProperty: #arrowSpec ifAbsent:
- [Preferences parameterAt: #arrowSpec ifAbsent: [5 @ 4]].
- result := Morph obtainArrowheadFor: 'Head size for arrowheads: ' translated defaultValue: aParameter asString.
- result ifNotNil:
- [self renderedMorph setProperty: #arrowSpec toValue: result]
- ifNil:
- [Beeper beep]!
Item was removed:
- ----- Method: Morph>>setAsActionInButtonProperties: (in category 'e-toy support') -----
- setAsActionInButtonProperties: buttonProperties
-
- ^false "means I don't know how to be set as a button action"!
Item was removed:
- ----- Method: Morph>>setBalloonText: (in category 'halos and balloon help') -----
- setBalloonText: stringOrText
- "Set receiver's balloon help text. Pass nil to remove the help."
-
- self flag: #deprecated. "mt: Use #balloonText:."
- self balloonText: stringOrText.!
Item was removed:
- ----- Method: Morph>>setBalloonText:maxLineLength: (in category 'halos and balloon help') -----
- setBalloonText: stringOrText maxLineLength: aLength
- "Set receiver's balloon help text. Pass nil to remove the help."
-
- self flag: #deprecated. "mt: Use #balloonText:."
- (extension isNil and: [stringOrText isNil]) ifTrue: [^ self].
- self assureExtension balloonText:
- (stringOrText ifNotNil: [stringOrText asString withNoLineLongerThan: aLength])!
Item was removed:
- ----- Method: Morph>>setBorderStyle: (in category 'accessing') -----
- setBorderStyle: aSymbol
- "Set the border style of my costume"
-
- (self borderStyleForSymbol: aSymbol)
- ifNotNil: [:style | self borderStyle: style].!
Item was removed:
- ----- Method: Morph>>setCenteredBalloonText: (in category 'halos and balloon help') -----
- setCenteredBalloonText: aString
- self setBalloonText: aString.
- self setProperty: #helpAtCenter toValue: true!
Item was removed:
- ----- Method: Morph>>setConstrainedPosition:hangOut: (in category 'geometry - misc') -----
- setConstrainedPosition: aPoint hangOut: partiallyOutside
- "Change the position of this morph and and all of its submorphs to aPoint, but don't let me go outside my owner's bounds. Let me go within two pixels of completely outside if partiallyOutside is true."
-
- | trialRect delta boundingMorph bRect |
- self flag: #smelly. "mt: The consideration of partiallyOutside is strange... The explicit #laoyutChanged, too."
- owner ifNil:[^self].
- trialRect := aPoint extent: self bounds extent.
- boundingMorph := self topRendererOrSelf owner.
- delta := boundingMorph
- ifNil: [0 at 0]
- ifNotNil: [
- bRect := partiallyOutside
- ifTrue: [boundingMorph bounds insetBy:
- self extent negated + boundingMorph borderWidth + (2 at 2)]
- ifFalse: [boundingMorph bounds].
- trialRect amountToTranslateWithin: bRect].
- self position: aPoint + delta.
- self layoutChanged "So that, eg, surrounding text will readjust"
- !
Item was removed:
- ----- Method: Morph>>setDirectionFrom: (in category 'rotate scale and flex') -----
- setDirectionFrom: aPoint
- | delta degrees |
- delta := (self transformFromWorld globalPointToLocal: aPoint) - self referencePosition.
- degrees := delta degrees + 90.0.
- self forwardDirection: (degrees \\ 360) rounded.
- !
Item was removed:
- ----- Method: Morph>>setExtentFromHalo: (in category 'miscellaneous') -----
- setExtentFromHalo: anExtent
- "The user has dragged the grow box such that the receiver's extent would be anExtent. Do what's needed"
-
- self extent: anExtent!
Item was removed:
- ----- Method: Morph>>setExtentFromLayout: (in category 'layout') -----
- setExtentFromLayout: aPoint
- "Sets the extent for laying out children of the receiver. We avoid triggering #layoutChanged again. This implementation is based on #extent:."
-
- "self assert: self owner layoutComputed not."
-
- self flag: #compatibility. "mt: There are way too many morphs that use #extent: to implement their own layout strategy such as updating gradient fills and submorph positions AND TEXT MORPH PARAGRAPHS (!!). So, we *must* call #extent: to trigger those layout updates. Since our owner has not yet computed its layout, we are fine performance-wise."
- self extent: aPoint.
-
- self flag: #alternative. "mt: The following code represents the desired implementation of this method."
- "(self extent closeTo: aPoint) ifTrue: [^ self].
-
- self invalidRect: self outerBounds.
- bounds := bounds topLeft extent: aPoint.
-
- self removeProperty: #dropShadow.
- self invalidRect: self outerBounds."!
Item was removed:
- ----- Method: Morph>>setFlexExtentFromHalo: (in category 'miscellaneous') -----
- setFlexExtentFromHalo: anExtent
- "The user has dragged the grow box such that the receiver's extent would be anExtent. Do what's needed. Set the extent of the top renderer as indicated."
-
- self addFlexShellIfNecessary.
- self topRendererOrSelf extent: anExtent!
Item was removed:
- ----- Method: Morph>>setLayoutBoundsFromLayout: (in category 'layout') -----
- setLayoutBoundsFromLayout: newLayoutBounds
- "Set the bounds for laying out children of the receiver. WE DO NOT MOVE CHILDREN HERE!!
-
- Note that this code is written so that #layoutBounds can be changed without touching this method. For example, the layout bounds are smaller or larger than the current bounds.
-
- WE MUST NOT TRIGGER #layoutChanged AGAIN!! See #doLayoutIn: and #adjustLayoutBounds."
-
- | priorBounds outer inner box |
- priorBounds := self outerBounds.
-
- outer := self bounds.
- inner := self layoutBounds.
- bounds := newLayoutBounds origin + (outer origin - inner origin) corner:
- newLayoutBounds corner + (outer corner - inner corner).
-
- bounds = outer ifFalse: [
- self removeProperty: #dropShadow.
- self invalidRect: (priorBounds quickMerge: self outerBounds)].!
Item was removed:
- ----- Method: Morph>>setNamePropertyTo: (in category 'naming') -----
- setNamePropertyTo: aName
- "change the receiver's externalName"
- self assureExtension externalName: aName!
Item was removed:
- ----- Method: Morph>>setNameTo: (in category 'naming') -----
- setNameTo: aName
- | nameToUse nameString |
- nameToUse := aName ifNotNil:
- [(nameString := aName asString) notEmpty ifTrue: [nameString] ifFalse: ['*']].
- self setNamePropertyTo: nameToUse "no Texts here!!"!
Item was removed:
- ----- Method: Morph>>setNumericValue: (in category 'e-toy support') -----
- setNumericValue: aValue
- "Set the receiver's contents to reflect the given numeric value. Only certain kinds of morphs know what to do with this, the rest, for now, stash the number in a property, where it may not be visible but at least it won't be lost, and can be retrieved by the companion getter. This code is never reached under normal circumstances, because the #numericValue slot is not shown in Viewers for most kinds of morphs, and those kinds of morphs that do show it also reimplement this method. However, this code *could* be reached via a user script which sends #setNumericValue: but whose receiver has been changed, via tile-scripting drag and drop for example, to one that doesn't directly handle numbers"
-
- ScriptingSystem informScriptingUser: 'an unusual setNumericValue: call was made'.
- self renderedMorph setProperty: #numericValue toValue: aValue
- !
Item was removed:
- ----- Method: Morph>>setPositionFromLayout: (in category 'layout') -----
- setPositionFromLayout: aPoint
- "Sets the position for laying out children of the receiver. We have to move the children here. We avoid triggering #layoutChanged again. This implementation is based on #position:."
-
- | delta box |
- delta := (aPoint - self bounds topLeft) rounded.
- (delta x = 0 and: [delta y = 0]) ifTrue: [^ self].
-
- box := self privateFullBoundsForRedraw.
- self invalidRect: (box merge: (box translateBy: delta)).
-
- self privateFullMoveBy: delta.!
Item was removed:
- ----- Method: Morph>>setProperties: (in category 'accessing - properties') -----
- setProperties: aList
- "Set many properties at once from a list of prop, value, prop, value. Answer the list."
-
- 1 to: aList size by: 2 do: [:ii |
- self setProperty: (aList at: ii) toValue: (aList at: ii+1)].
- ^ aList!
Item was removed:
- ----- Method: Morph>>setProperty:toValue: (in category 'accessing - properties') -----
- setProperty: aSymbol toValue: anObject
- "Change the receiver's property named aSymbol to anObject. Answer anObject."
- anObject ifNil: [
- self removeProperty: aSymbol.
- ^ anObject].
- ^ self assureExtension setProperty: aSymbol toValue: anObject!
Item was removed:
- ----- Method: Morph>>setRotationCenter (in category 'menus') -----
- setRotationCenter
- | p |
- self world displayWorld.
- p := Cursor crossHair showWhile:
- [Sensor waitButton].
- Sensor waitNoButton.
- self setRotationCenterFrom: (self transformFromWorld globalPointToLocal: p).
-
- !
Item was removed:
- ----- Method: Morph>>setRotationCenterFrom: (in category 'menus') -----
- setRotationCenterFrom: aPoint
- self rotationCenter: (aPoint - self bounds origin) / self bounds extent asFloatPoint.!
Item was removed:
- ----- Method: Morph>>setShadowOffset: (in category 'drop shadows') -----
- setShadowOffset: evt
- | handle |
- handle := HandleMorph new forEachPointDo:
- [:newPoint | self shadowPoint: newPoint].
- evt hand attachMorph: handle.
- handle startStepping.
- !
Item was removed:
- ----- Method: Morph>>setStandardTexture (in category 'e-toy support') -----
- setStandardTexture
- | parms |
- parms := self textureParameters.
- self makeGraphPaperGrid: parms first
- background: parms second
- line: parms third!
Item was removed:
- ----- Method: Morph>>setToAdhereToEdge: (in category 'menus') -----
- setToAdhereToEdge: anEdge
- anEdge ifNil: [^ self].
- anEdge == #none ifTrue: [^ self removeProperty: #edgeToAdhereTo].
- self setProperty: #edgeToAdhereTo toValue: anEdge.
- self layoutChanged.
- !
Item was removed:
- ----- Method: Morph>>shadowColor (in category 'drop shadows') -----
- shadowColor
- ^self valueOfProperty: #shadowColor ifAbsent:[Color black]!
Item was removed:
- ----- Method: Morph>>shadowColor: (in category 'drop shadows') -----
- shadowColor: aColor
- self shadowColor = aColor ifTrue: [^ self].
- self setProperty: #shadowColor toValue: aColor.
- self removeProperty: #dropShadow.
- self changed.!
Item was removed:
- ----- Method: Morph>>shadowForm (in category 'drawing') -----
- shadowForm
- "Return a form representing the 'shadow' of the receiver - e.g., all pixels that are occupied by the receiver are one, all others are zero."
- | canvas |
- canvas := (Display defaultCanvasClass extent: self fullBounds extent depth: 1)
- asShadowDrawingCanvas: Color black. "Color black represents one for 1bpp"
- canvas translateBy: bounds topLeft negated
- during:[:tempCanvas| tempCanvas fullDrawMorph: self].
- ^ canvas form offset: bounds topLeft
- !
Item was removed:
- ----- Method: Morph>>shadowOffset (in category 'drop shadows') -----
- shadowOffset
- "Return the current shadow offset"
- ^self valueOfProperty: #shadowOffset ifAbsent:[0 at 0]!
Item was removed:
- ----- Method: Morph>>shadowOffset: (in category 'drop shadows') -----
- shadowOffset: aPoint
- "Set the current shadow offset"
-
- self shadowOffset = aPoint ifTrue: [^ self].
- self changed.
-
- (aPoint isNil or: [ aPoint isZero ])
- ifTrue:[self removeProperty: #shadowOffset]
- ifFalse:[self setProperty: #shadowOffset toValue: aPoint].
-
- self removeProperty: #dropShadow.
- self layoutChanged.
- self changed.!
Item was removed:
- ----- Method: Morph>>shadowPoint: (in category 'drop shadows') -----
- shadowPoint: newPoint
- "Can be reset in #addDropShadow."
-
- | delta |
- delta := newPoint - self center.
- self shadowOffset: (self useSoftDropShadow
- ifTrue: [(10 at 8 corner: 10 at 12) outsetBy: delta]
- ifFalse: [delta]).
-
- !
Item was removed:
- ----- Method: Morph>>shiftSubmorphsOtherThan:by: (in category 'geometry - misc') -----
- shiftSubmorphsOtherThan: listNotToShift by: delta
- | rejectList |
- rejectList := listNotToShift ifNil: [OrderedCollection new].
- (submorphs copyWithoutAll: rejectList) do:
- [:m | m position: (m position + delta)]!
Item was removed:
- ----- Method: Morph>>shouldDropOnMouseUp (in category 'testing') -----
- shouldDropOnMouseUp
- | former |
- former := self formerPosition ifNil:[^false].
- ^(former dist: self position) > 10!
Item was removed:
- ----- Method: Morph>>shouldGetStepsFrom: (in category 'WiW support') -----
- shouldGetStepsFrom: aWorld
- ^self world == aWorld!
Item was removed:
- ----- Method: Morph>>shouldRememberCostumes (in category 'player') -----
- shouldRememberCostumes
- ^true!
Item was removed:
- ----- Method: Morph>>show (in category 'drawing') -----
- show
-
- self visible ifFalse: [self visible: true].!
Item was removed:
- ----- Method: Morph>>showActions (in category 'meta-actions') -----
- showActions
- "Put up a message list browser of all the code that this morph
- would run for mouseUp, mouseDown, mouseMove, mouseEnter,
- mouseLeave, and
- mouseLinger. tk 9/13/97"
- | list cls selector adder |
- list := OrderedCollection new.
- adder := [:mrClass :mrSel | list
- add: (MethodReference class: mrClass selector: mrSel)].
- "the eventHandler"
- self eventHandler
- ifNotNil: [list := self eventHandler methodRefList.
- (self eventHandler handlesMouseDown: nil)
- ifFalse: [adder value: HandMorph value: #grabMorph:]].
- "If not those, then non-default raw events"
- #(#keyStroke: #mouseDown: #mouseEnter: #mouseLeave: #mouseMove: #mouseUp: #doButtonAction )
- do: [:sel |
- cls := self class whichClassIncludesSelector: sel.
- cls
- ifNotNil: ["want more than default behavior"
- cls == Morph
- ifFalse: [adder value: cls value: sel]]].
- "The mechanism on a Button"
- (self respondsTo: #actionSelector)
- ifTrue: ["A button"
- selector := self actionSelector.
- cls := self target class whichClassIncludesSelector: selector.
- cls
- ifNotNil: ["want more than default behavior"
- cls == Morph
- ifFalse: [adder value: cls value: selector]]].
- MessageSet openMessageList: list sort name: 'Actions
- of ' , self printString autoSelect: nil!
Item was removed:
- ----- Method: Morph>>showBalloon (in category 'halos and balloon help') -----
- showBalloon
-
- self showBalloon: self balloonText.!
Item was removed:
- ----- Method: Morph>>showBalloon: (in category 'halos and balloon help') -----
- showBalloon: msgString
- "Pop up a balloon containing the given string."
-
- self isInWorld ifFalse: [^ self].
- (msgString isNil or: [msgString isEmpty]) ifTrue: [^ self].
-
- (self balloonMorphClass
- string: msgString
- for: self balloonHelpAligner)
- popUp.!
Item was removed:
- ----- Method: Morph>>showBalloon:at: (in category 'halos and balloon help') -----
- showBalloon: msgString at: point
- "Pop up a balloon containing the given string."
-
- self isInWorld ifFalse: [^ self].
- (msgString isNil or: [msgString isEmpty]) ifTrue: [^ self].
-
- (self balloonMorphClass
- string: msgString
- for: self balloonHelpAligner)
- popUpAt: point.!
Item was removed:
- ----- Method: Morph>>showBalloon:hand: (in category 'halos and balloon help') -----
- showBalloon: msgString hand: aHand
- "Pop up a balloon containing the given string. Note that any existing BalloonMorphs will be removed from the world."
-
- | balloon |
- self isInWorld ifFalse: [^ self].
-
- balloon := (self balloonMorphClass
- string: msgString
- for: self balloonHelpAligner).
-
- balloon
- popUpFor: self
- hand: (aHand ifNil: [self world activeHand]).!
Item was removed:
- ----- Method: Morph>>showHiders (in category 'meta-actions') -----
- showHiders
- self allMorphsDo:[:m | m show]!
Item was removed:
- ----- Method: Morph>>shuffleSubmorphs (in category 'submorphs - misc') -----
- shuffleSubmorphs
- "Randomly shuffle the order of my submorphs. Don't call this method lightly!!"
-
- | bg |
- self invalidRect: self fullBounds.
- (submorphs notEmpty and: [submorphs last mustBeBackmost])
- ifTrue:
- [bg := submorphs last.
- bg privateDelete].
- submorphs := submorphs shuffled.
- bg ifNotNil: [self addMorphBack: bg].
- self layoutChanged!
Item was removed:
- ----- Method: Morph>>sightTargets: (in category 'meta-actions') -----
- sightTargets: event
- "Return the potential targets for the receiver.
- This is derived from Morph>>potentialEmbeddingTargets."
- | bullseye candidates choice |
- owner ifNil: [^ #()].
- bullseye := Point fromUserWithCursor: Cursor target.
- candidates := self potentialTargetsAt: bullseye.
- choice := UIManager default
- chooseFrom: (candidates collect:[:m| m knownName ifNil:[m class name]])
- values: candidates.
- choice ifNotNil:[self target: choice].!
Item was removed:
- ----- Method: Morph>>sightWorldTargets: (in category 'meta-actions') -----
- sightWorldTargets: event
- "Return the potential targets for the receiver.
- This is derived from Morph>>potentialEmbeddingTargets."
- | bullseye myWorld candidates choice |
- myWorld := self world ifNil: [^ #()].
- bullseye := Point fromUserWithCursor: Cursor target.
- candidates := myWorld morphsAt: bullseye.
- choice := UIManager default
- chooseFrom: (candidates collect:[:m| m knownName ifNil:[m class name]])
- values: candidates.
- choice ifNotNil:[self target: choice].!
Item was removed:
- ----- Method: Morph>>slideBackToFormerSituation: (in category 'dropping/grabbing') -----
- slideBackToFormerSituation: evt
- "A drop of the receiver having been rejected, slide it back to where it came from, if possible."
-
- | slideForm formerOwner formerPosition aWorld startPoint endPoint trans |
- formerOwner := self formerOwner.
- formerPosition := self formerPosition.
- (aWorld := evt hand world) ifNil: [^ self delete]. "Likely a moribund hand from an EventRecorder playback."
-
- trans := formerOwner transformFromWorld.
- slideForm := trans isPureTranslation
- ifTrue: [self imageForm offset: 0 @ 0]
- ifFalse:
- [((TransformationMorph new asFlexOf: self) transform: trans) imageForm
- offset: 0 @ 0].
- startPoint := evt hand fullBounds origin.
- endPoint := trans localPointToGlobal: formerPosition.
- owner removeMorph: self.
- aWorld displayWorld.
- slideForm
- slideFrom: startPoint
- to: endPoint
- nSteps: 12
- delay: 15.
- "The OLPC Virtual Screen wouldn't notice the last update here."
- self refreshWorld.
- formerOwner addMorph: self.
- self position: formerPosition.
- self justDroppedInto: formerOwner event: evt!
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 == ScrapBook default scrapBook) or: [self renderedMorph isKindOf: TrashCanMorph]) ifTrue:
- [self dismissMorph. ^ self].
- TrashCanMorph slideDismissalsToTrash ifTrue:
- [morphToSlide := self representativeNoTallerThan: 200 norWiderThan: 200 thumbnailHeight: 100.
- aForm := morphToSlide imageForm offset: (0 at 0).
- trash := self currentWorld
- findDeepSubmorphThat:
- [:aMorph | (aMorph isKindOf: TrashCanMorph) and:
- [aMorph topRendererOrSelf owner == self currentWorld]]
- ifAbsent:
- [trash := TrashCanMorph new.
- trash position: self currentWorld bottomLeft - (0 @ (trash extent y + 26)).
- trash openInWorld.
- trash].
- endPoint := trash fullBoundsInWorld center.
- startPoint := self topRendererOrSelf fullBoundsInWorld center - (aForm extent // 2)].
- self dismissMorph.
- self currentWorld displayWorld.
- TrashCanMorph slideDismissalsToTrash ifTrue:
- [aForm slideFrom: startPoint to: endPoint nSteps: 12 delay: 15].
- ScrapBook default addToTrash: self!
Item was removed:
- ----- Method: Morph>>snapToEdgeIfAppropriate (in category 'menus') -----
- snapToEdgeIfAppropriate
- | edgeSymbol oldBounds aWorld |
- (edgeSymbol := self valueOfProperty: #edgeToAdhereTo) ifNotNil:
- [oldBounds := bounds.
- self adhereToEdge: edgeSymbol.
- bounds ~= oldBounds ifTrue: [(aWorld := self world) ifNotNil: [aWorld viewBox ifNotNil:
- [aWorld displayWorld]]]]!
Item was removed:
- ----- Method: Morph>>spaceFillWeight (in category 'layout properties - table') -----
- spaceFillWeight
- "Layout specific. This property describes the relative weight that
- should be given to the receiver when extra space is distributed
- between different #spaceFill cells."
-
- ^ self
- valueOfProperty: #spaceFillWeight
- ifAbsent: [1]!
Item was removed:
- ----- Method: Morph>>spaceFillWeight: (in category 'layout properties - table') -----
- spaceFillWeight: aNumber
- "Layout specific. This property describes the relative weight that should be given to the receiver when extra space is distributed between different #spaceFill cells."
- aNumber = 1
- ifTrue:[self removeProperty: #spaceFillWeight]
- ifFalse:[self setProperty: #spaceFillWeight toValue: aNumber].
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>specialNameInModel (in category 'naming') -----
- specialNameInModel
- "Return the name for this morph in the underlying model or nil."
-
- "Not an easy problem. For now, take the first part of the mouseDownSelector symbol in my eventHandler (fillBrushMouseUp:morph: gives 'fillBrush'). 5/26/97 tk"
-
- | hh |
- (self isMorphicModel)
- ifTrue: [^self slotName]
- ifFalse:
- [self eventHandler ifNotNil:
- [self eventHandler mouseDownSelector ifNotNil:
- [hh := self eventHandler mouseDownSelector indexOfSubCollection: 'Mouse'
- startingAt: 1.
- hh > 0
- ifTrue: [^self eventHandler mouseDownSelector copyFrom: 1 to: hh - 1]].
- self eventHandler mouseUpSelector ifNotNil:
- [hh := self eventHandler mouseUpSelector indexOfSubCollection: 'Mouse'
- startingAt: 1.
- hh > 0 ifTrue: [^self eventHandler mouseUpSelector copyFrom: 1 to: hh - 1]]]].
-
- " (self eventHandler mouseDownRecipient respondsTo: #nameFor:) ifTrue: [
- ^ self eventHandler mouseDownRecipient nameFor: self]]]. "
- "myModel := self findA: MorphicModel.
- myModel ifNotNil: [^ myModel slotName]"
- ^self world specialNameInModelFor: self!
Item was removed:
- ----- Method: Morph>>sqkPage (in category 'accessing') -----
- sqkPage
- ^ self valueOfProperty: #SqueakPage!
Item was removed:
- ----- Method: Morph>>standardPalette (in category 'initialization') -----
- standardPalette
- "Answer a standard palette forced by some level of enclosing presenter, or nil if none"
- | pal aPresenter itsOwner |
- (aPresenter := self presenter) ifNil: [^ nil].
- ^ (pal := aPresenter ownStandardPalette)
- ifNotNil: [pal]
- ifNil: [(itsOwner := aPresenter associatedMorph owner)
- ifNotNil:
- [itsOwner standardPalette]
- ifNil:
- [nil]]!
Item was removed:
- ----- Method: Morph>>start (in category 'stepping and presenter') -----
- start
- "Start running my script. For ordinary morphs, this means start stepping."
-
- self startStepping.
- !
Item was removed:
- ----- Method: Morph>>startDrag: (in category 'event handling') -----
- startDrag: evt
- "Handle a drag event when the user moves the cursor over the receiver, pressing and holding the red button, and then moves the cursor for more than the #dragThreshold. This message is only sent to clients that request it by sending #waitForClicksOrDrag:event: to the initiating hand in their mouseDown: method. This default implementation delegates to an #eventHandler if any."
-
- self eventHandler ifNotNil:
- [self eventHandler startDrag: evt fromMorph: self].!
Item was removed:
- ----- Method: Morph>>startDrag:with: (in category 'dropping/grabbing') -----
- startDrag: anItem with: anObject
- self currentHand attachMorph: anObject!
Item was removed:
- ----- Method: Morph>>startStepping (in category 'stepping and presenter') -----
- startStepping
- "Start getting sent the 'step' message."
- self startStepping: #stepAt: at: Time millisecondClockValue arguments: nil stepTime: nil.!
Item was removed:
- ----- Method: Morph>>startStepping:at:arguments:stepTime: (in category 'stepping and presenter') -----
- startStepping: aSelector at: scheduledTime arguments: args stepTime: stepTime
- "Start stepping the receiver"
- | w |
- w := self world.
- w ifNotNil: [
- w startStepping: self at: scheduledTime selector: aSelector arguments: args stepTime: stepTime.
- self changed].!
Item was removed:
- ----- Method: Morph>>startSteppingIn: (in category 'stepping and presenter') -----
- startSteppingIn: aWorld
- "Start getting sent the 'step' message in aWorld"
-
- self step. "one to get started!!"
- aWorld ifNotNil: [aWorld startStepping: self].
- self changed!
Item was removed:
- ----- Method: Morph>>startSteppingSelector: (in category 'stepping and presenter') -----
- startSteppingSelector: aSelector
- "Start getting sent the 'step' message."
- self startStepping: aSelector at: Time millisecondClockValue arguments: nil stepTime: nil.!
Item was removed:
- ----- Method: Morph>>startWiring (in category 'menu') -----
- startWiring
- Smalltalk
- at: #NCAAConnectorMorph
- ifPresent: [:connectorClass | connectorClass newCurvyArrow startWiringFrom: self] !
Item was removed:
- ----- Method: Morph>>step (in category 'stepping and presenter') -----
- step
- "Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message. The generic version dispatches control to the player, if any. The nasty circumlocation about owner's transformation is necessitated by the flexing problem that the player remains in the properties dictionary both of the flex and the real morph. In the current architecture, only the top renderer's pointer to the player should actually be honored for the purpose of firing."
- !
Item was removed:
- ----- Method: Morph>>stepAt: (in category 'stepping and presenter') -----
- stepAt: millisecondClockValue
- "Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message.
- The millisecondClockValue parameter gives the value of the millisecond clock at the moment of dispatch.
- Default is to dispatch to the parameterless step method for the morph, but this protocol makes it possible for some morphs to do differing things depending on the clock value"
- self player ifNotNil:[:p| p stepAt: millisecondClockValue].
- self step
- !
Item was removed:
- ----- Method: Morph>>stepTime (in category 'stepping and presenter') -----
- stepTime
- "Answer the desired time between steps in milliseconds. This default implementation requests that the 'step' method be called once every second."
-
- ^ self topRendererOrSelf player ifNotNil: [10] ifNil: [1000]!
Item was removed:
- ----- Method: Morph>>stickinessString (in category 'menus') -----
- stickinessString
- "Answer the string to be shown in a menu to represent the
- stickiness status"
- ^ (self isSticky
- ifTrue: ['<yes>']
- ifFalse: ['<no>'])
- , 'resist being picked up' translated!
Item was removed:
- ----- Method: Morph>>sticky: (in category 'accessing') -----
- sticky: aBoolean
- "change the receiver's sticky property"
- (extension isNil and: [aBoolean not]) ifTrue: [^ self].
- self assureExtension sticky: aBoolean!
Item was removed:
- ----- Method: Morph>>stop (in category 'stepping and presenter') -----
- stop
- "Stop running my script. For ordinary morphs, this means stop stepping."
-
- self stopStepping.
- !
Item was removed:
- ----- Method: Morph>>stopStepping (in category 'stepping and presenter') -----
- stopStepping
- "Stop getting sent the 'step' message."
-
- | w |
- w := self world.
- w ifNotNil: [w stopStepping: self].
- !
Item was removed:
- ----- Method: Morph>>stopSteppingSelector: (in category 'stepping and presenter') -----
- stopSteppingSelector: aSelector
- "Stop getting sent the given message."
- | w |
- w := self world.
- w ifNotNil: [w stopStepping: self selector: aSelector].
- !
Item was removed:
- ----- Method: Morph>>stopSteppingSelfAndSubmorphs (in category 'stepping and presenter') -----
- stopSteppingSelfAndSubmorphs
- self allMorphsDo: [:m | m stopStepping]
- !
Item was removed:
- ----- Method: Morph>>storeDataOn: (in category 'objects from disk') -----
- storeDataOn: aDataStream
- "Let all Morphs be written out. All owners are weak references. They only go out if the owner is in the tree being written."
- | cntInstVars cntIndexedVars ti localInstVars |
-
- "block my owner unless he is written out by someone else"
- cntInstVars := self class instSize.
- cntIndexedVars := self basicSize.
- localInstVars := Morph instVarNames.
- ti := 2.
- ((localInstVars at: ti) = 'owner') & (Morph superclass == Object) ifFalse:
- [self error: 'this method is out of date'].
- aDataStream
- beginInstance: self class
- size: cntInstVars + cntIndexedVars.
- 1 to: ti-1 do:
- [:i | aDataStream nextPut: (self instVarAt: i)].
- aDataStream nextPutWeak: owner. "owner only written if in our tree"
- ti+1 to: cntInstVars do:
- [:i | aDataStream nextPut: (self instVarAt: i)].
- 1 to: cntIndexedVars do:
- [:i | aDataStream nextPut: (self basicAt: i)]!
Item was removed:
- ----- Method: Morph>>structureString (in category 'printing') -----
- structureString
- "Return a string that showing this morph and all its submorphs in an indented list that reflects its structure."
-
- | s |
- s := WriteStream on: (String new: 1000).
- self printStructureOn: s indent: 0.
- ^ s contents
- !
Item was removed:
- ----- Method: Morph>>subclassMorph (in category 'meta-actions') -----
- subclassMorph
- "Create a new subclass of this morph's class and make this morph be an instance of it."
-
- | oldClass newClassName newClass |
- oldClass := self class.
- newClassName := UIManager default
- request: 'Please give this new class a name'
- initialAnswer: oldClass name.
- newClassName = '' ifTrue: [^ self].
- (Smalltalk includesKey: newClassName)
- ifTrue: [^ self inform: 'Sorry, there is already a class of that name'].
-
- newClass := oldClass subclass: newClassName asSymbol
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: oldClass category asString.
- self becomeForward: (self as: newClass)!
Item was removed:
- ----- Method: Morph>>submorphAfter (in category 'submorphs - misc') -----
- submorphAfter
- "Return the submorph after (behind) me, or nil"
- | ii |
- owner ifNil: [^ nil].
- ^ (ii := owner submorphIndexOf: self) = owner submorphs size
- ifTrue: [nil]
- ifFalse: [owner submorphs at: ii+1].
-
- !
Item was removed:
- ----- Method: Morph>>submorphBefore (in category 'submorphs - misc') -----
- submorphBefore
- "Return the submorph after (behind) me, or nil"
- | ii |
- owner ifNil: [^ nil].
- ^ (ii := owner submorphIndexOf: self) = 1
- ifTrue: [nil]
- ifFalse: [owner submorphs at: ii-1].
-
- !
Item was removed:
- ----- Method: Morph>>submorphBounds (in category 'layout') -----
- submorphBounds
- "Private. Compute the actual full bounds of the receiver"
- | box |
- submorphs do: [:m | | subBox |
- (m visible) ifTrue: [
- subBox := m fullBounds.
- box
- ifNil:[box := subBox copy]
- ifNotNil:[box := box quickMerge: subBox]]].
- box ifNil:[^self bounds]. "e.g., having submorphs but not visible"
- ^ box origin asIntegerPoint corner: box corner asIntegerPoint
- !
Item was removed:
- ----- Method: Morph>>submorphBoundsForShrinkWrap (in category 'layout') -----
- submorphBoundsForShrinkWrap
- "Private. Compute the submorph bounds of the receiver to shrink-wrap around. Note that we are not interested in my submorphs' fullBounds. For full-bound wrapping, use #shrinkWrap all the way down."
-
- | box |
- self submorphsDo: [:m |
- m visible ifTrue: [
- box
- ifNil:[box := m bounds copy]
- ifNotNil:[box := box quickMerge: m bounds]]].
- box ifNil:[^ self layoutBounds]. "e.g., having submorphs but not visible"
- ^ box origin asIntegerPoint corner: box corner asIntegerPoint!
Item was removed:
- ----- Method: Morph>>submorphCount (in category 'submorphs - accessing') -----
- submorphCount
-
- ^ submorphs size!
Item was removed:
- ----- Method: Morph>>submorphIndexOf: (in category 'submorphs - accessing') -----
- submorphIndexOf: aMorph
- "Assuming aMorph to be one of my submorphs, answer where it occurs in my submorph list"
-
- ^ submorphs indexOf: aMorph ifAbsent: [nil]!
Item was removed:
- ----- Method: Morph>>submorphNamed: (in category 'submorphs - accessing') -----
- submorphNamed: aName
- ^ self submorphNamed: aName ifNone: [nil]!
Item was removed:
- ----- Method: Morph>>submorphNamed:ifNone: (in category 'submorphs - accessing') -----
- submorphNamed: aName ifNone: aBlock
- "Find the first submorph with this name, or a button with an action selector of that name"
-
-
- self submorphs do: [:p | p knownName = aName ifTrue: [^p]].
- self submorphs do:
- [:button | | sub args |
- (button respondsTo: #actionSelector)
- ifTrue: [button actionSelector == aName ifTrue: [^button]].
- ((button respondsTo: #arguments) and: [(args := button arguments) notNil])
- ifTrue: [(args at: 2 ifAbsent: [nil]) == aName ifTrue: [^button]].
- (button isAlignmentMorph)
- ifTrue: [(sub := button submorphNamed: aName ifNone: [nil]) ifNotNil: [^sub]]].
- ^aBlock value!
Item was removed:
- ----- Method: Morph>>submorphOfClass: (in category 'submorphs - misc') -----
- submorphOfClass: aClass
-
- ^self findA: aClass!
Item was removed:
- ----- Method: Morph>>submorphThat:ifNone: (in category 'submorphs - accessing') -----
- submorphThat: block1 ifNone: block2
-
- ^submorphs detect: block1 ifNone: block2
- !
Item was removed:
- ----- Method: Morph>>submorphWithProperty: (in category 'submorphs - misc') -----
- submorphWithProperty: aSymbol
- ^ submorphs detect: [:aMorph | aMorph hasProperty: aSymbol] ifNone: [nil]!
Item was removed:
- ----- Method: Morph>>submorphs (in category 'submorphs - accessing') -----
- submorphs
- "This method returns my actual submorphs collection. Modifying the collection directly could be dangerous; make a copy if you need to alter it."
- ^ submorphs !
Item was removed:
- ----- Method: Morph>>submorphsBehind:do: (in category 'submorphs - enumerating') -----
- submorphsBehind: aMorph do: aBlock
- | behind |
- behind := false.
- submorphs do:
- [:m | m == aMorph ifTrue: [behind := true]
- ifFalse: [behind ifTrue: [aBlock value: m]]].
- !
Item was removed:
- ----- Method: Morph>>submorphsDo: (in category 'submorphs - enumerating') -----
- submorphsDo: aBlock
- submorphs do: aBlock!
Item was removed:
- ----- Method: Morph>>submorphsInFrontOf:do: (in category 'submorphs - enumerating') -----
- submorphsInFrontOf: aMorph do: aBlock
- | behind |
- behind := false.
- submorphs do:
- [:m | m == aMorph ifTrue: [behind := true]
- ifFalse: [behind ifFalse: [aBlock value: m]]].
- !
Item was removed:
- ----- Method: Morph>>submorphsReverseDo: (in category 'submorphs - enumerating') -----
- submorphsReverseDo: aBlock
-
- submorphs reverseDo: aBlock.!
Item was removed:
- ----- Method: Morph>>submorphsSatisfying: (in category 'submorphs - accessing') -----
- submorphsSatisfying: aBlock
- ^ submorphs select: [:m | (aBlock value: m) == true]!
Item was removed:
- ----- Method: Morph>>suspendEventHandler (in category 'event handling') -----
- suspendEventHandler
- self eventHandler ifNotNil:
- [self setProperty: #suspendedEventHandler toValue: self eventHandler.
- self eventHandler: nil].
- submorphs do: [:m | m suspendEventHandler]. "All those rectangles"!
Item was removed:
- ----- Method: Morph>>tabAmongFields (in category 'event handling') -----
- tabAmongFields
- ^ Preferences tabAmongFields
- or: [self hasProperty: #tabAmongFields] !
Item was removed:
- ----- Method: Morph>>target: (in category 'accessing-backstop') -----
- target: aMorph
- "Morphs with targets will override. This backstop does nothing."
- "This is here because targeting meta-actions are taken at morph level.
- Do not remove."!
Item was removed:
- ----- Method: Morph>>targetFromMenu: (in category 'meta-actions') -----
- targetFromMenu: aMenu
- "Some other morph become target of the receiver"
- | newTarget |
-
- newTarget := aMenu startUpWithCaption: self externalName , ' targets...'.
- newTarget
- ifNil: [^ self].
- self target: newTarget!
Item was removed:
- ----- Method: Morph>>targetWith: (in category 'meta-actions') -----
- targetWith: evt
- "Some other morph become target of the receiver"
- | morphs newTarget |
- morphs := self potentialTargets.
- newTarget := UIManager default
- chooseFrom: (morphs collect: [:m | m knownName ifNil:[m class name asString]])
- values: morphs
- title: self externalName, ' targets...'.
- newTarget ifNil:[^self].
- self target: newTarget.!
Item was removed:
- ----- Method: Morph>>tempCommand (in category 'debug and other') -----
- tempCommand
- "Generic backstop. If you care to, you can comment out what's below here, and substitute your own code, though the intention of design of the feature is that you leave this method as it is, and instead reimplement tempCommand in the class of whatever individual morph you care to. In any case, once you have your own #tempCommand in place, you will then be able to invoke it from the standard debugging menus."
-
- self inform: 'Before calling tempCommand, you
- should first give it a definition. To
- do this, choose "define tempCommand"
- from the debug menu.' translated!
Item was removed:
- ----- Method: Morph>>textAnchorProperties (in category 'text-anchor') -----
- textAnchorProperties
-
- ^ self valueOfProperty: #textAnchorProperties ifAbsentPut: [TextAnchorProperties new]!
Item was removed:
- ----- Method: Morph>>textToPaste (in category 'printing') -----
- textToPaste
- "If the receiver has text to offer pasting, answer it, else answer nil"
-
- ^ nil!
Item was removed:
- ----- Method: Morph>>textureParameters (in category 'e-toy support') -----
- textureParameters
- "Answer a triplet giving the preferred grid size, background color, and line color. The choices here are as suggested by Alan, 9/13/97"
-
- ^ Array with: 16 with: Color lightYellow with: Color lightGreen lighter lighter!
Item was removed:
- ----- Method: Morph>>thumbnail (in category 'thumbnail') -----
- thumbnail
- "Answer an appropiate form to represent the receiver"
-
- | maxExtent fb |
-
- maxExtent := 320 @ 240.
- fb := self fullBounds.
- ^ fb area <= (maxExtent x * maxExtent y)
- ifTrue: [self imageForm]
- ifFalse: [self imageFormForRectangle: (fb topLeft extent: maxExtent)]!
Item was removed:
- ----- Method: Morph>>toggleCornerRounding (in category 'rounding') -----
- toggleCornerRounding
- self cornerStyle == #rounded
- ifTrue: [self cornerStyle: #square]
- ifFalse: [self cornerStyle: #rounded].
- self changed!
Item was removed:
- ----- Method: Morph>>toggleDropShadow (in category 'drop shadows') -----
- toggleDropShadow
- self hasDropShadow
- ifTrue:[self removeDropShadow]
- ifFalse:[self addDropShadow].!
Item was removed:
- ----- Method: Morph>>toggleLocked (in category 'accessing') -----
- toggleLocked
-
- self lock: self isLocked not!
Item was removed:
- ----- Method: Morph>>toggleResistsRemoval (in category 'accessing') -----
- toggleResistsRemoval
- "Toggle the resistsRemoval property"
-
- self resistsRemoval
- ifTrue:
- [self removeProperty: #resistsRemoval]
- ifFalse:
- [self setProperty: #resistsRemoval toValue: true]!
Item was removed:
- ----- Method: Morph>>toggleStickiness (in category 'accessing') -----
- toggleStickiness
- "togle the receiver's Stickiness"
- extension ifNil: [^ self beSticky].
- extension sticky: extension sticky not!
Item was removed:
- ----- Method: Morph>>top (in category 'geometry') -----
- top
- " Return the y-coordinate of my top side "
-
- ^ bounds top!
Item was removed:
- ----- Method: Morph>>top: (in category 'geometry') -----
- top: aNumber
- " Move me so that my top is at the y-coordinate aNumber. My extent (width & height) are unchanged "
-
- self position: (bounds left @ aNumber)!
Item was removed:
- ----- Method: Morph>>topCenter (in category 'geometry') -----
- topCenter
-
- ^ bounds topCenter!
Item was removed:
- ----- Method: Morph>>topLeft (in category 'geometry') -----
- topLeft
-
- ^ bounds topLeft!
Item was removed:
- ----- Method: Morph>>topLeft: (in category 'geometry') -----
- topLeft: aPoint
- " Move me so that my top left corner is at aPoint. My extent (width & height) are unchanged "
-
- self position: aPoint
- !
Item was removed:
- ----- Method: Morph>>topPasteUp (in category 'structure') -----
- topPasteUp
- "If the receiver is in a world, return that; otherwise return the outermost pasteup morph"
- ^ self outermostMorphThat: [:m | m isKindOf: PasteUpMorph]!
Item was removed:
- ----- Method: Morph>>topRendererOrSelf (in category 'structure') -----
- topRendererOrSelf
- "Answer the topmost renderer for this morph, or this morph itself if it has no renderer. See the comment in Morph>isRenderer."
-
- | top topsOwner |
- owner ifNil: [^self].
- self isWorldMorph ifTrue: [^self]. "ignore scaling of this world"
- top := self.
- topsOwner := top owner.
- [topsOwner notNil and: [topsOwner isRenderer]] whileTrue:
- [top := topsOwner.
- topsOwner := top owner].
- ^top!
Item was removed:
- ----- Method: Morph>>topRight (in category 'geometry') -----
- topRight
-
- ^ bounds topRight!
Item was removed:
- ----- Method: Morph>>topRight: (in category 'geometry') -----
- topRight: aPoint
- " Move me so that my top right corner is at aPoint. My extent (width & height) are unchanged "
-
- self position: ((aPoint x - bounds width) @ (aPoint y))
- !
Item was removed:
- ----- Method: Morph>>transferHalo: (in category 'halos and balloon help') -----
- transferHalo: event
-
- ^ self transferHalo: event using: self defaultHaloDispatcher!
Item was removed:
- ----- Method: Morph>>transferHalo:using: (in category 'halos and balloon help') -----
- transferHalo: event using: dispatcher
-
- ^ dispatcher dispatchHalo: event with: self!
Item was removed:
- ----- Method: Morph>>transferStateToRenderer: (in category 'menus') -----
- transferStateToRenderer: aRenderer
- "Transfer knownName, actorState, visible, and player info over to aRenderer, which is being imposed above me as a transformation shell"
-
- | current |
- (current := self actorStateOrNil) ifNotNil:
- [aRenderer actorState: current.
- self actorState: nil].
-
- (current := self knownName) ifNotNil:
- [aRenderer setNameTo: current.
- self setNameTo: nil].
-
- (current := self player) ifNotNil:
- [aRenderer player: current.
- self player rawCostume: aRenderer.
- "NB player is redundantly pointed to in the extension of both the renderer and the rendee; this is regrettable but many years ago occasionally people tried to make that clean but always ran into problems iirc"
- "self player: nil"].
-
- aRenderer simplySetVisible: self visible
-
-
-
-
-
- !
Item was removed:
- ----- Method: Morph>>transformFrom: (in category 'event handling') -----
- transformFrom: uberMorph
- "Return a transform to be used to map coordinates in a morph above me into my childrens coordinates, or vice-versa. This is used to support scrolling, scaling, and/or rotation. This default implementation just returns my owner's transform or the identity transform if my owner is nil.
- Note: This method cannot be used to map into the receiver's coordinate system!!"
-
- (self == uberMorph or: [owner isNil]) ifTrue: [^IdentityTransform new].
- ^owner transformFrom: uberMorph!
Item was removed:
- ----- Method: Morph>>transformFromOutermostWorld (in category 'event handling') -----
- transformFromOutermostWorld
- "Return a transform to map world coordinates into my local coordinates"
-
- "self isWorldMorph ifTrue: [^ MorphicTransform identity]."
- ^ self transformFrom: self outermostWorldMorph!
Item was removed:
- ----- Method: Morph>>transformFromWorld (in category 'event handling') -----
- transformFromWorld
- "Return a transform to map world coordinates into my local coordinates"
-
- ^ self transformFrom: nil!
Item was removed:
- ----- Method: Morph>>transformedBy: (in category 'geometry - misc') -----
- transformedBy: aTransform
- aTransform isIdentity ifTrue:[^self].
- aTransform isPureTranslation ifTrue:[
- ^self position: (aTransform localPointToGlobal: self position).
- ].
- ^self addFlexShell transformedBy: aTransform!
Item was removed:
- ----- Method: Morph>>transformedFrom: (in category 'events-processing') -----
- transformedFrom: uberMorph
- "Return a transform to map coordinates of uberMorph, a morph above me in my owner chain, into the coordinates of MYSELF not any of my children."
- self flag: #arNote. "rename this method"
- owner ifNil:[^IdentityTransform new].
- ^ (owner transformFrom: uberMorph)!
Item was removed:
- ----- Method: Morph>>transportedMorph (in category 'dropping/grabbing') -----
- transportedMorph
- ^self!
Item was removed:
- ----- Method: Morph>>triggerActionFromPianoRoll (in category '*Morphic-Sound-piano rolls') -----
- triggerActionFromPianoRoll
-
- | evt |
- "a hack to allow for abitrary morphs to be dropped into piano roll"
- self world ifNil: [^self].
- evt := MouseEvent new setType: nil position: self center buttons: 0 hand: self world activeHand.
- self programmedMouseUp: evt for: self.
-
- !
Item was removed:
- ----- Method: Morph>>tryToRenameTo: (in category 'naming') -----
- tryToRenameTo: aName
- "A new name has been submited; make sure it's appropriate, and react accordingly. This circumlocution provides the hook by which the simple renaming of a field can result in a change to variable names in a stack, etc. There are some problems to worry about here."
-
- self renameTo: aName.!
Item was removed:
- ----- Method: Morph>>unHighlight (in category 'accessing') -----
- unHighlight
- self color: self regularColor!
Item was removed:
- ----- Method: Morph>>uncollapseSketch (in category 'menus') -----
- uncollapseSketch
-
- | uncollapsedVersion w whomToDelete |
-
- (w := self world) ifNil: [^self].
- uncollapsedVersion := self valueOfProperty: #uncollapsedMorph.
- uncollapsedVersion ifNil: [^self].
- whomToDelete := self valueOfProperty: #collapsedMorphCarrier.
- uncollapsedVersion setProperty: #collapsedPosition toValue: whomToDelete position.
-
- whomToDelete delete.
- w addMorphFront: uncollapsedVersion.
-
- !
Item was removed:
- ----- Method: Morph>>undoGrabCommand (in category 'dropping/grabbing') -----
- undoGrabCommand
- "Return an undo command for grabbing the receiver"
-
- | cmd |
- owner ifNil:
- [^ nil]. "no owner - no undo"
- ^ (cmd := Command new)
- cmdWording: 'move ' translated, self nameForUndoWording;
- undoTarget: self
- selector: #undoMove:redo:owner:bounds:predecessor:
- arguments: {cmd. false. owner. self bounds. (owner morphPreceding: self)};
- yourself!
Item was removed:
- ----- Method: Morph>>undoMove:redo:owner:bounds:predecessor: (in category 'undo') -----
- undoMove: cmd redo: redo owner: formerOwner bounds: formerBounds predecessor: formerPredecessor
- "Handle undo and redo of move commands in morphic"
-
- self owner ifNil: [^Beeper beep].
- redo
- ifFalse:
- ["undo sets up the redo state first"
-
- cmd
- redoTarget: self
- selector: #undoMove:redo:owner:bounds:predecessor:
- arguments: {
- cmd.
- true.
- owner.
- bounds.
- owner morphPreceding: self}].
- formerOwner ifNotNil:
- [formerPredecessor ifNil: [formerOwner addMorphFront: self]
- ifNotNil: [formerOwner addMorph: self after: formerPredecessor]].
- self bounds: formerBounds.
- (self isSystemWindow) ifTrue: [self beKeyWindow]!
Item was removed:
- ----- Method: Morph>>unlock (in category 'accessing') -----
- unlock
- self lock: false!
Item was removed:
- ----- Method: Morph>>unlockContents (in category 'accessing') -----
- unlockContents
- self submorphsDo:
- [:m | m unlock]!
Item was removed:
- ----- Method: Morph>>unlockOneSubpart (in category 'e-toy support') -----
- unlockOneSubpart
- | unlockables reply |
- unlockables := self submorphs select:
- [:m | m isLocked].
- unlockables size <= 1 ifTrue: [^ self unlockContents].
- reply := UIManager default
- chooseFrom: (unlockables collect: [:m | m externalName])
- values: unlockables
- title: 'Who should be be unlocked?' translated.
- reply isNil ifTrue: [^ self].
- reply unlock!
Item was removed:
- ----- Method: Morph>>updateAllFromResources (in category 'fileIn/out') -----
- updateAllFromResources
-
- self allMorphsDo: [:m | m updateFromResource]!
Item was removed:
- ----- Method: Morph>>updateAllScriptingElements (in category 'naming') -----
- updateAllScriptingElements
- "A sledge-hammer sweep from the world down to make sure that all live scripting elements are up to date. Presently in eclipse, not sent at the moment."
-
- | aPasteUp |
- (aPasteUp := self topPasteUp) ifNotNil:
- [aPasteUp allTileScriptingElements do: [:m | m bringUpToDate]]!
Item was removed:
- ----- Method: Morph>>updateCachedThumbnail (in category 'e-toy support') -----
- updateCachedThumbnail
- "If I have a cached thumbnail, then update it. Copied up from Dan's original version in PasteUpMorph so it can be used by all morphs."
- | cachedThumbnail |
-
- (cachedThumbnail := self valueOfProperty: #cachedThumbnail) ifNotNil:
- [(cachedThumbnail respondsTo: #computeThumbnail)
- ifTrue: [cachedThumbnail computeThumbnail]
- ifFalse: [self removeProperty: #computeThumbnail]].
- "Test and removal are because the thumbnail is being replaced by another Morph. We don't know why. Need to fix that at the source."!
Item was removed:
- ----- Method: Morph>>updateDropShadowCache (in category 'drawing') -----
- updateDropShadowCache
- "Draws the receiver's drop shadow into a separate form (or cache) to be used repeatedly in #drawDropShadowOn:, which is itself guarded via #hasDropShadow (see #fullDrawOn:).
-
- Note that this cache is not so much about performance as it is about visual aesthetics. While the shadow itself is just one or more repeated calls to fill/frame a (rounded rectangle), we finally cut out (or mask or erase) the inner portion so that translucent receiver's wont look awkward. This is not possible with direct drawing calls to BitBlt onto Display.
-
- Also note that with the advent of the Spur object memory (http://www.mirandabanda.org/cogblog/category/spur/) in the OpenSmalltalk VM, we got a different garbage collector (GC) that does not yet have the most efficient incremental collection strategies. As an effect, repeated invalidation of the drop-shadow cache now entails frequent full-GC pauses and thus noticeable lags (or stuttering) in the environment. This has been the case since the release of Squeak 5.0, where we started to use the Spur object memory and hence the new GC.
-
- To make the full-GC pauses less noticeable, we started to temporarily disable the drop shadow in situations where responsiveness is importent. For example, we do this for frequently used morphs such as all system windows when being resized using their corner (or edge) grips. You can get an overview of thus points by browsing senders of #targetHadDropShadow and #hasDropShadow: (or actually the code 'hasDropShadow: false', which typically starts the temporary disabling of the shadow).
-
- February 2022: We are currently working on improving the incremental compaction in the OpenSmalltalk VM. Once that issue has been solved, we can remove that source code that disables the drop shadow temporarily."
-
- | shadowOffset shadowBounds offset form canvas drawBlock localBounds mask maskCanvas |
- self flag: #hasDropShadow. "Marker for senders browsing."
- self flag: #targetHadDropShadow. "Marker for senders browsing."
-
- (shadowOffset := self shadowOffset) isRectangle
- ifTrue: [
- shadowBounds := 0 at 0 corner: (self bounds outsetBy: shadowOffset) extent.
- offset := 0 at 0.
- localBounds := shadowOffset topLeft extent: self extent ]
- ifFalse: [
- | extent |
- extent := self extent.
- shadowBounds := 0 at 0 corner: extent + shadowOffset abs.
- offset := shadowOffset max: 0 at 0.
- localBounds := (shadowOffset negated max: 0 at 0) extent: extent ].
-
- form := Form extent: shadowBounds extent depth: Display depth.
- canvas := form getCanvas.
-
- drawBlock := self useSoftDropShadow
- ifFalse: [
- [:c | self wantsRoundedCorners
- ifTrue: [c fillRoundRect: localBounds radius: self cornerRadius fillStyle: self shadowColor]
- ifFalse: [c fillRectangle: localBounds fillStyle: self shadowColor]]]
- ifTrue: [
- [:c | self wantsRoundedCorners
- ifTrue: [0 to: 9 do: [:i |
- c
- fillRoundRect: (shadowBounds insetBy: i)
- radius: (self cornerRadius max: 20) -i
- fillStyle: (self shadowColor alpha: self shadowColor alpha * (i+1))]]
- ifFalse: [0 to: 9 do: [:i |
- c
- fillRoundRect: (shadowBounds insetBy: i) radius: 20-i
- fillStyle: (self shadowColor alpha: self shadowColor alpha * (i+1))]]]].
-
- canvas
- translateBy: offset
- during: [ :shadowCanvas | drawBlock value: shadowCanvas].
-
- "Support transparent morph colors without having the shadow to shine through.."
- mask := Form extent: shadowBounds extent depth: Display depth.
- maskCanvas := mask getCanvas.
- self wantsRoundedCorners
- ifTrue: [maskCanvas fillRoundRect: (localBounds insetBy: self borderWidth) radius: self cornerRadius fillStyle: Color black]
- ifFalse: [maskCanvas fillRectangle: (localBounds insetBy: self borderWidth) fillStyle: Color black].
- mask
- displayOn: form
- at: 0 at 0
- rule: Form erase.
-
- self setProperty: #dropShadow toValue: form.!
Item was removed:
- ----- Method: Morph>>updateFromResource (in category 'fileIn/out') -----
- updateFromResource
- | pathName newMorph f |
- (pathName := self valueOfProperty: #resourceFilePath) ifNil: [^self].
- (pathName asLowercase endsWith: '.morph')
- ifTrue:
- [newMorph := (FileStream readOnlyFileNamed: pathName) fileInObjectAndCode.
- (newMorph isMorph)
- ifFalse: [^self error: 'Resource not a single morph']]
- ifFalse:
- [f := Form fromFileNamed: pathName.
- f ifNil: [^self error: 'unrecognized image file format'].
- newMorph := self world drawingClass withForm: f].
- newMorph setProperty: #resourceFilePath toValue: pathName.
- self owner replaceSubmorph: self by: newMorph!
Item was removed:
- ----- Method: Morph>>updateReferencesUsing: (in category 'copying') -----
- updateReferencesUsing: aDictionary
- "Update intra-morph references within a composite morph that
- has been copied. For example, if a button refers to morph X in
- the orginal
- composite then the copy of that button in the new composite
- should refer to
- the copy of X in new composite, not the original X. This default
- implementation updates the contents of any morph-bearing slot.
- It may be
- overridden to avoid this behavior if so desired."
- | old |
- Morph instSize + 1
- to: self class instSize
- do: [:i |
- old := self instVarAt: i.
- old isMorph
- ifTrue: [self
- instVarAt: i
- put: (aDictionary
- at: old
- ifAbsent: [old])]].
- extension ifNotNil: [extension updateReferencesUsing: aDictionary]!
Item was removed:
- ----- Method: Morph>>updateThumbnailUrl (in category 'thumbnail') -----
- updateThumbnailUrl
- "If I have a cached thumbnail, then update it's urls."
- | cachedThumbnail |
-
- (cachedThumbnail := self valueOfProperty: #cachedThumbnail) ifNotNil:
- [(cachedThumbnail respondsTo: #computeThumbnail)
- ifTrue: [cachedThumbnail pageMorph: self url inBook: owner url]
- ifFalse: [self removeProperty: #computeThumbnail]].
- "Test and removal are because the thumbnail is being replaced
- by another Morph. We don't know why. Need to fix that at
- the source."!
Item was removed:
- ----- Method: Morph>>updateThumbnailUrlInBook: (in category 'thumbnail') -----
- updateThumbnailUrlInBook: bookUrl
- "If I have a cached thumbnail, then update it's urls."
- | cachedThumbnail |
-
- (cachedThumbnail := self valueOfProperty: #cachedThumbnail) ifNotNil:
- [(cachedThumbnail respondsTo: #computeThumbnail)
- ifTrue: [cachedThumbnail pageMorph: self url inBook: bookUrl]
- ifFalse: [self removeProperty: #computeThumbnail]].
- "Test and removal are because the thumbnail is being replaced
- by another Morph. We don't know why. Need to fix that at
- the source."!
Item was removed:
- ----- Method: Morph>>updateableActionMap (in category 'events-accessing') -----
- updateableActionMap
- "Answer an updateable action map, saving it in my #actionMap property"
-
- | actionMap |
- actionMap := self valueOfProperty: #actionMap.
- actionMap ifNil:
- [actionMap := self createActionMap.
- self setProperty: #actionMap toValue: actionMap].
- ^ actionMap!
Item was removed:
- ----- Method: Morph>>url (in category 'accessing') -----
- url
- "If I have been assigned a url, return it. For PasteUpMorphs mostly."
- | sq |
- (sq := self sqkPage) ifNotNil: [^ sq url].
- ^ self valueOfProperty: #url
- !
Item was removed:
- ----- Method: Morph>>usableSiblingInstance (in category 'copying') -----
- usableSiblingInstance
- "Return another similar morph whose Player is of the same class as mine.
- Do not open it in the world."
-
- | aName newPlayer newMorph topRenderer counter world |
- (topRenderer := self topRendererOrSelf) == self
- ifFalse: [^topRenderer usableSiblingInstance].
- self assuredPlayer assureUniClass.
- newMorph := self veryDeepCopySibling.
- newPlayer := newMorph player.
- newPlayer resetCostumeList.
- (aName := self knownName) isNil
- ifTrue: [self player notNil ifTrue: [aName := newMorph innocuousName]].
- "Force a difference here"
-
- aName := aName stemAndNumericSuffix at: 1.
-
- world := self world ifNil: [Project current world].
- (world hasProperty: #nameCounter) ifFalse: [
- (world setProperty: #nameCounter toValue: Dictionary new)
- ].
-
- counter := (world valueOfProperty: #nameCounter) at: aName ifAbsent: [1].
- newMorph setNameTo: aName, counter.
- (world valueOfProperty: #nameCounter) at: aName put: counter + 1.
-
- newMorph privateOwner: nil.
- newPlayer assureEventHandlerRepresentsStatus.
- self presenter flushPlayerListCache.
- ^newMorph!
Item was removed:
- ----- Method: Morph>>useBitmapFill (in category 'visual properties') -----
- useBitmapFill
- "Make receiver use a solid fill style (e.g., a simple color)"
- | fill |
- self fillStyle isBitmapFill ifTrue:[^self]. "Already done"
- fill := BitmapFillStyle fromForm: self defaultBitmapFillForm.
- "Note: Must fix the origin due to global coordinates"
- fill origin: self bounds origin.
- self fillStyle: fill.!
Item was removed:
- ----- Method: Morph>>useDefaultFill (in category 'visual properties') -----
- useDefaultFill
- "Make receiver use a solid fill style (e.g., a simple color)"
- self fillStyle: self defaultColor.!
Item was removed:
- ----- Method: Morph>>useGradientFill (in category 'visual properties') -----
- useGradientFill
- "Make receiver use a solid fill style (e.g., a simple color)"
- | fill color1 color2 |
- self fillStyle isGradientFill ifTrue:[^self]. "Already done"
- color1 := self color asColor.
- color2 := color1 negated.
- fill := GradientFillStyle ramp: {0.0 -> color1. 1.0 -> color2}.
- fill origin: self topLeft.
- fill direction: 0 @ self bounds extent y.
- fill normal: self bounds extent x @ 0.
- fill radial: false.
- self fillStyle: fill!
Item was removed:
- ----- Method: Morph>>useSoftDropShadow (in category 'drop shadows') -----
- useSoftDropShadow
-
- ^ self
- valueOfProperty: #useSoftDropShadow
- ifAbsent: [self class useSoftDropShadow]!
Item was removed:
- ----- Method: Morph>>useSoftDropShadow: (in category 'drop shadows') -----
- useSoftDropShadow: aBooleanOrNil
-
- aBooleanOrNil
- ifNil: [self removeProperty: #useSoftDropShadow]
- ifNotNil: [self setProperty: #useSoftDropShadow toValue: aBooleanOrNil].!
Item was removed:
- ----- Method: Morph>>useSolidFill (in category 'visual properties') -----
- useSolidFill
- "Make receiver use a solid fill style (e.g., a simple color)"
- self fillStyle isSolidFill ifTrue:[^self]. "Already done"
- self fillStyle: self fillStyle asColor. "Try minimizing changes"!
Item was removed:
- ----- Method: Morph>>userSelectedColor: (in category 'change reporting') -----
- userSelectedColor: aColor
- "The user, via the UI, chose aColor to be the color for the receiver; set it, and tell my owner in case he wishes to react"
- self color: aColor.
- self world ifNotNil: [owner colorChangedForSubmorph: self]!
Item was removed:
- ----- Method: Morph>>userString (in category 'accessing') -----
- userString
- "Do I have a text string to be searched on?"
-
- ^ nil!
Item was removed:
- ----- Method: Morph>>vResizeToFit: (in category 'layout properties') -----
- vResizeToFit: aBoolean
- aBoolean ifTrue:[
- self vResizing: #shrinkWrap.
- ] ifFalse:[
- self vResizing: #rigid.
- ].!
Item was removed:
- ----- Method: Morph>>vResizing (in category 'layout properties') -----
- vResizing
- "Layout specific. This property describes how the receiver should be resized with respect to its owner and its children. Possible values are:
- #rigid - do not resize the receiver
- #spaceFill - resize to fill owner's available space
- #shrinkWrap - resize to fit children
- "
- | props |
- props := self layoutProperties.
- ^props ifNil:[#rigid] ifNotNil:[props vResizing].!
Item was removed:
- ----- Method: Morph>>vResizing: (in category 'layout properties') -----
- vResizing: aSymbol
- "Layout specific. This property describes how the receiver should be resized with respect to its owner and its children. Possible values are:
- #rigid - do not resize the receiver
- #spaceFill - resize to fill owner's available space
- #shrinkWrap - resize to fit children
- "
- self checkResizingProperty: aSymbol.
- self assureLayoutProperties vResizing: aSymbol.
- self layoutChanged.
- !
Item was removed:
- ----- Method: Morph>>vResizingString: (in category 'layout-menu') -----
- vResizingString: aSymbol
- ^self layoutMenuPropertyString: aSymbol from: self vResizing!
Item was removed:
- ----- Method: Morph>>valueOfProperty: (in category 'accessing - properties') -----
- valueOfProperty: aSymbol
- "answer the value of the receiver's property named aSymbol"
- ^ extension ifNotNil: [extension valueOfProperty: aSymbol]!
Item was removed:
- ----- Method: Morph>>valueOfProperty:ifAbsent: (in category 'accessing - properties') -----
- valueOfProperty: aSymbol ifAbsent: aBlock
- "if the receiver possesses a property of the given name, answer
- its value. If not then evaluate aBlock and answer the result of
- this block evaluation"
-
- extension ifNil: [ ^aBlock value ].
- ^extension valueOfProperty: aSymbol ifAbsent: aBlock!
Item was removed:
- ----- Method: Morph>>valueOfProperty:ifAbsentPut: (in category 'accessing - properties') -----
- valueOfProperty: aSymbol ifAbsentPut: aBlock
- "If the receiver possesses a property of the given name, answer
- its value. If not, then create a property of the given name, give
- it the value obtained by evaluating aBlock, then answer that
- value"
- ^ self assureExtension valueOfProperty: aSymbol ifAbsentPut: aBlock!
Item was removed:
- ----- Method: Morph>>valueOfProperty:ifPresentDo: (in category 'accessing - properties') -----
- valueOfProperty: aSymbol ifPresentDo: aBlock
- "If the receiver has a property of the given name, evaluate
- aBlock on behalf of the value of that property"
- extension ifNil: [^ self].
- ^ aBlock value: (extension valueOfProperty: aSymbol ifAbsent: [^ self])!
Item was removed:
- ----- Method: Morph>>vanishAfterSlidingTo:event: (in category 'dropping/grabbing') -----
- vanishAfterSlidingTo: aPosition event: evt
-
- | aForm aWorld startPoint endPoint |
- aForm := self imageForm offset: 0 at 0.
- aWorld := self world.
- startPoint := evt hand fullBounds origin.
- self delete.
- aWorld displayWorld.
- endPoint := aPosition.
- aForm slideFrom: startPoint to: endPoint nSteps: 12 delay: 15.
- SoundService soundEnabled ifTrue: [TrashCanMorph playDeleteSound].
- !
Item was removed:
- ----- Method: Morph>>veryDeepCopyWith: (in category 'copying') -----
- veryDeepCopyWith: deepCopier
- "Copy me and the entire tree of objects I point to. An object in the tree twice is copied once, and both references point to him. deepCopier holds a dictionary of objects we have seen. See veryDeepInner:, veryDeepFixupWith:"
-
- self prepareToBeSaved.
- ^ super veryDeepCopyWith: deepCopier!
Item was removed:
- ----- Method: Morph>>veryDeepFixupWith: (in category 'copying') -----
- veryDeepFixupWith: deepCopier
- "If some fields were weakly copied, fix new copy here."
-
- "super veryDeepFixupWith: deepCopier. Object has no fixups, so don't call it"
-
- "If my owner is being duplicated too, then store his duplicate.
- If I am owned outside the duplicated tree, then I am no longer owned!!"
- owner := deepCopier references at: owner ifAbsent: [nil].
-
- !
Item was removed:
- ----- Method: Morph>>veryDeepInner: (in category 'copying') -----
- veryDeepInner: deepCopier
- "The inner loop, so it can be overridden when a field should not
- be traced."
- "super veryDeepInner: deepCopier. know Object has no inst vars"
- bounds := bounds shallowCopy.
- "Points are shared with original"
- "owner := owner. special, see veryDeepFixupWith:"
- submorphs := submorphs veryDeepCopyWith: deepCopier.
- "each submorph's fixup will install me as the owner"
- "fullBounds := fullBounds. fullBounds is shared with original!!"
- color := color veryDeepCopyWith: deepCopier.
- "color, if simple, will return self. may be complex"
- extension := (extension veryDeepCopyWith: deepCopier)!
Item was removed:
- ----- Method: Morph>>viewBox (in category 'accessing') -----
- viewBox
- ^ self pasteUpMorph viewBox!
Item was removed:
- ----- Method: Morph>>viewMorphDirectly (in category 'debug and other') -----
- viewMorphDirectly
- "Open a Viewer directly on the Receiver, i.e. no Player involved"
-
- self presenter viewObjectDirectly: self renderedMorph
-
- !
Item was removed:
- ----- Method: Morph>>visible (in category 'drawing') -----
- visible
- "answer whether the receiver is visible"
- extension ifNil: [^ true].
- ^ extension visible!
Item was removed:
- ----- Method: Morph>>visible: (in category 'drawing') -----
- visible: aBoolean
- "set the 'visible' attribute of the receiver to aBoolean"
- (extension isNil and:[aBoolean]) ifTrue: [^ self].
- self visible == aBoolean ifTrue: [^ self].
-
- self changed.
- self assureExtension visible: aBoolean.
- self changed!
Item was removed:
- ----- Method: Morph>>visibleClearArea (in category 'accessing') -----
- visibleClearArea
- "Answer the receiver visible clear area. The intersection
- between the clear area and the viewbox."
- ^ self viewBox intersect: self clearArea!
Item was removed:
- ----- Method: Morph>>wantsBalloon (in category 'halos and balloon help') -----
- wantsBalloon
- "Answer true if receiver wants to show a balloon help text is a few moments."
-
- ^ (self balloonText notNil) and: [Preferences balloonHelpEnabled]!
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>>wantsDirectionHandles (in category 'halos and balloon help') -----
- wantsDirectionHandles
- ^self valueOfProperty: #wantsDirectionHandles ifAbsent:[Preferences showDirectionHandles]!
Item was removed:
- ----- Method: Morph>>wantsDirectionHandles: (in category 'halos and balloon help') -----
- wantsDirectionHandles: aBool
- aBool == Preferences showDirectionHandles
- ifTrue:[self removeProperty: #wantsDirectionHandles]
- ifFalse:[self setProperty: #wantsDirectionHandles toValue: aBool].
- !
Item was removed:
- ----- Method: Morph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
- wantsDroppedMorph: aMorph event: evt
- "Return true if the receiver wishes to accept the given morph, which is being dropped by a hand in response to the given event. Note that for a successful drop operation both parties need to agree. The symmetric check is done automatically via aMorph wantsToBeDroppedInto: self."
-
- ^self dropEnabled!
Item was removed:
- ----- Method: Morph>>wantsEveryMouseMove (in category 'event handling') -----
- wantsEveryMouseMove
- "Unless overridden, this method allows processing to skip mouse move events
- when processing is lagging. No 'significant' event (down/up, etc) will be skipped."
-
- ^ false!
Item was removed:
- ----- Method: Morph>>wantsHalo (in category 'halos and balloon help') -----
- wantsHalo
- | topOwner |
- ^(topOwner := self topRendererOrSelf owner) notNil
- and: [topOwner wantsHaloFor: self]!
Item was removed:
- ----- Method: Morph>>wantsHaloFor: (in category 'halos and balloon help') -----
- wantsHaloFor: aSubMorph
- ^ false!
Item was removed:
- ----- Method: Morph>>wantsHaloFromClick (in category 'halos and balloon help') -----
- wantsHaloFromClick
-
- ^ self valueOfProperty: #wantsHaloFromClick ifAbsent: [^true].!
Item was removed:
- ----- Method: Morph>>wantsHaloFromClick: (in category 'halos and balloon help') -----
- wantsHaloFromClick: aBoolean
-
- self
- setProperty: #wantsHaloFromClick
- toValue: aBoolean.!
Item was removed:
- ----- Method: Morph>>wantsHaloHandleWithSelector:inHalo: (in category 'halos and balloon help') -----
- wantsHaloHandleWithSelector: aSelector inHalo: aHaloMorph
- "Answer whether the receiver would like to offer the halo handle with the given selector (e.g. #addCollapseHandle:)"
-
- (#(addDismissHandle:) includes: aSelector) ifTrue:
- [^ self resistsRemoval not].
-
- (#( addDragHandle: ) includes: aSelector) ifTrue:
- [^ self okayToBrownDragEasily].
-
- (#(addGrowHandle: addScaleHandle:) includes: aSelector) ifTrue:
- [^ self okayToResizeEasily].
-
- (#( addRotateHandle: ) includes: aSelector) ifTrue:
- [^ self okayToRotateEasily].
-
- (#(addRecolorHandle:) includes: aSelector) ifTrue:
- [^ self renderedMorph wantsRecolorHandle].
-
- true ifTrue: [^ true]
- !
Item was removed:
- ----- Method: Morph>>wantsKeyboardFocus (in category 'event handling') -----
- wantsKeyboardFocus
- "Whether this morph should get the current keyboard focus when handling a keyboard event to speed up further event processing."
-
- ^ false!
Item was removed:
- ----- Method: Morph>>wantsKeyboardFocusFor: (in category 'event handling') -----
- wantsKeyboardFocusFor: aSubmorph
- "Answer whether a plain mouse click on aSubmorph, a text-edit-capable thing, should result in a text selection there"
- ^ false!
Item was removed:
- ----- Method: Morph>>wantsMetaMenu (in category 'menu') -----
- wantsMetaMenu
-
- ^ self valueOfProperty: #wantsMetaMenu ifAbsent: [true]!
Item was removed:
- ----- Method: Morph>>wantsMetaMenu: (in category 'menu') -----
- wantsMetaMenu: aBoolean
-
- self
- setProperty: #wantsMetaMenu
- toValue: aBoolean.!
Item was removed:
- ----- Method: Morph>>wantsRecolorHandle (in category 'e-toy support') -----
- wantsRecolorHandle
- "Answer whether the receiver would like a recoloring halo handle to be put up. Since this handle also presently affords access to the property-sheet, it is presently always allowed, even though SketchMorphs don't like regular recoloring"
-
- ^ true
-
- !
Item was removed:
- ----- Method: Morph>>wantsRoundedCorners (in category 'rounding') -----
- wantsRoundedCorners
- "Return true if the receiver wants its corners rounded"
- ^ self cornerStyle == #rounded!
Item was removed:
- ----- Method: Morph>>wantsScriptorHaloHandle (in category 'halos and balloon help') -----
- wantsScriptorHaloHandle
- "Answer whether the receiver would like to have a Scriptor halo handle put up on its behalf. Initially, only the ScriptableButton says yes"
-
- ^ false!
Item was removed:
- ----- Method: Morph>>wantsSimpleSketchMorphHandles (in category 'halos and balloon help') -----
- wantsSimpleSketchMorphHandles
- "Answer true if my halo's simple handles should include the simple sketch morph handles."
- ^false!
Item was removed:
- ----- Method: Morph>>wantsSteps (in category 'stepping and presenter') -----
- wantsSteps
- "Return true if the receiver overrides the default Morph step method."
- "Details: Find first class in superclass chain that implements #step and return true if it isn't class Morph."
-
- | c |
- self isPartsDonor ifTrue: [^ false].
- (self == self topRendererOrSelf) ifTrue: [self player wantsSteps ifTrue: [^ true]].
- c := self class.
- [c includesSelector: #step] whileFalse: [c := c superclass].
- ^ c ~= Morph!
Item was removed:
- ----- Method: Morph>>wantsToBeCachedByHand (in category 'accessing') -----
- wantsToBeCachedByHand
- "Return true if the receiver wants to be cached by the hand when it is dragged around.
- Note: The default implementation queries all submorphs since subclasses may have shapes that do not fill the receiver's bounds completely."
- self hasTranslucentColor ifTrue:[^false].
- self submorphsDo:[:m|
- m wantsToBeCachedByHand ifFalse:[^false].
- ].
- ^true!
Item was removed:
- ----- Method: Morph>>wantsToBeDroppedInto: (in category 'dropping/grabbing') -----
- wantsToBeDroppedInto: aMorph
- "Return true if it's okay to drop the receiver into aMorph. This check is symmetric to #wantsDroppedMorph:event: to give both parties a chance of figuring out whether they like each other."
- ^true!
Item was removed:
- ----- Method: Morph>>wantsToBeOpenedInWorld (in category 'dropping/grabbing') -----
- wantsToBeOpenedInWorld
- "Return true if the receiver wants to be put into the World directly,
- rather than allowing the user to place it (e.g., prevent attaching me
- to the hand after choosing 'new morph' in the world menu)"
- ^false!
Item was removed:
- ----- Method: Morph>>wantsToBeTopmost (in category 'e-toy support') -----
- wantsToBeTopmost
- "Answer if the receiver want to be one of the topmost objects in its owner"
- ^ self isFlapOrTab!
Item was removed:
- ----- Method: Morph>>wantsWindowEvents: (in category 'event handling') -----
- wantsWindowEvents: anEvent
- "Return true if the receiver wants to process host window events. These are only dispatched to the World anyway, but one could have an eventListener in the Hand or a windowEventHandler in the World"
- ^false!
Item was removed:
- ----- Method: Morph>>wantsYellowButtonMenu (in category 'menu') -----
- wantsYellowButtonMenu
- "Answer true if the receiver wants a yellow button menu"
- self
- valueOfProperty: #wantsYellowButtonMenu
- ifPresentDo: [:value | ^ value].
- ""
- self isInSystemWindow
- ifTrue: [^ false].""
- (Preferences noviceMode
- and: [self isInDockingBar])
- ifTrue: [^ false].""
- ^ Preferences generalizedYellowButtonMenu!
Item was removed:
- ----- Method: Morph>>wantsYellowButtonMenu: (in category 'menu') -----
- wantsYellowButtonMenu: aBoolean
- "Change the receiver to wants or not a yellow button menu"
- self setProperty: #wantsYellowButtonMenu toValue: aBoolean!
Item was removed:
- ----- Method: Morph>>width (in category 'geometry') -----
- width
-
- ^ bounds width!
Item was removed:
- ----- Method: Morph>>width: (in category 'geometry') -----
- width: aNumber
- " Set my width; my position (top-left corner) and height will remain the same "
-
- self extent: aNumber asInteger at self height.
- !
Item was removed:
- ----- Method: Morph>>willingToBeDiscarded (in category 'dropping/grabbing') -----
- willingToBeDiscarded
- ^ true!
Item was removed:
- ----- Method: Morph>>windowEvent: (in category 'event handling') -----
- windowEvent: anEvent
- "Host window event"!
Item was removed:
- ----- Method: Morph>>withAllOwners (in category 'structure') -----
- withAllOwners
- "Return the receiver and all its owners"
-
- ^ Array streamContents: [:strm | self withAllOwnersDo: [:m | strm nextPut: m]]!
Item was removed:
- ----- Method: Morph>>withAllOwnersDo: (in category 'structure') -----
- withAllOwnersDo: aBlock
- "Evaluate aBlock with the receiver and all of its owners"
- aBlock value: self.
- owner ifNotNil:[^owner withAllOwnersDo: aBlock].!
Item was removed:
- ----- Method: Morph>>world (in category 'structure') -----
- world
- ^owner isNil ifTrue: [nil] ifFalse: [owner world]!
Item was removed:
- ----- Method: Morph>>worldBounds (in category 'geometry - misc') -----
- worldBounds
- ^ self world bounds!
Item was removed:
- ----- Method: Morph>>worldBoundsForHalo (in category 'geometry - misc') -----
- worldBoundsForHalo
- "Answer the rectangle to be used as the inner dimension of my halos.
- Allow for showing either bounds or fullBounds, and compensate for the optional bounds rectangle."
-
- | r |
- self deprecated: 'ct: Use SimpleHaloMorph >> #haloBoundsFor:'.
- r := (Preferences haloEnclosesFullBounds)
- ifFalse: [ self boundsIn: nil ]
- ifTrue: [ self fullBoundsInWorld ].
- Preferences showBoundsInHalo ifTrue: [ ^r outsetBy: 2 ].
- ^r!
Item was removed:
- ----- Method: Morph>>wouldAcceptKeyboardFocus (in category 'event handling') -----
- wouldAcceptKeyboardFocus
- "Answer whether a plain mouse click on the receiver should result in a text selection there"
- ^ false!
Item was removed:
- ----- Method: Morph>>wouldAcceptKeyboardFocusUponTab (in category 'event handling') -----
- wouldAcceptKeyboardFocusUponTab
- "Answer whether the receiver is in the running as the new keyboard focus if the tab key were hit at a meta level. This provides the leverage for tabbing among fields of a card, for example."
-
- ^ false!
Item was removed:
- ----- Method: Morph>>wrapCentering (in category 'layout properties - table') -----
- wrapCentering
- "Layout specific. This property describes how the rows/columns in a list-like layout should be centered.
- #topLeft - center at start of secondary direction
- #bottomRight - center at end of secondary direction
- #center - center in the middle of secondary direction
- #justified - insert extra space inbetween rows/columns
- "
- | props |
- props := self layoutProperties.
- ^props ifNil:[#topLeft] ifNotNil:[props wrapCentering].!
Item was removed:
- ----- Method: Morph>>wrapCentering: (in category 'layout properties - table') -----
- wrapCentering: aSymbol
- "Layout specific. This property describes how the rows/columns in a list-like layout should be centered.
- #topLeft - center at start of secondary direction
- #bottomRight - center at end of secondary direction
- #center - center in the middle of secondary direction
- #justified - insert extra space inbetween rows/columns
- "
- self assureTableLayoutProperties wrapCentering: aSymbol.
- self layoutChanged.!
Item was removed:
- ----- Method: Morph>>wrapCenteringString: (in category 'layout-menu') -----
- wrapCenteringString: aSymbol
- ^self layoutMenuPropertyString: aSymbol from: self wrapCentering!
Item was removed:
- ----- Method: Morph>>wrapDirection (in category 'layout properties - table') -----
- wrapDirection
- "Layout specific. This property describes the direction along which a list-like layout should be wrapped. Possible values are:
- #leftToRight
- #rightToLeft
- #topToBottom
- #bottomToTop
- #none
- indicating in which direction wrapping should occur. This direction must be orthogonal to the list direction, that is if listDirection is #leftToRight or #rightToLeft then wrapDirection must be #topToBottom or #bottomToTop and vice versa."
- | props |
- props := self layoutProperties.
- ^props ifNil:[#none] ifNotNil:[props wrapDirection].!
Item was removed:
- ----- Method: Morph>>wrapDirection: (in category 'layout properties - table') -----
- wrapDirection: aSymbol
- "Layout specific. This property describes the direction along which a list-like layout should be wrapped. Possible values are:
- #leftToRight
- #rightToLeft
- #topToBottom
- #bottomToTop
- #none
- indicating in which direction wrapping should occur. This direction must be orthogonal to the list direction, that is if listDirection is #leftToRight or #rightToLeft then wrapDirection must be #topToBottom or #bottomToTop and vice versa."
- self assureTableLayoutProperties wrapDirection: aSymbol.
- self layoutChanged.
- !
Item was removed:
- ----- Method: Morph>>wrapDirectionString: (in category 'layout-menu') -----
- wrapDirectionString: aSymbol
- ^self layoutMenuPropertyString: aSymbol from: self wrapDirection !
Item was removed:
- ----- Method: Morph>>wrappedInWindow: (in category 'e-toy support') -----
- wrappedInWindow: aSystemWindow
- | aWindow |
- aWindow := aSystemWindow model: Model new.
- aWindow addMorph: self frame: (0 at 0 extent: 1 at 1).
- aWindow extent: self extent.
- ^ aWindow!
Item was removed:
- ----- Method: Morph>>wrappedInWindowWithTitle: (in category 'e-toy support') -----
- wrappedInWindowWithTitle: aTitle
- | aWindow w2 |
- aWindow := (SystemWindow labelled: aTitle) model: Model new.
- aWindow addMorph: self frame: (0 at 0 extent: 1 at 1).
- w2 := aWindow borderWidth * 2.
- w2 := 3. "oh, well"
- aWindow extent: self fullBounds extent + (0 @ aWindow labelHeight) + (w2 @ w2).
- ^ aWindow!
Item was removed:
- ----- Method: Morph>>yellowButtonActivity: (in category 'event handling') -----
- yellowButtonActivity: shiftState
- "Find me or my outermost owner that has items to add to a
- yellow button menu.
- shiftState is true if the shift was pressed.
- Otherwise, build a menu that contains the contributions from
- myself and my interested submorphs,
- and present it to the user."
- | menu |
- self isWorldMorph
- ifFalse: [| outerOwner |
- outerOwner := self outermostOwnerWithYellowButtonMenu.
- outerOwner
- ifNil: [^ self].
- outerOwner == self
- ifFalse: [^ outerOwner yellowButtonActivity: shiftState]].
- menu := self buildYellowButtonMenu: self currentHand.
- menu
- addTitle: self externalName
- icon: (self iconOrThumbnailOfSize: (Preferences tinyDisplay ifTrue: [16] ifFalse: [28])).
- menu popUpInWorld: self currentWorld!
Item was removed:
- ----- Method: Morph>>yellowButtonGestureDictionaryOrName: (in category 'geniestubs') -----
- yellowButtonGestureDictionaryOrName: aSymbolOrDictionary!
Item was removed:
- Object subclass: #MorphExtension
- instanceVariableNames: 'locked visible sticky balloonText balloonTextSelector externalName isPartsDonor actorState player eventHandler otherProperties'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Kernel'!
-
- !MorphExtension commentStamp: '<historical>' prior: 0!
- MorphExtension provides access to extra instance state that is not required in most simple morphs. This allows simple morphs to remain relatively lightweight while still admitting more complex structures as necessary. The otherProperties field takes this policy to the extreme of allowing any number of additional named attributes, albeit at a certain cost in speed and space.!
Item was removed:
- ----- Method: MorphExtension>>actorState (in category 'accessing') -----
- actorState
- "answer the redeiver's actorState"
- ^ actorState !
Item was removed:
- ----- Method: MorphExtension>>actorState: (in category 'accessing') -----
- actorState: anActorState
- "change the receiver's actorState"
- actorState := anActorState!
Item was removed:
- ----- Method: MorphExtension>>assureOtherProperties (in category 'accessing - other properties') -----
- assureOtherProperties
- "creates an otherProperties for the receiver if needed"
- otherProperties ifNil: [self initializeOtherProperties].
- ^ otherProperties!
Item was removed:
- ----- Method: MorphExtension>>balloonText (in category 'accessing') -----
- balloonText
- ^ balloonText!
Item was removed:
- ----- Method: MorphExtension>>balloonText: (in category 'accessing') -----
- balloonText: newValue
- balloonText := newValue!
Item was removed:
- ----- Method: MorphExtension>>balloonTextSelector (in category 'accessing') -----
- balloonTextSelector
- ^ balloonTextSelector!
Item was removed:
- ----- Method: MorphExtension>>balloonTextSelector: (in category 'accessing') -----
- balloonTextSelector: aSymbol
- "change the receiver's balloonTextSelector"
- balloonTextSelector := aSymbol!
Item was removed:
- ----- Method: MorphExtension>>comeFullyUpOnReload: (in category 'objects from disk') -----
- comeFullyUpOnReload: smartRefStream
- "inst vars have default booplean values."
-
- locked ifNil: [locked := false].
- visible ifNil: [visible := true].
- sticky ifNil: [sticky := false].
- isPartsDonor ifNil: [isPartsDonor := false].
- ^ self!
Item was removed:
- ----- Method: MorphExtension>>copyWeakly (in category 'connectors-copying') -----
- copyWeakly
- "list of names of properties whose values should be weak-copied when veryDeepCopying a morph. See DeepCopier."
-
- ^ #(formerOwner newPermanentPlayer logger graphModel gestureDictionaryOrName)
- "add yours to this list"
-
- "formerOwner should really be nil at the time of the copy, but this will work just fine."!
Item was removed:
- ----- Method: MorphExtension>>eventHandler (in category 'accessing') -----
- eventHandler
- "answer the receiver's eventHandler"
- ^ eventHandler !
Item was removed:
- ----- Method: MorphExtension>>eventHandler: (in category 'accessing') -----
- eventHandler: newValue
- eventHandler := newValue!
Item was removed:
- ----- Method: MorphExtension>>externalName (in category 'viewer') -----
- externalName
- ^ externalName!
Item was removed:
- ----- Method: MorphExtension>>externalName: (in category 'accessing') -----
- externalName: aString
- "change the receiver's externalName"
- externalName := aString!
Item was removed:
- ----- Method: MorphExtension>>hasOtherProperties (in category 'accessing - other properties') -----
- hasOtherProperties
- "answer whether the receiver has otherProperties"
- ^ otherProperties notNil!
Item was removed:
- ----- Method: MorphExtension>>hasProperty: (in category 'accessing - other properties') -----
- hasProperty: aSymbol
- "Answer whether the receiver has the property named aSymbol"
- | property |
- otherProperties ifNil: [^ false].
- property := otherProperties at: aSymbol ifAbsent: [].
- property isNil ifTrue: [^ false].
- property == false ifTrue: [^ false].
- ^ true!
Item was removed:
- ----- Method: MorphExtension>>initialize (in category 'initialization') -----
- initialize
- "Init all booleans to default values"
- locked := false.
- visible := true.
- sticky := false.
- isPartsDonor := false.
- !
Item was removed:
- ----- Method: MorphExtension>>initializeOtherProperties (in category 'accessing - other properties') -----
- initializeOtherProperties
- "private - initializes the receiver's otherProperties"
- otherProperties := IdentityDictionary new!
Item was removed:
- ----- Method: MorphExtension>>isDefault (in category 'other') -----
- isDefault
- "Return true if the receiver is a default and can be omitted"
- locked == true
- ifTrue: [^ false].
- visible == false
- ifTrue: [^ false].
- sticky == true
- ifTrue: [^ false].
- balloonText isNil
- ifFalse: [^ false].
- balloonTextSelector isNil
- ifFalse: [^ false].
- externalName isNil
- ifFalse: [^ false].
- isPartsDonor == true
- ifTrue: [^ false].
- actorState isNil
- ifFalse: [^ false].
- player isNil
- ifFalse: [^ false].
- eventHandler isNil
- ifFalse: [^ false].
- otherProperties ifNotNil: [otherProperties isEmpty ifFalse: [^ false]].
- ^ true!
Item was removed:
- ----- Method: MorphExtension>>isPartsDonor (in category 'parts bin') -----
- isPartsDonor
- "answer whether the receiver is PartsDonor"
- ^ isPartsDonor!
Item was removed:
- ----- Method: MorphExtension>>isPartsDonor: (in category 'parts bin') -----
- isPartsDonor: aBoolean
- "change the receiver's isPartDonor property"
- isPartsDonor := aBoolean!
Item was removed:
- ----- Method: MorphExtension>>layoutFrame (in category 'accessing - layout properties') -----
- layoutFrame
- ^self valueOfProperty: #layoutFrame!
Item was removed:
- ----- Method: MorphExtension>>layoutFrame: (in category 'accessing - layout properties') -----
- layoutFrame: aLayoutFrame
- aLayoutFrame isNil
- ifTrue: [self removeProperty: #layoutFrame]
- ifFalse: [self setProperty: #layoutFrame toValue: aLayoutFrame]!
Item was removed:
- ----- Method: MorphExtension>>layoutPolicy (in category 'accessing - layout properties') -----
- layoutPolicy
- ^self valueOfProperty: #layoutPolicy!
Item was removed:
- ----- Method: MorphExtension>>layoutPolicy: (in category 'accessing - layout properties') -----
- layoutPolicy: aLayoutPolicy
- aLayoutPolicy isNil
- ifTrue: [self removeProperty: #layoutPolicy]
- ifFalse: [self setProperty: #layoutPolicy toValue: aLayoutPolicy]!
Item was removed:
- ----- Method: MorphExtension>>layoutProperties (in category 'accessing - layout properties') -----
- layoutProperties
- ^self valueOfProperty: #layoutProperties!
Item was removed:
- ----- Method: MorphExtension>>layoutProperties: (in category 'accessing - layout properties') -----
- layoutProperties: newProperties
- "Return the current layout properties associated with the receiver"
-
- newProperties isNil
- ifTrue: [self removeProperty: #layoutProperties]
- ifFalse: [self setProperty: #layoutProperties toValue: newProperties]!
Item was removed:
- ----- Method: MorphExtension>>locked (in category 'accessing') -----
- locked
- "answer whether the receiver is Locked"
- ^ locked!
Item was removed:
- ----- Method: MorphExtension>>locked: (in category 'accessing') -----
- locked: aBoolean
- "change the receiver's locked property"
- locked := aBoolean!
Item was removed:
- ----- Method: MorphExtension>>otherProperties (in category 'accessing - other properties') -----
- otherProperties
- "answer the receiver's otherProperties"
- ^ otherProperties!
Item was removed:
- ----- Method: MorphExtension>>player (in category 'accessing') -----
- player
- "answer the receiver's player"
- ^ player!
Item was removed:
- ----- Method: MorphExtension>>player: (in category 'accessing') -----
- player: anObject
- "change the receiver's player"
- player := anObject !
Item was removed:
- ----- Method: MorphExtension>>printOn: (in category 'printing') -----
- printOn: aStream
- "Append to the argument, aStream, a sequence of characters that
- identifies the receiver."
- super printOn: aStream.
- aStream nextPutAll: ' ' , self identityHashPrintString.
- locked == true
- ifTrue: [aStream nextPutAll: ' [locked] '].
- visible == false
- ifTrue: [aStream nextPutAll: '[not visible] '].
- sticky == true
- ifTrue: [aStream nextPutAll: ' [sticky] '].
- balloonText
- ifNotNil: [aStream nextPutAll: ' [balloonText] '].
- balloonTextSelector
- ifNotNil: [aStream nextPutAll: ' [balloonTextSelector: ' , balloonTextSelector printString , '] '].
- externalName
- ifNotNil: [aStream nextPutAll: ' [externalName = ' , externalName , ' ] '].
- isPartsDonor == true
- ifTrue: [aStream nextPutAll: ' [isPartsDonor] '].
- player
- ifNotNil: [aStream nextPutAll: ' [player = ' , player printString , '] '].
- eventHandler
- ifNotNil: [aStream nextPutAll: ' [eventHandler = ' , eventHandler printString , '] '].
- (otherProperties isNil or: [otherProperties isEmpty ]) ifTrue: [^ self].
- aStream nextPutAll: ' [other: '.
- self otherProperties
- keysDo: [:aKey | aStream nextPutAll: ' (' , aKey , ' -> ' , (self otherProperties at: aKey) printString , ')'].
- aStream nextPut: $]!
Item was removed:
- ----- Method: MorphExtension>>privateOtherProperties: (in category 'accessing - other properties') -----
- privateOtherProperties: anIdentityDictionary
- "private - change the receiver's otherProperties"
- otherProperties := anIdentityDictionary !
Item was removed:
- ----- Method: MorphExtension>>propertyNamesNotCopied (in category 'connectors-copying') -----
- propertyNamesNotCopied
- "list of names of properties whose values should be deleted when veryDeepCopying a morph.
- See DeepCopier."
-
- ^ #(connectedConstraints connectionHighlights highlightedTargets)
- "add yours to this list"
- !
Item was removed:
- ----- Method: MorphExtension>>removeOtherProperties (in category 'accessing - other properties') -----
- removeOtherProperties
- "Remove the 'other' properties"
- otherProperties := nil!
Item was removed:
- ----- Method: MorphExtension>>removeProperty: (in category 'accessing - other properties') -----
- removeProperty: aSymbol
- "Removes the property named aSymbol if it exists. Answer the old value or nil."
- | value |
- otherProperties ifNil: [^ nil].
- value := otherProperties removeKey: aSymbol ifAbsent: [].
- otherProperties ifEmpty: [self removeOtherProperties].
- ^ value!
Item was removed:
- ----- Method: MorphExtension>>setProperty:toValue: (in category 'accessing - other properties') -----
- setProperty: aSymbol toValue: abObject
- "Change the receiver's property named aSymbol to anObject. Answer anObject."
- ^ self assureOtherProperties at: aSymbol put: abObject!
Item was removed:
- ----- Method: MorphExtension>>sortedPropertyNames (in category 'accessing - other properties') -----
- sortedPropertyNames
- "answer the receiver's property names in a sorted way"
-
- | props |
- props := WriteStream on: (Array new: 10).
- locked == true ifTrue: [props nextPut: #locked].
- visible == false ifTrue: [props nextPut: #visible].
- sticky == true ifTrue: [props nextPut: #sticky].
- balloonText isNil ifFalse: [props nextPut: #balloonText].
- balloonTextSelector isNil ifFalse: [props nextPut: #balloonTextSelector].
- externalName isNil ifFalse: [props nextPut: #externalName].
- isPartsDonor == true ifTrue: [props nextPut: #isPartsDonor].
- actorState isNil ifFalse: [props nextPut: #actorState].
- player isNil ifFalse: [props nextPut: #player].
- eventHandler isNil ifFalse: [props nextPut: #eventHandler].
- otherProperties ifNotNil: [otherProperties associationsDo: [:a | props nextPut: a key]].
- ^props contents sort: [:s1 :s2 | s1 <= s2]!
Item was removed:
- ----- Method: MorphExtension>>sticky (in category 'accessing') -----
- sticky
- ^ sticky!
Item was removed:
- ----- Method: MorphExtension>>sticky: (in category 'accessing') -----
- sticky: aBoolean
- "change the receiver's sticky property"
- sticky := aBoolean!
Item was removed:
- ----- Method: MorphExtension>>valueOfProperty: (in category 'accessing - other properties') -----
- valueOfProperty: aSymbol
- "answer the value of the receiver's property named aSymbol"
-
- ^otherProperties ifNotNil: [ otherProperties at: aSymbol ifAbsent: nil ]!
Item was removed:
- ----- Method: MorphExtension>>valueOfProperty:ifAbsent: (in category 'accessing - other properties') -----
- valueOfProperty: aSymbol ifAbsent: aBlock
- "if the receiver possesses a property of the given name, answer
- its value. If not then evaluate aBlock and answer the result of
- this block evaluation"
- otherProperties ifNil: [^ aBlock value].
- ^otherProperties at: aSymbol ifAbsent: aBlock!
Item was removed:
- ----- Method: MorphExtension>>valueOfProperty:ifAbsentPut: (in category 'accessing - other properties') -----
- valueOfProperty: aSymbol ifAbsentPut: aBlock
- "If the receiver possesses a property of the given name, answer
- its value. If not, then create a property of the given name, give
- it the value obtained by evaluating aBlock, then answer that
- value"
- ^self assureOtherProperties at: aSymbol ifAbsentPut: aBlock!
Item was removed:
- ----- Method: MorphExtension>>veryDeepFixupWith: (in category 'connectors-copying') -----
- veryDeepFixupWith: deepCopier
- "If target and arguments fields were weakly copied, fix them here.
- If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"
-
- super veryDeepFixupWith: deepCopier.
- otherProperties ifNil: [ ^self ].
-
- "Properties whose values are only copied weakly replace those values if they were copied via another path"
- self copyWeakly do: [ :propertyName |
- otherProperties at: propertyName ifPresent: [ :property |
- otherProperties at: propertyName
- put: (deepCopier references at: property ifAbsent: [ property ])]].
- !
Item was removed:
- ----- Method: MorphExtension>>veryDeepInner: (in category 'connectors-copying') -----
- veryDeepInner: deepCopier
- "Copy all of my instance variables.
- Some otherProperties need to be not copied at all, but shared. Their names are given by copyWeakly.
- Some otherProperties should not be copied or shared. Their names are given by propertyNamesNotCopied.
- This is special code for the dictionary. See DeepCopier, and veryDeepFixupWith:."
-
- | namesOfWeaklyCopiedProperties weaklyCopiedValues |
- super veryDeepInner: deepCopier.
- locked := locked veryDeepCopyWith: deepCopier.
- visible := visible veryDeepCopyWith: deepCopier.
- sticky := sticky veryDeepCopyWith: deepCopier.
- balloonText := balloonText veryDeepCopyWith: deepCopier.
- balloonTextSelector := balloonTextSelector veryDeepCopyWith: deepCopier.
- externalName := externalName veryDeepCopyWith: deepCopier.
- isPartsDonor := isPartsDonor veryDeepCopyWith: deepCopier.
- actorState := actorState veryDeepCopyWith: deepCopier.
- player := player veryDeepCopyWith: deepCopier. "Do copy the player of this morph"
- eventHandler := eventHandler veryDeepCopyWith: deepCopier. "has its own restrictions"
-
- otherProperties ifNil: [ ^self ].
-
- otherProperties := otherProperties copy.
- self propertyNamesNotCopied do: [ :propName | otherProperties removeKey: propName ifAbsent: [] ].
-
- namesOfWeaklyCopiedProperties := self copyWeakly.
- weaklyCopiedValues := namesOfWeaklyCopiedProperties collect: [ :propName | otherProperties removeKey: propName ifAbsent: [] ].
-
- "Now copy all the others."
- otherProperties := otherProperties veryDeepCopyWith: deepCopier.
-
- "And replace the weak ones."
- namesOfWeaklyCopiedProperties with: weaklyCopiedValues do: [ :name :value | value ifNotNil: [ otherProperties at: name put: value ]].
- !
Item was removed:
- ----- Method: MorphExtension>>visible (in category 'accessing') -----
- visible
- "answer whether the receiver is visible"
- ^ visible!
Item was removed:
- ----- Method: MorphExtension>>visible: (in category 'accessing') -----
- visible: newValue
- visible := newValue!
Item was removed:
- Object subclass: #MorphHierarchy
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
Item was removed:
- ----- Method: MorphHierarchy class>>openOrDelete (in category 'opening') -----
- openOrDelete
- | oldMorph |
- oldMorph := Project current world submorphs
- detect: [:each | each hasProperty: #morphHierarchy]
- ifNone: [| newMorph |
- newMorph := self new asMorph.
- newMorph bottomLeft: self currentHand position.
- newMorph openInWorld.
- newMorph isFullOnScreen
- ifFalse: [newMorph goHome].
- ^ self].
- ""
- oldMorph delete!
Item was removed:
- ----- Method: MorphHierarchy>>asMorph (in category 'private') -----
- asMorph
- "Answer the morph version of the receiver"
- | morph |
- morph := MorphHierarchyListMorph
- on: self
- list: #roots
- selected: nil
- changeSelected: #selected:.
- ""
- ^ morph inAContainer!
Item was removed:
- ----- Method: MorphHierarchy>>roots (in category 'accessing') -----
- roots
- "Answer the roots for the Object Hierarchy, that means answer the world"
- ^ {MorphListItemWrapper with: Project current world}!
Item was removed:
- ----- Method: MorphHierarchy>>selected: (in category 'accessing') -----
- selected: aMorphListItemWrapper
- "Change the selected object"
- | newSelection |
- aMorphListItemWrapper isNil
- ifTrue: [^ self].
- newSelection := aMorphListItemWrapper withoutListWrapper.
- newSelection == Project current world selectedObject
- ifTrue: [newSelection removeHalo]
- ifFalse: [newSelection addHalo].
- self changed: #selected!
Item was removed:
- SimpleHierarchicalListMorph subclass: #MorphHierarchyListMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
Item was removed:
- ----- Method: MorphHierarchyListMorph>>createContainer (in category 'private') -----
- createContainer
- "Private - Create a container"
- | container |
- container := BorderedMorph new.
- container extent: (self world extent * (1 / 4 @ (2 / 3))) rounded.
- container layoutPolicy: TableLayout new.
- container hResizing: #rigid.
- container vResizing: #rigid.
- container
- color: (Color gray: 0.9);
- borderWidth: 1;
- borderColor: Color gray.
- container layoutInset: 0.
- "container useRoundedCorners."
- ""
- container setProperty: #morphHierarchy toValue: true.
- container setNameTo: 'Objects Hierarchy' translated.
- ""
- ^ container!
Item was removed:
- ----- Method: MorphHierarchyListMorph>>inAContainer (in category 'private') -----
- inAContainer
- "Answer the receiver contained in a proper container"
- | container |
- container := self createContainer.
- container addMorphBack: self.
- "
- nasty hack to force the scroolbar recreation"
- self extent: container extent - container borderWidth.
- ""
- ^ container!
Item was removed:
- ----- Method: MorphHierarchyListMorph>>on:list:selected:changeSelected:menu:keystroke: (in category 'initialization') -----
- on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel
- super
- on: anObject
- list: getListSel
- selected: getSelectionSel
- changeSelected: setSelectionSel
- menu: getMenuSel
- keystroke: keyActionSel.
- ""
- self borderWidth: 0.
- self autoDeselect: false.
- self enableDrag: false.
- self enableDrop: true.
- self hResizing: #spaceFill.
- self vResizing: #spaceFill.
- self expandRoots!
Item was removed:
- ----- Method: MorphHierarchyListMorph>>setSelectedMorph: (in category 'selection') -----
- setSelectedMorph: aMorph
- super setSelectedMorph: aMorph.
- self owner isNil ifFalse:[self owner delete]!
Item was removed:
- ListItemWrapper subclass: #MorphListItemWrapper
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
Item was removed:
- ----- Method: MorphListItemWrapper>>asString (in category 'converting') -----
- asString
- "Answer the string representation of the receiver"
- ^ item externalName!
Item was removed:
- ----- Method: MorphListItemWrapper>>contents (in category 'accessing') -----
- contents
- "Answer the receiver's contents"
-
- | tentative submorphs |
- tentative := item submorphs
- collect: [:each | each renderedMorph].
-
- submorphs := Preferences noviceMode
- ifTrue: [
- tentative
- reject: [:each |
- each isSystemWindow
- or: [each isDockingBar
- or: [(each isKindOf: HaloMorph)
- or: [(each hasProperty: #morphHierarchy)
- or: [each isFlapOrTab
- or: [each isObjectsTool]]]]]]]
- ifFalse: [
- tentative
- reject: [:each | each isKindOf: HaloMorph]].
-
- ^ submorphs
- collect: [:each | self class with: each]!
Item was removed:
- ----- Method: MorphListItemWrapper>>icon (in category 'accessing') -----
- icon
- "Answer a form to be used as icon"
- ^ item iconOrThumbnailOfSize: ((Preferences tinyDisplay ifTrue: [16] ifFalse: [28]))!
Item was removed:
- ListItemWrapper subclass: #MorphWithSubmorphsWrapper
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Explorer'!
-
- !MorphWithSubmorphsWrapper commentStamp: 'ls 3/1/2004 17:32' prior: 0!
- Display a morph in a SimpleHierarchicalListMorph, and arrange to recursively display the morph's submorphs. The "item" that is wrapped is the morph to display.!
Item was removed:
- ----- Method: MorphWithSubmorphsWrapper>>contents (in category 'hierarchy') -----
- contents
- ^item submorphs collect: [ :m |
- self class with: m ]!
Item was removed:
- MessageSend subclass: #MorphicAlarm
- instanceVariableNames: 'scheduledTime sequenceNumber numArgs'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!
Item was removed:
- ----- Method: MorphicAlarm class>>scheduledAt:receiver:selector:arguments: (in category 'instance creation') -----
- scheduledAt: scheduledTime receiver: aTarget selector: aSelector arguments: argArray
- ^(self receiver: aTarget selector: aSelector arguments: argArray)
- scheduledTime: scheduledTime.!
Item was removed:
- ----- Method: MorphicAlarm>>scheduledTime (in category 'accessing') -----
- scheduledTime
- "Return the time (in milliseconds) that the receiver is scheduled to be executed"
- ^scheduledTime!
Item was removed:
- ----- Method: MorphicAlarm>>scheduledTime: (in category 'accessing') -----
- scheduledTime: msecs
- "Set the time (in milliseconds) that the receiver is scheduled to be executed"
- scheduledTime := msecs!
Item was removed:
- ----- Method: MorphicAlarm>>sequenceNumber (in category 'accessing') -----
- sequenceNumber
- "Answer the sequence number of the alarm, which is used to preserve ordering for alarms scheduled for the same time."
- ^sequenceNumber ifNil: [0]!
Item was removed:
- ----- Method: MorphicAlarm>>sequenceNumber: (in category 'accessing') -----
- sequenceNumber: positiveInteger
- "Set the sequence number of the alarm, which is used to preserve ordering for alarms scheduled for the same time."
- sequenceNumber := positiveInteger!
Item was removed:
- ----- Method: MorphicAlarm>>value: (in category 'evaluating') -----
- value: anArgument
- | nArgs |
- numArgs ifNil:[numArgs := selector numArgs].
- nArgs := arguments ifNil:[0] ifNotNil:[arguments size].
- nArgs = numArgs ifTrue:[
- "Ignore extra argument"
- ^self value].
- ^arguments
- ifNil: [ receiver perform: selector with: anArgument]
- ifNotNil: [ receiver perform: selector withArguments: (arguments copyWith: anArgument)]!
Item was removed:
- Object subclass: #MorphicAlarmQueue
- instanceVariableNames: 'mutex sequenceNumber heap'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!
-
- !MorphicAlarmQueue commentStamp: 'jcg 1/9/2010 13:34' prior: 0!
- MorphicAlarmQueue is a specialized Heap. The main change is to stamp each added MorphicAlarm with a sequence number to ensure that alarms scheduled for the same time are executed in the order that they were added.!
Item was removed:
- ----- Method: MorphicAlarmQueue class>>convertAllAlarms (in category 'class initialization') -----
- convertAllAlarms
- "Alarms should be kept in a MorphicAlarmQueue, not a Heap."
- WorldState allSubInstancesDo: [:ws | ws convertAlarms]!
Item was removed:
- ----- Method: MorphicAlarmQueue class>>initialize (in category 'class initialization') -----
- initialize
- self convertAllAlarms.!
Item was removed:
- ----- Method: MorphicAlarmQueue>>add: (in category 'adding') -----
- add: aMorphicAlarm
-
- aMorphicAlarm sequenceNumber: self nextSequenceNumber.
- ^heap add: aMorphicAlarm!
Item was removed:
- ----- Method: MorphicAlarmQueue>>alarmsDoSafely: (in category 'enumeration') -----
- alarmsDoSafely: aBlock
-
- heap asArray do: aBlock!
Item was removed:
- ----- Method: MorphicAlarmQueue>>incrementScheduledTimesBy: (in category 'accessing') -----
- incrementScheduledTimesBy: anInteger
-
- heap do: [ :each | each scheduledTime: each scheduledTime + anInteger ]!
Item was removed:
- ----- Method: MorphicAlarmQueue>>initialize (in category 'initialize') -----
- initialize
-
- super initialize.
- mutex := Mutex new.
- sequenceNumber := 0.
- heap := Heap sortBlock: [ :alarmA :alarmB |
- alarmA scheduledTime = alarmB scheduledTime
- ifFalse: [ alarmA scheduledTime < alarmB scheduledTime ]
- ifTrue: [
- alarmA sequenceNumber = alarmB sequenceNumber
- ifFalse: [ alarmA sequenceNumber < alarmB sequenceNumber ]
- ifTrue: [ self error: 'These alarms run at the same time' ] ] ]!
Item was removed:
- ----- Method: MorphicAlarmQueue>>mutex (in category 'accessing') -----
- mutex
-
- ^mutex!
Item was removed:
- ----- Method: MorphicAlarmQueue>>nextSequenceNumber (in category 'private') -----
- nextSequenceNumber
-
- (sequenceNumber := sequenceNumber + 1) = 16r3FFFFFFF ifTrue: [
- "Sequence number overflow... reassign sequence numbers starting at 1."
- heap sort.
- 1 to: heap size do: [ :index |
- (heap at: index) sequenceNumber: index ].
- sequenceNumber := heap size + 1 ].
- ^sequenceNumber!
Item was removed:
- ----- Method: MorphicAlarmQueue>>postCopy (in category 'copying') -----
- postCopy
-
- super postCopy.
- mutex := Mutex new.
- heap := heap copy!
Item was removed:
- ----- Method: MorphicAlarmQueue>>removeAlarmWithReceiver:selector: (in category 'removing') -----
- removeAlarmWithReceiver: receiver selector: selector
-
- ^heap
- detect: [ :each | each receiver == receiver and: [ each selector == selector ] ]
- ifFound: [ :found | heap remove: found ]
- ifNone: [ ]!
Item was removed:
- ----- Method: MorphicAlarmQueue>>removeAllAlarmsBefore: (in category 'removing') -----
- removeAllAlarmsBefore: nowTime
-
- ^Array new: 10 streamContents: [ :stream |
- [ heap notEmpty and: [ heap first scheduledTime < nowTime ] ]
- whileTrue: [ stream nextPut: heap removeFirst ] ]!
Item was removed:
- Debugger subclass: #MorphicDebugger
- instanceVariableNames: 'errorWasInUIProcess'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Support'!
Item was removed:
- ----- Method: MorphicDebugger class>>openOn:context:label:contents:fullView: (in category 'opening') -----
- openOn: processToDebug context: context label: title contents: contentsStringOrNil fullView: full
-
- | debugger uiBlock |
- debugger := self new
- process: processToDebug context: context;
- errorWasInUIProcess: (Project current spawnNewProcessIfThisIsUI: processToDebug).
-
- uiBlock := [
- full
- ifTrue: [debugger openFullNoSuspendLabel: title]
- ifFalse: [debugger openNotifierNoSuspendContents: contentsStringOrNil label: title].
-
- "Try layouting the debugger tool at least once to avoid freeze."
- debugger topView ifNotNil: [:window |
- "There are way too many #fullBounds sends. Layout errors might already have happened."
- window allMorphsDo: [:m | (m hasProperty: #errorOnLayout) ifTrue: [self error: 'Layout error']].
- window world doLayout. "Not safely!!"].
- "Try drawing the debugger tool at least once to avoid freeze."
- debugger topView ifNotNil: [:window | window world displayWorld. "Not safely!!"].
- ].
-
- "Schedule debugging in a deferred UI message if necessary. Note that only the ui process should execute ui code."
- (Project current uiProcess isActiveProcess not or: [processToDebug isActiveProcess])
- ifFalse: uiBlock
- ifTrue: [ | event |
- self flag: #discuss. "mt: We need to preserve the currentEvent for #openToolsAttachedToMouseCursor ..."
- event := self currentEvent.
- Project current addDeferredUIMessage: [event becomeActiveDuring: uiBlock]].
-
- processToDebug suspend.
-
- "Get here only if active process is not the process-to-debug. So in tests, use a helper process if you want to access this return value."
- ^ debugger!
Item was removed:
- ----- Method: MorphicDebugger>>errorWasInUIProcess (in category 'accessing') -----
- errorWasInUIProcess
-
- ^ errorWasInUIProcess!
Item was removed:
- ----- Method: MorphicDebugger>>errorWasInUIProcess: (in category 'accessing') -----
- errorWasInUIProcess: boolean
-
- errorWasInUIProcess := boolean!
Item was removed:
- ----- Method: MorphicDebugger>>initialize (in category 'initialize') -----
- initialize
-
- super initialize.
-
- errorWasInUIProcess := false.!
Item was removed:
- ----- Method: MorphicDebugger>>openFullFromNotifier: (in category 'initialize') -----
- openFullFromNotifier: notifierWindow
- "Create, schedule and answer a full debugger with the given label. Do not terminate the current active process."
-
- super openFullFromNotifier: notifierWindow.
-
- notifierWindow delete.
-
- ^ ToolBuilder default
- open: self
- label: notifierWindow label!
Item was removed:
- ----- Method: MorphicDebugger>>openFullNoSuspendLabel: (in category 'initialize') -----
- openFullNoSuspendLabel: aString
- "Create, schedule and answer a full debugger with the given label. Do not terminate the current active process."
-
- super openFullNoSuspendLabel: aString.
-
- ^ ToolBuilder default
- open: self
- label: aString!
Item was removed:
- ----- Method: MorphicDebugger>>openNotifierNoSuspendContents:label: (in category 'initialize') -----
- openNotifierNoSuspendContents: msgString label: label
-
- | builder spec |
- super openNotifierNoSuspendContents: msgString label: label.
-
- builder := ToolBuilder default.
- spec := self buildNotifierWith: builder label: label message: msgString.
-
- ^ ToolBuilder default open: spec!
Item was removed:
- ----- Method: MorphicDebugger>>resumeProcess: (in category 'private') -----
- resumeProcess: processToResume
-
- processToResume isTerminated ifFalse: [
- errorWasInUIProcess ifTrue: [Project current uiProcess: processToResume].
- processToResume resume.
- errorWasInUIProcess ifTrue: [Processor terminateActive]].!
Item was removed:
- ----- Method: MorphicDebugger>>windowIsClosing (in category 'initialize') -----
- windowIsClosing
- "Keep track of last debugger extent."
-
- interruptedProcess ifNil: [ ^ self ].
-
- SavedExtent ifNotNil:
- [ self dependents
- detect:
- [ : each | each isWindowForModel: self ]
- ifFound:
- [ : topWindow | | isDebuggerNotNotifier |
- isDebuggerNotNotifier := self dependents anySatisfy:
- [ : each | each isTextView ].
- isDebuggerNotNotifier ifTrue: [
- SavedExtent := (topWindow extent / RealEstateAgent scaleFactor) rounded ] ]
- ifNone: [ "do nothing" ] ].
-
- super windowIsClosing.!
Item was removed:
- Object subclass: #MorphicEvent
- instanceVariableNames: 'timeStamp source'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!
-
- !MorphicEvent commentStamp: '<historical>' prior: 0!
- This class represents the base for all events.
-
- Instance variables:
- stamp <Integer> The millisecond clock time stamp (based on Time millisecondClock)
- source <Hand | nil> If non-nil the hand that generated the event.!
Item was removed:
- ----- Method: MorphicEvent class>>convertObsolete: (in category 'instance creation') -----
- convertObsolete: anEvent
- "ar 10/25/2000: This method is used to convert OLD MorphicEvents into new ones."
- | type cursorPoint buttons keyValue sourceHand |
- type := anEvent type.
- cursorPoint := anEvent cursorPoint.
- buttons := anEvent buttons.
- keyValue := anEvent keyValue.
- sourceHand := anEvent hand.
- type == #mouseMove ifTrue:[
- ^MouseMoveEvent new
- setType: #mouseMove
- startPoint: cursorPoint
- endPoint: cursorPoint
- trail: #()
- buttons: buttons
- hand: sourceHand
- stamp: nil].
- (type == #mouseDown) | (type == #mouseUp) ifTrue:[
- ^MouseButtonEvent new
- setType: type
- position: cursorPoint
- which: 0
- buttons: buttons
- hand: sourceHand
- stamp: nil].
- (type == #keystroke) | (type == #keyDown) | (type == #keyUp) ifTrue:[
- ^KeyboardEvent new
- setType: type
- buttons: buttons
- position: cursorPoint
- keyValue: keyValue
- hand: sourceHand
- stamp: nil].
- ^nil!
Item was removed:
- ----- Method: MorphicEvent class>>readFrom: (in category 'instance creation') -----
- readFrom: aStream
- "Read a MorphicEvent from the given stream."
- | typeString |
- typeString := String streamContents:
- [:s | | c | [(c := aStream next) isLetter] whileTrue: [s nextPut: c]].
- typeString = 'mouseMove' ifTrue:[^MouseMoveEvent type: #mouseMove readFrom: aStream].
- typeString = 'mouseDown' ifTrue:[^MouseButtonEvent type: #mouseDown readFrom: aStream].
- typeString = 'mouseUp' ifTrue:[^MouseButtonEvent type: #mouseUp readFrom: aStream].
- typeString = 'mouseWheel' ifTrue:[^MouseWheelEvent type: #mouseWheel readFrom: aStream].
-
- typeString = 'keystroke' ifTrue:[^KeyboardEvent type: #keystroke readFrom: aStream].
- typeString = 'keyDown' ifTrue:[^KeyboardEvent type: #keyDown readFrom: aStream].
- typeString = 'keyUp' ifTrue:[^KeyboardEvent type: #keyUp readFrom: aStream].
-
- typeString = 'mouseOver' ifTrue:[^MouseEvent type: #mouseOver readFrom: aStream].
- typeString = 'mouseEnter' ifTrue:[^MouseEvent type: #mouseEnter readFrom: aStream].
- typeString = 'mouseLeave' ifTrue:[^MouseEvent type: #mouseLeave readFrom: aStream].
-
- typeString = 'unknown' ifTrue:[^MorphicUnknownEvent type: #unknown readFrom: aStream].
-
- ^nil
- !
Item was removed:
- ----- Method: MorphicEvent class>>readFromObsolete: (in category 'instance creation') -----
- readFromObsolete: aStream
- "Read one of those old and now obsolete events from the stream"
- | type x y buttons keyValue typeString |
- typeString := String streamContents:
- [:s | | c | [(c := aStream next) isLetter] whileTrue: [s nextPut: c]].
- typeString = 'mouseMove'
- ifTrue: [type := #mouseMove "fast treatment of common case"]
- ifFalse: [type := typeString asSymbol].
-
- x := Integer readFrom: aStream.
- aStream skip: 1.
- y := Integer readFrom: aStream.
- aStream skip: 1.
-
- buttons := Integer readFrom: aStream.
- aStream skip: 1.
-
- keyValue := Integer readFrom: aStream.
-
- typeString = 'mouseMove' ifTrue:[
- ^MouseMoveEvent new
- setType: #mouseMove
- startPoint: x at y
- endPoint: x at y
- trail: #()
- buttons: buttons
- hand: nil
- stamp: nil].
- (typeString = 'mouseDown') | (typeString = 'mouseUp') ifTrue:[
- ^MouseButtonEvent new
- setType: type
- position: x at y
- which: 0
- buttons: buttons
- hand: nil
- stamp: nil].
- (typeString = 'keystroke') | (typeString = 'keyDown') | (typeString = 'keyUp') ifTrue:[
- ^KeyboardEvent new
- setType: type
- buttons: buttons
- position: x at y
- keyValue: keyValue
- hand: nil
- stamp: nil].
-
- ^nil!
Item was removed:
- ----- Method: MorphicEvent class>>type:readFrom: (in category 'instance creation') -----
- type: eventType readFrom: aStream
- ^self new type: eventType readFrom: aStream!
Item was removed:
- ----- Method: MorphicEvent>>= (in category 'comparing') -----
- = anEvent
- anEvent isMorphicEvent ifFalse:[^false].
- ^self type = anEvent type!
Item was removed:
- ----- Method: MorphicEvent>>becomeActiveDuring: (in category 'initialize') -----
- becomeActiveDuring: aBlock
- "Make the receiver the active event during the evaluation of aBlock."
-
- ^ ActiveEventVariable value: self during: aBlock!
Item was removed:
- ----- Method: MorphicEvent>>convertOctober2000:using: (in category 'object fileIn') -----
- convertOctober2000: varDict using: smartRefStrm
- "ar 10/25/2000: This method is used to convert OLD MorphicEvents into new ones."
- "These are going away #('type' 'cursorPoint' 'buttons' 'keyValue' 'sourceHand'). Possibly store their info in another variable?"
- | type cursorPoint buttons keyValue sourceHand |
- type := varDict at: 'type'.
- cursorPoint := varDict at: 'cursorPoint'.
- buttons := varDict at: 'buttons'.
- keyValue := varDict at: 'keyValue'.
- sourceHand := varDict at: 'sourceHand'.
- type == #mouseMove ifTrue:[
- ^MouseMoveEvent new
- setType: #mouseMove
- startPoint: cursorPoint
- endPoint: cursorPoint
- trail: #()
- buttons: buttons
- hand: sourceHand
- stamp: nil].
- (type == #mouseDown) | (type == #mouseUp) ifTrue:[
- ^MouseButtonEvent new
- setType: type
- position: cursorPoint
- which: 0
- buttons: buttons
- hand: sourceHand
- stamp: nil].
- (type == #keystroke) | (type == #keyDown) | (type == #keyUp) ifTrue:[
- ^KeyboardEvent new
- setType: type
- buttons: buttons
- position: cursorPoint
- keyValue: keyValue
- hand: sourceHand
- stamp: nil].
- "All others will be handled there"
- ^MorphicUnknownEvent new!
Item was removed:
- ----- Method: MorphicEvent>>convertToCurrentVersion:refStream: (in category 'objects from disk') -----
- convertToCurrentVersion: varDict refStream: smartRefStrm
-
-
-
- "ar 10/25/2000: This method is used to convert OLD MorphicEvents into new ones."
- varDict at: 'cursorPoint' ifPresent: [ :x | | answer |
- answer := self convertOctober2000: varDict using: smartRefStrm.
- varDict removeKey: 'cursorPoint'. "avoid doing this again"
- ^answer
- ].
- ^super convertToCurrentVersion: varDict refStream: smartRefStrm.
-
-
- !
Item was removed:
- ----- Method: MorphicEvent>>copyHandlerState: (in category 'initialize') -----
- copyHandlerState: anEvent
- "Copy the handler state from anEvent. Used for quickly transferring handler information between transformed events."
- !
Item was removed:
- ----- Method: MorphicEvent>>cursorPoint (in category 'accessing') -----
- cursorPoint
- "Backward compatibility. Use #position instead"
- ^ self position!
Item was removed:
- ----- Method: MorphicEvent>>hand (in category 'accessing') -----
- hand
- "Return the source that generated the event"
- ^source!
Item was removed:
- ----- Method: MorphicEvent>>hash (in category 'comparing') -----
- hash
- ^self type hash!
Item was removed:
- ----- Method: MorphicEvent>>ignore (in category 'dispatching') -----
- ignore
-
- source ignoreEvent: self.!
Item was removed:
- ----- Method: MorphicEvent>>isDraggingEvent (in category 'testing') -----
- isDraggingEvent
- ^false!
Item was removed:
- ----- Method: MorphicEvent>>isDropEvent (in category 'testing') -----
- isDropEvent
- ^false!
Item was removed:
- ----- Method: MorphicEvent>>isKeyboard (in category 'testing') -----
- isKeyboard
- ^false!
Item was removed:
- ----- Method: MorphicEvent>>isKeystroke (in category 'testing') -----
- isKeystroke
- ^false!
Item was removed:
- ----- Method: MorphicEvent>>isMorphicEvent (in category 'testing') -----
- isMorphicEvent
- ^true!
Item was removed:
- ----- Method: MorphicEvent>>isMouse (in category 'testing') -----
- isMouse
- ^false!
Item was removed:
- ----- Method: MorphicEvent>>isMouseOver (in category 'testing') -----
- isMouseOver
- ^self type == #mouseOver!
Item was removed:
- ----- Method: MorphicEvent>>isWindowEvent (in category 'testing') -----
- isWindowEvent
- ^false!
Item was removed:
- ----- Method: MorphicEvent>>position (in category 'accessing') -----
- position
- "Since cursorPoint is defined and refers to position it should be defined
- here as well"
- ^ self subclassResponsibility!
Item was removed:
- ----- Method: MorphicEvent>>resetHandlerFields (in category 'initialize') -----
- resetHandlerFields
- "Reset anything that is used to cross-communicate between two eventual handlers during event dispatch"!
Item was removed:
- ----- Method: MorphicEvent>>sentTo: (in category 'dispatching') -----
- sentTo: anObject
- "Dispatch the receiver into anObject"
- ^anObject handleUnknownEvent: self!
Item was removed:
- ----- Method: MorphicEvent>>setHand: (in category 'private') -----
- setHand: aHand
- source := aHand!
Item was removed:
- ----- Method: MorphicEvent>>setTimeStamp: (in category 'private') -----
- setTimeStamp: stamp
- timeStamp := stamp.!
Item was removed:
- ----- Method: MorphicEvent>>timeStamp (in category 'accessing') -----
- timeStamp
- "Return the millisecond clock value at which the event was generated"
- ^timeStamp ifNil:[timeStamp := Sensor eventTimeNow]!
Item was removed:
- ----- Method: MorphicEvent>>transformedBy: (in category 'transforming') -----
- transformedBy: aMorphicTransform
- "Return the receiver transformed by the given transform into a local coordinate system."
- !
Item was removed:
- ----- Method: MorphicEvent>>translateTo: (in category 'transforming') -----
- translateTo: point
- !
Item was removed:
- ----- Method: MorphicEvent>>type (in category 'accessing') -----
- type
- "Return a symbol indicating the type this event."
- ^self subclassResponsibility!
Item was removed:
- ----- Method: MorphicEvent>>type:readFrom: (in category 'initialize') -----
- type: eventType readFrom: aStream
- "Read a MorphicEvent from the given stream."
- !
Item was removed:
- ----- Method: MorphicEvent>>wasHandled (in category 'accessing') -----
- wasHandled
- "Return true if this event was handled. May be ignored for some types of events."
- ^false!
Item was removed:
- ----- Method: MorphicEvent>>wasHandled: (in category 'accessing') -----
- wasHandled: aBool
- "Determine if this event was handled. May be ignored for some types of events."!
Item was removed:
- ----- Method: MorphicEvent>>wasIgnored (in category 'accessing') -----
- wasIgnored
- ^ false!
Item was removed:
- ----- Method: MorphicEvent>>wasIgnored: (in category 'accessing') -----
- wasIgnored: boolean
- !
Item was removed:
- Object subclass: #MorphicEventDispatcher
- instanceVariableNames: 'lastType lastDispatch'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!
-
- !MorphicEventDispatcher commentStamp: '<historical>' prior: 0!
- The class represents a strategy for dispatching events to some immediate child of a morph. It is used by morphs to delegate the somewhat complex action of dispatching events accurately. !
Item was removed:
- ----- Method: MorphicEventDispatcher>>dispatchDefault:with: (in category 'specific') -----
- dispatchDefault: anEvent with: aMorph
- "Dispatch the given event. The event will be passed to the front-most visible submorph that contains the position wrt. to the event."
-
- "Try to get out quickly"
- anEvent wasIgnored ifTrue: [^anEvent "propagate the ignored event"].
- (aMorph fullBounds containsPoint: anEvent position) ifFalse:[^#rejected].
-
- ^ self
- dispatchEvent: anEvent
- withHandler: aMorph
- withMorph: aMorph!
Item was removed:
- ----- Method: MorphicEventDispatcher>>dispatchDropEvent:with: (in category 'specific') -----
- dispatchDropEvent: anEvent with: aMorph
- "Find the appropriate receiver for the event and let it handle it. The dispatch is similar to the default dispatch with one difference: Morphs are given the chance to reject an entire drop operation. If the operation is rejected, no drop will be executed."
-
- "Try to get out quickly"
- anEvent wasIgnored ifTrue: [^anEvent "propagate the ignored event"].
- (aMorph fullBounds containsPoint: anEvent position) ifFalse:[^#rejected].
-
- "Give aMorph a chance to repel the dropping morph"
- aMorph rejectDropEvent: anEvent.
- anEvent wasHandled ifTrue:[^anEvent].
-
- ^ self
- dispatchEvent: anEvent
- withHandler: aMorph
- withMorph: aMorph!
Item was removed:
- ----- Method: MorphicEventDispatcher>>dispatchEvent:toSubmorphsOf: (in category 'support') -----
- dispatchEvent: anEvent toSubmorphsOf: aMorph
- "Dispatch the given event to the submorphs of the given morph. For coordinate transformations, work only with copies. Either return the given event or a copy of any filtered event to employ immutability to some extent. --- PRIVATE!!"
-
- | localEvent filteredEvent |
- aMorph submorphsDo: [:child |
- localEvent := anEvent transformedBy: (child transformedFrom: aMorph).
- filteredEvent := child processEvent: localEvent.
- filteredEvent == #rejected ifFalse: [ "some event or #rejected symbol or any other object"
- filteredEvent isMorphicEvent ifFalse: [filteredEvent := localEvent].
- self flag: #overlappingChildren. "mt: We cannot give two overlapping siblings the chance to handle the event!!"
- ^ self nextFromOriginal: anEvent local: localEvent filtered: filteredEvent]].
-
- ^ #rejected!
Item was removed:
- ----- Method: MorphicEventDispatcher>>dispatchEvent:with: (in category 'dispatching') -----
- dispatchEvent: anEvent with: aMorph
- "Dispatch the given event for a morph that has chosen the receiver to dispatch its events. The method implements a shortcut for repeated dispatches of events using the same dispatcher."
- anEvent type == lastType ifTrue:[^self perform: lastDispatch with: anEvent with: aMorph].
- "Otherwise classify"
- lastType := anEvent type.
- anEvent isMouse ifTrue:[
- anEvent isMouseDown ifTrue:[
- lastDispatch := #dispatchMouseDown:with:.
- ^self dispatchMouseDown: anEvent with: aMorph]].
- anEvent type == #dropEvent ifTrue:[
- lastDispatch := #dispatchDropEvent:with:.
- ^self dispatchDropEvent: anEvent with: aMorph].
- anEvent isWindowEvent ifTrue:[
- lastDispatch := #dispatchWindowEvent:with:.
- ^self dispatchWindowEvent: anEvent with: aMorph].
- lastDispatch := #dispatchDefault:with:.
- ^self dispatchDefault: anEvent with: aMorph!
Item was removed:
- ----- Method: MorphicEventDispatcher>>dispatchEvent:withHandler:withMorph: (in category 'support') -----
- dispatchEvent: anEvent withHandler: aHandler withMorph: aMorph
- "Perform the actual event dispatch. Use the given object as handler. Ask submorphs first to handle the event. Then bubble up. Stop if ignored. Note that event rejection and event filters are two separete concepts. Filters come from the outside. Rejection is a morph's decision.
-
- * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event.
- * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed.
- * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event."
-
- | result filteredEvent |
-
- result := self dispatchEvent: anEvent toSubmorphsOf: aMorph.
-
- result == #rejected "Anybody?"
- ifFalse: [filteredEvent := result]
- ifTrue: [
- "My submorphs did not want it. Do I want it anyway? It's about locked children..."
- (aMorph containsPoint: anEvent position event: anEvent)
- ifFalse: [^ #rejected].
- filteredEvent := anEvent "there was no filtering, only basic rejects"].
-
- "Receiver is in the top-most unlocked, visible chain."
- (aHandler notNil and: [filteredEvent wasIgnored not])
- ifTrue: [filteredEvent := aHandler handleEvent: filteredEvent].
-
- ^ filteredEvent!
Item was removed:
- ----- Method: MorphicEventDispatcher>>dispatchFocusEvent:with: (in category 'focus events') -----
- dispatchFocusEvent: anEventWithGlobalPosition with: focusMorph
- "Dispatch the given event to the given morph. Simulate capturing phase, handle the event, then do bubbling."
-
- | currentEvent |
- "1) Capturing phase."
- currentEvent := self doCapturingForFocusEvent: anEventWithGlobalPosition with: focusMorph.
- currentEvent == #rejected ifTrue: [
- "See implementors of #rejectsEvent:, which is usually based on receiver state and not event state. Thus, reset foci to avoid unresponsive environment."
- anEventWithGlobalPosition hand
- releaseKeyboardFocus: focusMorph;
- releaseMouseFocus: focusMorph.
- ^ #rejected].
- "No need to reset foci here for ignored events because not all events might be ignored. Unlike #rejected."
- currentEvent wasIgnored ifTrue: [^ currentEvent].
-
- "2) No sub-tree processing here. Use #dispatchFocusEventFully:with: if you want that, too."
-
- "3) Let the focus morph handle the event."
- currentEvent := self doHandlingForFocusEvent: currentEvent with: focusMorph.
- currentEvent wasIgnored ifTrue: [^ currentEvent].
-
- "4) Bubbling phase"
- ^ self doBubblingForFocusEvent: currentEvent with: focusMorph!
Item was removed:
- ----- Method: MorphicEventDispatcher>>dispatchFocusEventAllOver:with: (in category 'focus events') -----
- dispatchFocusEventAllOver: evt with: focusMorph
- "Like a full event dispatch BUT adds regular dispatch if the focus morph did nothing with the event. This is useful for letting the focusMorph's siblings handle the events instead. Take halo invocation as an example. See senders of me."
-
- | result hand mouseFocus |
- result := self dispatchFocusEventFully: evt with: focusMorph.
-
- evt isMouseOver ifTrue: [^ result].
-
- result == #rejected ifTrue: [^ result].
- result wasIgnored ifTrue: [^ result].
- result wasHandled ifTrue: [^ result].
-
- hand := evt hand.
- mouseFocus := hand mouseFocus.
-
- [
- "Avoid re-dispatching the event to the focus morph. See Morph >> #rejectsEvent:."
- focusMorph lock.
- hand newMouseFocus: nil.
-
- "Give the event's hand a chance to normally dispatch it."
- ^ hand handleEvent: evt
- ] ensure: [
- focusMorph unlock.
- hand newMouseFocus: mouseFocus].!
Item was removed:
- ----- Method: MorphicEventDispatcher>>dispatchFocusEventFully:with: (in category 'focus events') -----
- dispatchFocusEventFully: anEventWithGlobalPosition with: focusMorph
- "Dispatch the given event to the given morph. Do capturing, processing in sub-tree, and bubbling."
-
- | currentEvent |
- "1) Capturing phase."
- currentEvent := self doCapturingForFocusEvent: anEventWithGlobalPosition with: focusMorph.
- currentEvent == #rejected ifTrue: [
- "See implementors of #rejectsEvent:, which is usually based on receiver state and not event state. Thus, reset foci to avoid unresponsive environment."
- anEventWithGlobalPosition hand
- releaseKeyboardFocus: focusMorph;
- releaseMouseFocus: focusMorph.
- ^ #rejected].
- "No need to reset foci here for ignored events because not all events might be ignored. Unlike #rejected."
- currentEvent wasIgnored ifTrue: [^ currentEvent].
-
- "2) Sub-tree processing."
- currentEvent := self doProcessingForFocusEvent: currentEvent with: focusMorph.
- currentEvent wasIgnored ifTrue: [^ currentEvent].
-
- "3) Let the focus morph handle the event. Usually no effect because previous sub-tree processing involved the focus morph already -- at least in the bubbling phase. Skip it?"
- currentEvent := self doHandlingForFocusEvent: currentEvent with: focusMorph.
- currentEvent wasIgnored ifTrue: [^ currentEvent].
-
- "4) Bubbling phase."
- ^ self doBubblingForFocusEvent: currentEvent with: focusMorph!
Item was removed:
- ----- Method: MorphicEventDispatcher>>dispatchMouseDown:with: (in category 'specific') -----
- dispatchMouseDown: anEvent with: aMorph
- "Find the appropriate receiver for the event and let it handle it. When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is."
-
- | handler lastHandler |
-
- "Try to get out quickly"
- anEvent wasIgnored ifTrue: [^anEvent "propagate the ignored event"].
- (aMorph fullBounds containsPoint: anEvent position) ifFalse:[^#rejected].
-
- "In case the mouse wasn't even in the receiver"
- lastHandler := anEvent handler.
-
- "Negotiate and install the actual handler."
- handler := aMorph handlerForMouseDown: anEvent.
- handler ifNotNil: [anEvent handler: handler].
-
- ^[ self
- dispatchEvent: anEvent
- withHandler: handler
- withMorph: aMorph
- ] ensure: [
- anEvent handler: lastHandler. "good style"].!
Item was removed:
- ----- Method: MorphicEventDispatcher>>dispatchWindowEvent:with: (in category 'specific') -----
- dispatchWindowEvent: anEvent with: aMorph
- "Host window events do not have a position and are only dispatched to the World"
-
- anEvent wasIgnored ifTrue: [^anEvent].
- aMorph isWorldMorph ifFalse: [^#rejected].
- anEvent wasHandled ifTrue:[^anEvent].
- ^aMorph handleEvent: anEvent!
Item was removed:
- ----- Method: MorphicEventDispatcher>>doBubblingForFocusEvent:with: (in category 'support') -----
- doBubblingForFocusEvent: anEvent with: focusMorph
- "Simulate real event bubbling up to the focused morph's outermost owner. Applies event bubble filters via Morph >> #handleEvent:. Watch out for coordinate transformations and some globals (ActiveWorld, ...)."
-
- | currentEvent filteredEvent localEvent referenceMorph |
- currentEvent := anEvent.
- referenceMorph := anEvent hand.
-
- focusMorph allOwnersDo: [:ownerMorph |
- ownerMorph == anEvent hand ifFalse: [ "Never bubble up to the hand morph but only up to the world."
- localEvent := currentEvent transformedBy: (ownerMorph transformedFrom: referenceMorph).
- filteredEvent := ownerMorph handleEvent: localEvent.
- currentEvent := self nextFromOriginal: currentEvent local: localEvent filtered: filteredEvent.
- currentEvent wasIgnored ifTrue: [^ currentEvent]]].
-
- ^ currentEvent!
Item was removed:
- ----- Method: MorphicEventDispatcher>>doCapturingForFocusEvent:with: (in category 'support') -----
- doCapturingForFocusEvent: anEvent with: focusMorph
- "Simulate real event capturing down to the focused morph. Apply event capture filters. Watch out for coordinate transformations. Keep the filter-ignore-reject order like in Morph >> #processEvent:using:."
-
- | currentEvent filteredEvent localEvent referenceMorph |
- currentEvent := anEvent.
- referenceMorph := anEvent hand.
-
- "Event capturing. Filters only because the capturing phase was bypassed by using the keyboard/mouse focus."
- focusMorph withAllOwners reverseDo: [:ownerMorph | "reverse order to comply with regular dispatching"
- ownerMorph == anEvent hand ifFalse: [ "Never dispatch the hand morph. It already did so."
- localEvent := currentEvent transformedBy: (ownerMorph transformedFrom: referenceMorph).
-
- filteredEvent := ownerMorph sendFilterEventCapture: localEvent for: ownerMorph.
-
- "Ignoring has higher priority but the reject-check must be with local event coodinates."
- (filteredEvent wasIgnored not and: [ownerMorph rejectsEvent: filteredEvent])
- ifTrue: [^ #rejected].
-
- currentEvent := self nextFromOriginal: currentEvent local: localEvent filtered: filteredEvent.
- currentEvent wasIgnored ifTrue: [^ currentEvent]]].
-
- ^ currentEvent!
Item was removed:
- ----- Method: MorphicEventDispatcher>>doHandlingForFocusEvent:with: (in category 'support') -----
- doHandlingForFocusEvent: currentEvent with: focusMorph
-
- | localEvent filteredEvent |
- localEvent := currentEvent transformedBy: (focusMorph transformedFrom: currentEvent hand).
- filteredEvent := focusMorph handleFocusEvent: localEvent.
- ^ self nextFromOriginal: currentEvent local: localEvent filtered: filteredEvent.!
Item was removed:
- ----- Method: MorphicEventDispatcher>>doProcessingForFocusEvent:with: (in category 'support') -----
- doProcessingForFocusEvent: currentEvent with: focusMorph
- "Sub-tree processing (including capturing from focus morph down to something and bubbling up back to focus morph). Never reject in the end."
-
- | localEvent filteredEvent |
- localEvent := currentEvent transformedBy: (focusMorph transformedFrom: currentEvent hand).
- filteredEvent := focusMorph processEvent: localEvent using: self.
- ^ filteredEvent == #rejected
- ifTrue: [currentEvent] "Can happen if you click, e.g., outside the bounds of the focus morph"
- ifFalse: [self nextFromOriginal: currentEvent local: localEvent filtered: filteredEvent]!
Item was removed:
- ----- Method: MorphicEventDispatcher>>nextFromOriginal:local:filtered: (in category 'support') -----
- nextFromOriginal: originalEvent local: localEvent filtered: filteredEvent
- "Take the filtered event if different but always keep the original coordinates."
-
- filteredEvent == localEvent
- ifTrue: [ "Use original event but keep track of ignored flag."
- localEvent wasHandled ifTrue: [originalEvent copyHandlerState: localEvent].
- originalEvent wasIgnored: localEvent wasIgnored.
- ^ originalEvent]
- ifFalse: [ "There was an event transformation. Copy, revert coordinates, keep handler state."
- | result |
- result := filteredEvent copy. "Never mutate position without copying. MouseClickState etc. will break otherwise."
- result translateTo: originalEvent position. "restore to untransformed coordinates"
- result wasHandled ifFalse: [result copyHandlerState: originalEvent].
- ^ result].
- !
Item was removed:
- Object subclass: #MorphicHaloDispatcher
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!
Item was removed:
- ----- Method: MorphicHaloDispatcher>>dispatchHalo:createFor: (in category 'dispatching') -----
- dispatchHalo: anEvent createFor: aContainer
- "Invoke a halo on any aContainer's submorph that wants it. Dispatch uses anEvent's #position. The dispatch only ends in that container if no other morph wants it. Note that the event's #shiftPressed state determines whether the dispatch goes innermost-to-outermost (if pressed) or the other way around (if not pressed).
-
- If there already is a halo, check whether the event still points into the same hierarchy. If it does, do nothing here but rely on the halo itself to process the event (see implementors of #transferHalo:from:). If, however, the event points to a different hierarchy in the container, invoke a new halo and discard the current one. We do this here because the current halo should not bother with its container but only its #target."
-
- | stack innermost haloTarget |
- "The stack is the frontmost (i.e. innermost) to backmost (i.e. outermost) morph."
- stack := (aContainer morphsAt: anEvent position unlocked: true useFullBounds: true) select:
- [ : each | each wantsHaloFromClick or: [ each isRenderer ] ].
- "self assert: [ stack last == aContainer ]."
- innermost := anEvent hand halo
- ifNil: [ stack first ]
- ifNotNil:
- [ : existingHalo |
- "self assert: [ existingHalo wantsHaloFromClick not ]. "
- stack
- detect: [ : each | each owner == aContainer
- and: [ existingHalo bounds intersects: (existingHalo haloBoundsFor: each) ] ]
- ifFound:
- [ : topInContainer | "Is existingHalo's target part of the same topInContainer as the morph clicked?"
- (existingHalo target withAllOwners includes: topInContainer)
- ifTrue: [ "same hierarchy, let #transferHalo: continue to handle it for now." ^ false ]
- ifFalse:
- [ "different hierarchy, remove + add."
- anEvent hand removeHalo.
- anEvent shiftPressed
- ifTrue: [ stack first ]
- ifFalse: [ topInContainer ] ] ]
- ifNone: [ "existingHalo is on the World, defer to #transferHalo: for now." ^ false ] ].
-
- "If modifier key is pressed, start at innermost (the target), otherwise the outermost (direct child of the world (self))."
- haloTarget := (innermost == aContainer or: [ anEvent shiftPressed ])
- ifTrue: [ innermost ]
- ifFalse:
- [ "Find the outermost owner that wants it. Ignore containment above aContainer."
- stack := innermost withAllOwners.
- (stack first: (stack findFirst: [ : each | each owner == aContainer ])) reversed
- detect: [ : each | each wantsHaloFromClick or: [ each isRenderer ] ]
- ifNone: [ "haloTarget has its own mouseDown handler, don't halo." ^ false ] ].
- "Now that we have the haloTarget, show the halo."
- self invokeHaloOrMove: anEvent on: haloTarget.
- ^ true!
Item was removed:
- ----- Method: MorphicHaloDispatcher>>dispatchHalo:transferFrom: (in category 'dispatching') -----
- dispatchHalo: event transferFrom: morph
- "Progressively transfer the halo to the next likely recipient"
-
- ^ event shiftPressed
- ifTrue: [self dispatchHalo: event transferOutwardsFrom: morph]
- ifFalse: [self dispatchHalo: event transferInwardsFrom: morph]!
Item was removed:
- ----- Method: MorphicHaloDispatcher>>dispatchHalo:transferInwardsFrom: (in category 'dispatching') -----
- dispatchHalo: event transferInwardsFrom: currentTarget
-
- | localEvent world |
- "Note that a halo usually attaches to the outermost (or top) renderer in a composition around the rendered morph. Thus, we have to lookup that inner (or rendered) morph first when transferring the halo inwards in the hierarchy of submorphs."
- currentTarget renderedMorph submorphsDo: [:nextTarget |
- localEvent := event transformedBy: (nextTarget transformedFrom: currentTarget).
- (nextTarget fullContainsPoint: localEvent position) ifTrue: [
- ^ nextTarget renderedMorph wantsHaloFromClick
- ifTrue: [self invokeHalo: localEvent on: nextTarget]
- ifFalse: [self dispatchHalo: localEvent transferInwardsFrom: nextTarget]]].
-
- "We're at the bottom most level; throw the event back up to the root to find recipient"
- event hand removeHalo.
- Preferences maintainHalos ifFalse: [
- (world := currentTarget world) ifNil: [ ^ false ].
- localEvent := event transformedBy: (currentTarget transformedFrom: world) inverseTransformation.
- world processEvent: localEvent resetHandlerFields].
-
- ^ false!
Item was removed:
- ----- Method: MorphicHaloDispatcher>>dispatchHalo:transferOutwardsFrom: (in category 'dispatching') -----
- dispatchHalo: event transferOutwardsFrom: currentTarget
-
- | localEvent |
- "Note that a halo usually handles composite renderers through the outermost (or top) renderer. So, we can directly use the renderer's owner to transfer a halo outwards in the hierarchy of morphs."
- "self assert: [currentTarget == currentTarget topRendererOrSelf]."
- currentTarget owner ifNotNil: [:nextTarget |
- localEvent := event transformedBy: (currentTarget transformedFrom: nextTarget).
- "Never transfer halo to top-most world"
- ^ (nextTarget isWorldMorph not and: [nextTarget wantsHaloFromClick])
- ifTrue: [self invokeHalo: localEvent on: nextTarget]
- ifFalse: [self dispatchHalo: localEvent transferOutwardsFrom: nextTarget]].
-
- "We're at the top level; throw the event back in to find recipient"
- event hand removeHalo.
- currentTarget isWorldMorph
- ifTrue: [currentTarget processEvent: event copy resetHandlerFields].
-
- ^ false!
Item was removed:
- ----- Method: MorphicHaloDispatcher>>dispatchHalo:with: (in category 'dispatching') -----
- dispatchHalo: anEvent with: aMorph
-
- | halo successful |
- halo := anEvent hand halo.
- successful := (halo isNil or: [halo target ~~ aMorph])
- ifTrue: [self dispatchHalo: anEvent createFor: aMorph]
- ifFalse: [self dispatchHalo: anEvent transferFrom: aMorph].
- successful ifTrue: [
- self assert: [halo ~~ anEvent hand halo].
- anEvent hand halo setProperty: #lastHaloDispatcher toValue: self].
- ^ successful!
Item was removed:
- ----- Method: MorphicHaloDispatcher>>invokeHalo:on: (in category 'invoking') -----
- invokeHalo: anEvent on: aMorph
-
- aMorph addHalo: anEvent.
- ^ true!
Item was removed:
- ----- Method: MorphicHaloDispatcher>>invokeHaloOrMove:on: (in category 'invoking') -----
- invokeHaloOrMove: anEvent on: aMorph
- "Special gestures (cmd-mouse on the Macintosh; Alt-mouse on Windows and Unix) allow a mouse-sensitive morph to be moved or bring up a halo for the morph."
- | h doNotDrag |
- anEvent hand newMouseFocus: aMorph event: anEvent.
- h := anEvent hand halo.
- "Prevent wrap around halo transfers originating from throwing the event back in"
- doNotDrag := false.
- h ifNotNil:[
- (h innerTarget == aMorph) ifTrue:[doNotDrag := true].
- (h innerTarget hasOwner: aMorph) ifTrue:[doNotDrag := true].
- (aMorph hasOwner: h target) ifTrue:[doNotDrag := true]].
-
- h := aMorph addHalo: anEvent.
- h setProperty: #lastHaloDispatcher toValue: self.
- doNotDrag ifTrue:[^ true].
- "Initiate drag transition if requested"
- anEvent hand
- waitForClicksOrDrag: h
- event: anEvent
- selectors: { nil. nil. nil. #startDragTarget:. }
- threshold: HandMorph dragThreshold.
- "Pass focus explicitly here"
- anEvent hand newMouseFocus: h.
- "Reset temporary cursors to make available halo interaction visible."
- anEvent hand showTemporaryCursor: nil.
- ^ true!
Item was removed:
- BorderedMorph subclass: #MorphicModel
- instanceVariableNames: 'model slotName open'
- classVariableNames: 'TimeOfError'
- poolDictionaries: ''
- category: 'Morphic-Kernel'!
- MorphicModel class
- instanceVariableNames: 'prototype'!
-
- !MorphicModel commentStamp: '<historical>' prior: 0!
- MorphicModels are used to represent structures with state and behavior as well as graphical structure. A morphicModel is usually the root of a morphic tree depicting its appearance. The tree is constructed concretely by adding its consituent morphs to a world.
-
- When a part is named in a world, it is given a new slot in the model. When a part is sensitized, it is named, and a set of mouse-driven methods is also generated in the model. These may be edited to induce particular behavior. When a variable is added through the morphic world, it is given a slot in the model, along with a set of access methods.
-
- In addition for public variables (and this is the default for now), methods are generated and called in any outer model in which this model gets embedded, thus propagating variable changes outward.!
- MorphicModel class
- instanceVariableNames: 'prototype'!
Item was removed:
- ----- Method: MorphicModel class>>acceptsLoggingOfCompilation (in category 'compiling') -----
- acceptsLoggingOfCompilation
- "Dont log sources for my automatically-generated subclasses. Can easily switch this back when it comes to deal with Versions, etc."
-
- ^super acceptsLoggingOfCompilation
- and:
- [self == MorphicModel
- or:
- [(name last isDigit) not]]!
Item was removed:
- ----- Method: MorphicModel class>>categoryForSubclasses (in category 'compilation') -----
- categoryForSubclasses
- ^ 'Morphic-Models'!
Item was removed:
- ----- Method: MorphicModel class>>chooseNewName (in category 'compilation') -----
- chooseNewName
- "Choose a new name for the receiver, persisting until an acceptable name is provided or until the existing name is resubmitted"
-
- | oldName newName |
- oldName := self name.
- [newName := (UIManager default request: 'Please give this Model a name'
- initialAnswer: oldName) asSymbol.
- newName = oldName ifTrue: [^ self].
- Smalltalk includesKey: newName]
- whileTrue:
- [self inform: 'Sorry, that name is already in use.'].
- self rename: newName.!
Item was removed:
- ----- Method: MorphicModel class>>compileAccessorsFor: (in category 'compilation') -----
- compileAccessorsFor: varName
- self compile: (
- '&var
- "Return the value of &var"
- ^ &var'
- copyReplaceAll: '&var' with: varName)
- classified: 'public access' notifying: nil.
- self compile: (
- '&varPut: newValue
- "Assign newValue to &var.
- Add code below to update related graphics appropriately..."
-
- &var := newValue.'
- copyReplaceAll: '&var' with: varName)
- classified: 'public access' notifying: nil.
- self compile: (
- '&var: newValue
- "Assigns newValue to &var and updates owner"
- &var := newValue.
- self propagate: &var as: ''&var:'''
- copyReplaceAll: '&var' with: varName)
- classified: 'private - propagation' notifying: nil.
- !
Item was removed:
- ----- Method: MorphicModel class>>compilePropagationForVarName:slotName: (in category 'compilation') -----
- compilePropagationForVarName: varName slotName: slotName
- self compile: ((
- '&slot&var: newValue
- "The value of &var in &slot has changed to newValue.
- This value can be read elsewhere in code with
- &slot &var
- and it can be stored into with
- &slot &varPut: someValue"
-
- "Add code for appropriate response here..."'
- copyReplaceAll: '&var' with: varName)
- copyReplaceAll: '&slot' with: slotName)
- classified: 'input events' notifying: nil.
- !
Item was removed:
- ----- Method: MorphicModel class>>hasPrototype (in category 'queries') -----
- hasPrototype
- "Return true if there is a prototype for this morph."
-
- ^ prototype ~~ nil
- !
Item was removed:
- ----- Method: MorphicModel class>>includeInNewMorphMenu (in category 'new-morph participation') -----
- includeInNewMorphMenu
- "Only include Models that are appropriate"
- ^ false!
Item was removed:
- ----- Method: MorphicModel class>>new (in category 'instance creation') -----
- new
- "Return a copy of the prototype, if there is one.
- Otherwise create a new instance normally."
-
- self hasPrototype ifTrue: [^ prototype veryDeepCopy].
- ^ super new
- !
Item was removed:
- ----- Method: MorphicModel class>>newBounds:model:slotName: (in category 'instance creation') -----
- newBounds: bounds model: thang slotName: nameOfThisPart
- ^ (super new model: thang slotName: nameOfThisPart)
- newBounds: bounds!
Item was removed:
- ----- Method: MorphicModel class>>officialClass (in category 'testing') -----
- officialClass
- "We want to make a new instance of the receiver, which is a subclass of MorphicModel. Answer who to make a new subclass of. Also used to tell if a given class is a UniClass, existing only for its single instance."
-
- ^ self name last isDigit ifTrue: [MorphicModel] ifFalse: [self]
- "MorphicModel7 can not have subclasses, but Slider and SystemWindow may"!
Item was removed:
- ----- Method: MorphicModel class>>prototype (in category 'prototype access') -----
- prototype
- "Return the prototype for this morph."
-
- ^ prototype
- !
Item was removed:
- ----- Method: MorphicModel class>>prototype: (in category 'prototype access') -----
- prototype: aMorph
- "Store a copy of the given morph as a prototype to be copied to make new instances."
-
- aMorph ifNil: [prototype := nil. ^ self].
-
- prototype := aMorph veryDeepCopy.
- (prototype isMorphicModel) ifTrue:
- [prototype model: nil slotName: nil].
- !
Item was removed:
- ----- Method: MorphicModel class>>removeUninstantiatedModels (in category 'housekeeping') -----
- removeUninstantiatedModels
- "With the user's permission, remove the classes of any models that have neither instances nor subclasses."
- "MorphicModel removeUninstantiatedModels"
-
- | candidatesForRemoval |
- Smalltalk garbageCollect.
- candidatesForRemoval :=
- MorphicModel subclasses select: [:c |
- (c instanceCount = 0) and: [c subclasses size = 0]].
- candidatesForRemoval do: [:c | | ok |
- ok := self confirm: 'Are you certain that you
- want to delete the class ', c name, '?'.
- ok ifTrue: [c removeFromSystem]].
- !
Item was removed:
- ----- Method: MorphicModel class>>wantsChangeSetLogging (in category 'compiling') -----
- wantsChangeSetLogging
- "Log changes for MorphicModel itself and for things like PlayWithMe2, but not for automatically-created subclasses like MorphicModel1, MorphicModel2, etc."
-
- ^ self == MorphicModel or:
- [(self class name beginsWith: 'Morphic') not]!
Item was removed:
- ----- Method: MorphicModel>>addCustomMenuItems:hand: (in category 'menu') -----
- addCustomMenuItems: aCustomMenu hand: aHandMorph
-
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- model ifNotNil: [model addModelMenuItemsTo: aCustomMenu forMorph: self hand: aHandMorph].
- self isOpen ifTrue: [aCustomMenu add: 'close editing' translated action: #closeToEdits]
- ifFalse: [aCustomMenu add: 'open editing' translated action: #openToEdits].
- !
Item was removed:
- ----- Method: MorphicModel>>addModelYellowButtonMenuItemsTo:forMorph:hand: (in category 'graph model') -----
- addModelYellowButtonMenuItemsTo: aCustomMenu forMorph: aMorph hand: aHandMorph
-
- Preferences noviceMode ifFalse: [
- super addModelYellowButtonMenuItemsTo: aCustomMenu forMorph: aMorph hand: aHandMorph].
- ^ aCustomMenu!
Item was removed:
- ----- Method: MorphicModel>>addPartNameLike:withValue: (in category 'compilation') -----
- addPartNameLike: className withValue: aMorph
- | otherNames i default partName stem |
- stem := className first asLowercase asString , className allButFirst.
- otherNames := self class allInstVarNames.
- i := 1.
- [otherNames includes: (default := stem, i printString)]
- whileTrue: [i := i + 1].
- partName := UIManager default
- request: 'Please give this part a name'
- initialAnswer: default.
- (otherNames includes: partName)
- ifTrue: [self inform: 'Sorry, that name is already used'. ^ nil].
- self class addInstVarName: partName.
- self instVarAt: self class instSize put: aMorph. "Assumes added as last field"
- ^ partName!
Item was removed:
- ----- Method: MorphicModel>>allKnownNames (in category 'submorphs - accessing') -----
- allKnownNames
- "Return a list of all known names based on the scope of the receiver. If the receiver is a member of a uniclass, incorporate the original 1997 logic that queries the known names of the values of all the instance variables."
-
- | superNames |
- superNames := super allKnownNames. "gather them from submorph tree"
- ^self belongsToUniClass
- ifTrue:
- [superNames , (self instanceVariableValues
- select: [:e | e notNil and: [e knownName notNil]]
- thenCollect: [:e | e knownName])]
- ifFalse: [superNames]!
Item was removed:
- ----- Method: MorphicModel>>allowSubmorphExtraction (in category 'drag and drop') -----
- allowSubmorphExtraction
- ^ self isOpen
- !
Item was removed:
- ----- Method: MorphicModel>>charactersOccluded (in category 'geometry') -----
- charactersOccluded
- "Subclasses override as necessary to keep smart-splitters balanced."
- ^ 0!
Item was removed:
- ----- Method: MorphicModel>>choosePartName (in category 'naming') -----
- choosePartName
- "When I am renamed, get a slot, make default methods, move any existing methods. ** Does not clean up old inst var name or methods** "
-
- | old |
- old := slotName.
- super choosePartName.
- slotName ifNil: [^self]. "user chose bad slot name"
- self model: self world model slotName: slotName.
- old isNil
- ifTrue: [self compilePropagationMethods]
- ifFalse: [self copySlotMethodsFrom: old]
- "old ones not erased!!"!
Item was removed:
- ----- Method: MorphicModel>>closeToEdits (in category 'menu') -----
- closeToEdits
- "Disable this morph's ability to add and remove morphs via drag-n-drop."
-
- open := false
- !
Item was removed:
- ----- Method: MorphicModel>>compileAccessForSlot: (in category 'compilation') -----
- compileAccessForSlot: aSlotName
- "Write the method to get at this inst var. "
- "Instead call the right thing to make this happen?"
-
- | s |
- s := WriteStream on: (String new: 2000).
- s nextPutAll: aSlotName; cr; tab; nextPutAll: '^', aSlotName.
- self class
- compile: s contents
- classified: 'public access'
- notifying: nil.
- !
Item was removed:
- ----- Method: MorphicModel>>compilePropagationMethods (in category 'compilation') -----
- compilePropagationMethods
-
- (self class organization listAtCategoryNamed: 'private - propagation' asSymbol)
- do: [:sel | | varName |
- varName := sel allButLast.
- model class compilePropagationForVarName: varName slotName: slotName]!
Item was removed:
- ----- Method: MorphicModel>>defaultBorderColor (in category 'initialization') -----
- defaultBorderColor
- "answer the default border color/fill style for the receiver"
- ^ Color yellow!
Item was removed:
- ----- Method: MorphicModel>>defaultBounds (in category 'initialization') -----
- defaultBounds
- "answer the default bounds for the receiver"
- ^ 0 @ 0 corner: 200 @ 100!
Item was removed:
- ----- Method: MorphicModel>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color transparent!
Item was removed:
- ----- Method: MorphicModel>>delete (in category 'submorphs - add/remove') -----
- delete
- (model isMorphicModel) ifFalse: [^super delete].
- slotName ifNotNil:
- [(UIManager default confirm: 'Shall I remove the slot ' , slotName
- , '
- along with all associated methods?')
- ifTrue:
- [(model class selectors select: [:s | s beginsWith: slotName])
- do: [:s | model class removeSelector: s].
- (model class instVarNames includes: slotName)
- ifTrue: [model class removeInstVarName: slotName]]
- ifFalse:
- [(UIManager default
- confirm: '...but should I at least dismiss this morph?
- [choose no to leave everything unchanged]')
- ifFalse: [^self]]].
- super delete!
Item was removed:
- ----- Method: MorphicModel>>duplicate:from: (in category 'initialization') -----
- duplicate: newGuy from: oldGuy
- "oldGuy has just been duplicated and will stay in this world. Make sure all the MorphicModel requirements are carried out for the copy. Ask user to rename it. "
-
- newGuy installModelIn: oldGuy world.
- newGuy copySlotMethodsFrom: oldGuy slotName.!
Item was removed:
- ----- Method: MorphicModel>>initString (in category 'printing') -----
- initString
-
- ^ String streamContents:
- [:s | s nextPutAll: self class name;
- nextPutAll: ' newBounds: (';
- print: bounds;
- nextPutAll: ') model: self slotName: ';
- print: slotName]!
Item was removed:
- ----- Method: MorphicModel>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
- open := false!
Item was removed:
- ----- Method: MorphicModel>>installModelIn: (in category 'debug and other') -----
- installModelIn: aWorld
-
- self wantsSlot ifFalse: [^ self]. "No real need to install"
- slotName := aWorld model addPartNameLike: self class name withValue: self.
- slotName ifNil: [^ self]. "user chose bad slot name"
- self model: aWorld model slotName: slotName.
- self compilePropagationMethods.
- aWorld model compileAccessForSlot: slotName.
- !
Item was removed:
- ----- Method: MorphicModel>>isMorphicModel (in category 'classification') -----
- isMorphicModel
- ^true!
Item was removed:
- ----- Method: MorphicModel>>isOpen (in category 'drag and drop') -----
- isOpen
- "Support drag/drop and other edits."
- ^ open!
Item was removed:
- ----- Method: MorphicModel>>model (in category 'accessing') -----
- model
- ^ model!
Item was removed:
- ----- Method: MorphicModel>>model: (in category 'initialization') -----
- model: anObject
- "Set my model and make me me a dependent of the given object."
-
- model ifNotNil: [model removeDependent: self].
- anObject ifNotNil: [anObject addDependent: self].
- model := anObject.
- !
Item was removed:
- ----- Method: MorphicModel>>model:slotName: (in category 'initialization') -----
- model: thang slotName: nameOfThisPart
- model := thang.
- slotName := nameOfThisPart.
- open := false.!
Item was removed:
- ----- Method: MorphicModel>>modelOrNil (in category 'accessing') -----
- modelOrNil
- ^ model!
Item was removed:
- ----- Method: MorphicModel>>nameFor: (in category 'compilation') -----
- nameFor: aMorph
- "Return the name of the slot containing the given morph or nil if that morph has not been named."
-
- | allNames start |
- allNames := self class allInstVarNames.
- start := MorphicModel allInstVarNames size + 1.
- start to: allNames size do: [:i |
- (self instVarAt: i) == aMorph ifTrue: [^ allNames at: i]].
- ^ nil
- !
Item was removed:
- ----- Method: MorphicModel>>newBounds: (in category 'geometry') -----
- newBounds: newBounds
- self bounds: newBounds!
Item was removed:
- ----- Method: MorphicModel>>openToEdits (in category 'menu') -----
- openToEdits
- "Enable this morph's ability to add and remove morphs via drag-n-drop."
-
- open := true
- !
Item was removed:
- ----- Method: MorphicModel>>propagate:as: (in category 'compilation') -----
- propagate: value as: partStoreSelector
- model ifNil: [^ self].
- "
- Later we can cache this for more speed as follows...
- (partName == cachedPartName and: [slotName == cachedSlotName])
- ifFalse: [cachedPartName := partName.
- cachedSlotName := slotName.
- cachedStoreSelector := (slotName , partStoreSelector) asSymbol].
- model perform: cachedStoreSelector with: value].
- "
- model perform: (self slotSelectorFor: partStoreSelector) with: value!
Item was removed:
- ----- Method: MorphicModel>>recomputeBounds (in category 'geometry') -----
- recomputeBounds
-
- | bnds |
- bnds := submorphs first bounds.
- bounds := bnds origin corner: bnds corner. "copy it!!"
- fullBounds := nil.
- bounds := self fullBounds.
- !
Item was removed:
- ----- Method: MorphicModel>>releaseCachedState (in category 'caching') -----
- releaseCachedState
- "Release cached state of the receiver"
-
- (model ~~ self and: [model respondsTo: #releaseCachedState]) ifTrue:
- [model releaseCachedState].
- super releaseCachedState!
Item was removed:
- ----- Method: MorphicModel>>removeAll (in category 'compilation') -----
- removeAll
- "Clear out all script methods and subpart instance variables in me. Start over."
- "self removeAll"
- "MorphicModel2 removeAll"
-
- self class == MorphicModel ifTrue: [^ self]. "Must be a subclass!!"
- self class removeCategory: 'scripts'.
- self class instVarNames do: [:nn | self class removeInstVarName: nn].!
Item was removed:
- ----- Method: MorphicModel>>slotName (in category 'accessing') -----
- slotName
- ^ slotName!
Item was removed:
- ----- Method: MorphicModel>>slotSelectorFor: (in category 'compilation') -----
- slotSelectorFor: selectorBody
- | selector |
- model ifNil: [^ nil].
- "Make up selector from slotname if any"
- selector := (slotName ifNil: [selectorBody]
- ifNotNil: [slotName , selectorBody]) asSymbol.
- (model canUnderstand: selector) ifFalse:
- [self halt: 'Compiling a null response for ' , model class name , '>>' , selector].
- ^ selector!
Item was removed:
- ----- Method: MorphicModel>>use:orMakeModelSelectorFor:in: (in category 'compilation') -----
- use: cachedSelector orMakeModelSelectorFor: selectorBody in: selectorBlock
- | selector |
- model ifNil: [^ nil].
- cachedSelector ifNil:
- ["Make up selector from slotname if any"
- selector := (slotName ifNil: [selectorBody]
- ifNotNil: [slotName , selectorBody]) asSymbol.
- (model class canUnderstand: selector) ifFalse:
- [(self confirm: 'Shall I compile a null response for'
- , Character cr asString
- , model class name , '>>' , selector)
- ifFalse: [self halt].
- model class compile: (String streamContents:
- [:s | selector keywords withIndexDo:
- [:k :i | s nextPutAll: k , ' arg' , i printString].
- s cr; nextPutAll: '"Automatically generated null response."'.
- s cr; nextPutAll: '"Add code below for appropriate behavior..."'.])
- classified: 'input events'
- notifying: nil]]
- ifNotNil:
- [selector := cachedSelector].
- ^ selectorBlock value: selector!
Item was removed:
- ----- Method: MorphicModel>>wantsSlot (in category 'accessing') -----
- wantsSlot
- "Override this default for models that want to be installed in theri model"
- ^ false!
Item was removed:
- Project subclass: #MorphicProject
- instanceVariableNames: 'uiProcess'
- classVariableNames: 'DefaultFill UseCompactButtons UseCompactLists UseCompactTextFields'
- poolDictionaries: ''
- category: 'Morphic-Support'!
-
- !MorphicProject commentStamp: 'dtl 7/13/2013 15:40' prior: 0!
- An MorphicProject is a project with a Morphic user interface. Its world is a PasteUpMorph, and its UI manager is a MorphicUIManager. It uses a MorphicToolBuilder to create the views for various tools. It has a single uiProcess for its world, and Morph updates and user interaction occur in the context of that UI process.
- !
Item was removed:
- ----- Method: MorphicProject class>>applyUserInterfaceTheme (in category 'preferences') -----
- applyUserInterfaceTheme
-
- self current addDeferredUIMessage: [
- "After all immediate changes where applied, we can reset to values that match the current world configuration:"
- self worldGridOrigin: nil.
- self worldGridModulus: nil.
- self worldGridEnabled
- ifTrue: [self current world firstHand turnOnGridding]].!
Item was removed:
- ----- Method: MorphicProject class>>compileNewDefaultBackgroundFrom: (in category 'utilities') -----
- compileNewDefaultBackgroundFrom: aForm
- "Compile a new #defaultBackgroundForm method in this class-side which uses aForm as the background."
- | formStream base64 |
- formStream := ByteArray new writeStream.
- PNGReadWriter
- putForm: aForm
- onStream: formStream.
- base64 := formStream base64Encoded.
- self class
- compile:
- (String streamContents:
- [ : stream | stream
- nextPutAll: 'defaultBackgroundForm
- ^ Form fromBinaryStream: ' ;
- nextPut: $' ;
- nextPutAll: base64 ;
- nextPut: $' ;
- nextPutAll: ' base64Decoded asByteArray readStream' ])
- classified: 'class initialization'!
Item was removed:
- ----- Method: MorphicProject class>>convertOldProjects (in category 'class initialization') -----
- convertOldProjects
- "Convert older Morphic projects to be MorphicProjects"
- Project allInstancesDo:[:p|
- p isMorphic ifTrue:[p primitiveChangeClassTo: self basicNew].
- ].!
Item was removed:
- ----- Method: MorphicProject class>>defaultFill (in category 'utilities') -----
- defaultFill
- "Answer the default fill to use for new Morphic Worlds"
- ^DefaultFill ifNil:[Color white].
- !
Item was removed:
- ----- Method: MorphicProject class>>defaultFill: (in category 'utilities') -----
- defaultFill: aFill
- "Answer the default fill to use for new Morphic Worlds"
- DefaultFill := aFill.!
Item was removed:
- ----- Method: MorphicProject class>>initialize (in category 'class initialization') -----
- initialize
- "MorphicProject initialize"
-
- Smalltalk addToShutDownList: self.!
Item was removed:
- ----- Method: MorphicProject class>>openViewAndEnter: (in category 'instance creation') -----
- openViewAndEnter: morphOrList
- "morphOrList has been reconstituted from a file. Open it in an appropriate
- Morphic world."
-
- | contents |
- contents := morphOrList.
- (morphOrList isKindOf: SqueakPage) ifTrue: [
- contents := morphOrList contentsMorph
- ].
- (contents isKindOf: PasteUpMorph) ifFalse:
- [^ self inform: 'This is not a PasteUpMorph or
- exported Project.' translated].
- (self openViewOn: contents) enter
- !
Item was removed:
- ----- Method: MorphicProject class>>openViewOn: (in category 'instance creation') -----
- openViewOn: aPasteUpOrNil
- "Create a new Morphic Project and open a view for the project"
- | newProject |
- newProject := self new.
- aPasteUpOrNil ifNotNil: [newProject installPasteUpAsWorld: aPasteUpOrNil].
- ProjectViewMorph openOn: newProject.
- ^newProject
- !
Item was removed:
- ----- Method: MorphicProject class>>releaseProjectReferences: (in category 'utilities') -----
- releaseProjectReferences: outgoingProject
- "Iterate over all project-view morphs, wherever they may be located. Also consider image segments."
-
- ImageSegment allSubInstancesDo: [:seg |
- seg ifOutPointer: outgoingProject thenAllObjectsDo: [:obj |
- (obj isKindOf: ProjectViewMorph) ifTrue: [
- obj owner isSystemWindow
- ifTrue: [obj owner model: nil; delete].
- obj abandon]]].
-
- ProjectViewMorph allSubInstancesDo: [:p |
- p owner isSystemWindow ifTrue: [p owner model: nil; delete].
- p project == outgoingProject ifTrue: [p abandon]].!
Item was removed:
- ----- Method: MorphicProject class>>shutDown: (in category 'system startup') -----
- shutDown: quitting
-
- Project current isMorphic ifTrue: [
- Project current world submorphsDo: [:ea |
- ea removeProperty: #dropShadow]].!
Item was removed:
- ----- Method: MorphicProject class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ super themeProperties, {
- { #background. 'Colors'. 'Color or fill-style for projects. Use-defined background will not be overwritten.' }.
- }!
Item was removed:
- ----- Method: MorphicProject class>>unload (in category 'class initialization') -----
- unload
-
- Smalltalk removeFromShutDownList: self.!
Item was removed:
- ----- Method: MorphicProject class>>unloadMorphic (in category 'shrinking') -----
- unloadMorphic
- "MorphicProject unloadMorphic"
-
- Project current isMorphic ifTrue: [
- ^ Error signal: 'You can only unload Morphic from within another kind of project.'].
-
- MorphicProject removeProjectsFromSystem.
-
- #(ActiveHand ActiveWorld ActiveEvent World) do: [:ea |
- Smalltalk globals removeKey: ea].
-
- { 'ToolBuilder-Morphic' . 'MorphicTests' . 'MorphicExtras' . 'Morphic' }
- do: [ :package | (MCPackage named: package) unload ].
-
- !
Item was removed:
- ----- Method: MorphicProject class>>useCompactButtons (in category 'preferences - accessibility') -----
- useCompactButtons
- <preference: 'Compact button widgets'
- categoryList: #('Morphic' 'Tools' 'Accessibility')
- description: 'When true, make the buttons only as high as the current button font with the usual extra margins.'
- type: #Boolean>
-
- ^ UseCompactButtons ifNil: [false]!
Item was removed:
- ----- Method: MorphicProject class>>useCompactButtons: (in category 'preferences - accessibility') -----
- useCompactButtons: aBooleanOrNil
-
- UseCompactButtons = aBooleanOrNil ifTrue: [^ self].
- UseCompactButtons := aBooleanOrNil.
-
- " UserInterfaceTheme current basicApply."!
Item was removed:
- ----- Method: MorphicProject class>>useCompactLists (in category 'preferences - accessibility') -----
- useCompactLists
- <preference: 'Compact list/tree/menu widgets'
- categoryList: #('Morphic' 'Tools' 'Accessibility')
- description: 'When true, ignore the #lineGrid of the current list font when computing the list layout and other geometry properties. Does not interfere with the layout of text fields. Also makes the window title more compact.'
- type: #Boolean>
-
- ^ UseCompactLists ifNil: [false]!
Item was removed:
- ----- Method: MorphicProject class>>useCompactLists: (in category 'preferences') -----
- useCompactLists: aBooleanOrNil
-
- UseCompactLists = aBooleanOrNil ifTrue: [^ self].
- UseCompactLists := aBooleanOrNil.
-
- AbstractFont allSubInstancesDo: [:font | font reset "except glyph caches"].
- UserInterfaceTheme current basicApply.!
Item was removed:
- ----- Method: MorphicProject class>>useCompactTextFields (in category 'preferences - accessibility') -----
- useCompactTextFields
- <preference: 'Compact text fields'
- categoryList: #('Morphic' 'Tools' 'Accessibility')
- description: 'When true, do not add extra spacing to better see the current theme''s keyboard-focus indication. Will be mostly noticeable in one-line text fields.'
- type: #Boolean>
-
- ^ UseCompactTextFields ifNil: [false]!
Item was removed:
- ----- Method: MorphicProject class>>useCompactTextFields: (in category 'preferences - accessibility') -----
- useCompactTextFields: aBooleanOrNil
-
- UseCompactTextFields = aBooleanOrNil ifTrue: [^ self].
- UseCompactTextFields := aBooleanOrNil.
-
- "Discard cached margins for text fields."
- MorphicToolBuilder applyUserInterfaceTheme.
- TheWorldMainDockingBar updateInstances.!
Item was removed:
- ----- Method: MorphicProject class>>worldGridEnabled (in category 'preferences') -----
- worldGridEnabled
- <preference: 'Snap Morphs to World Grid'
- categoryList: #('Morphic' 'Tools')
- description: 'When true, morphs placed in the world will align with a regular grid. This includes tool windows.'
- type: #Boolean>
-
- | world |
- world := self current world.
- ^ self current isMorphic and: [world layoutPolicy notNil and: [world layoutPolicy isGridLayout]]!
Item was removed:
- ----- Method: MorphicProject class>>worldGridEnabled: (in category 'preferences') -----
- worldGridEnabled: aBooleanOrNil
-
- (aBooleanOrNil ifNil: [false])
- ifTrue: [self current world layoutPolicy: GridLayout new]
- ifFalse: [self current world layoutPolicy: nil].
-
- "Auto-configure origin and modulus to match world properties."
- self worldGridOrigin: nil.
- self worldGridModulus: nil.
-
- "Snap to grid when dragging something."
- self worldGridEnabled
- ifTrue: [self current world firstHand turnOnGridding]
- ifFalse: [self current world firstHand turnOffGridding].!
Item was removed:
- ----- Method: MorphicProject class>>worldGridModulus (in category 'preferences') -----
- worldGridModulus
- <preference: 'World Grid Modulus'
- categoryList: #('Morphic' 'Tools')
- description: 'Configures the cell extent of the world''s grid, which is useful to accommodate screen resolution and personal style.'
- type: #String>
-
- ^ self current isMorphic
- ifFalse: [0 at 0]
- ifTrue: [self current world gridModulus]!
Item was removed:
- ----- Method: MorphicProject class>>worldGridModulus: (in category 'preferences') -----
- worldGridModulus: aPointOrCode
-
- | value |
- self current isMorphic ifFalse: [^ self].
- value := (aPointOrCode isString ifTrue: [Compiler evaluate: aPointOrCode]) ifNil: [(self current world clearArea width // 60 "num cells") asPoint].
- value isPoint ifFalse: [^ self].
- self current world gridModulus: value.!
Item was removed:
- ----- Method: MorphicProject class>>worldGridOrigin (in category 'preferences') -----
- worldGridOrigin
- <preference: 'World Grid Origin'
- categoryList: #('Morphic' 'Tools')
- description: 'Configures the offset of the world''s grid, which is useful to accommodate docking bars and other edge-adhering morphs.'
- type: #String>
-
- ^ self current isMorphic
- ifFalse: [0 at 0]
- ifTrue: [self current world gridOrigin]!
Item was removed:
- ----- Method: MorphicProject class>>worldGridOrigin: (in category 'preferences') -----
- worldGridOrigin: aPointOrCode
-
- | value |
- self current isMorphic ifFalse: [^ self].
- value := (aPointOrCode isString ifTrue: [Compiler evaluate: aPointOrCode]) ifNil: [self current world clearArea origin].
- value isPoint ifFalse: [^ self].
- self current world gridOrigin: value. !
Item was removed:
- ----- Method: MorphicProject>>acceptProjectDetails: (in category 'file in/out') -----
- acceptProjectDetails: details
- "Store project details back into a property of the world, and if a name is provided, make sure the name is properly installed in the project."
-
- self world setProperty: #ProjectDetails toValue: details.
- details ifNotNil:
- [details
- at: 'projectname'
- ifPresent: [ :newName | self renameTo: newName]]!
Item was removed:
- ----- Method: MorphicProject>>addDeferredUIMessage: (in category 'scheduling & debugging') -----
- addDeferredUIMessage: valuableObject
- "Arrange for valuableObject to be evaluated at a time when the user interface
- is in a coherent state."
-
- self flag: #discuss. "mt: Why are deferred UI messages shared among all Morphic projects? That's not the case for MVC projects..."
- WorldState addDeferredUIMessage: valuableObject!
Item was removed:
- ----- Method: MorphicProject>>addItem:toMenu:selection:color:thumbnail: (in category 'utilities') -----
- addItem: item toMenu: menu selection: action color: aColor thumbnail: aForm
- "Add menu item representing the sender to a menu"
- "Removed setting the color - it wasn't working well with dark color themes."
-
- menu
- add: item
- selector: #jumpToSelection:
- argument: action.
- aForm isNil
- ifFalse: [menu lastItem
- icon: (aForm
- scaledIntoFormOfSize: (Preferences tinyDisplay
- ifTrue: [16]
- ifFalse: [28]))]!
Item was removed:
- ----- Method: MorphicProject>>addProject: (in category 'subprojects') -----
- addProject: project
-
- | view |
- super addProject: project.
-
- view := Preferences projectViewsInWindows
- ifTrue: [ProjectViewMorph newProjectViewInAWindowFor: project]
- ifFalse: [ProjectViewMorph on: project].
-
- "Do not use #openInWorld: because SystemWindow does things with real-estate manager, which depends on too much global state."
- self world
- addMorph: view;
- startSteppingSubmorphsOf: view.!
Item was removed:
- ----- Method: MorphicProject>>applyUserInterfaceTheme (in category 'updating') -----
- applyUserInterfaceTheme
-
- super applyUserInterfaceTheme.
- self setWorldBackground: false.!
Item was removed:
- ----- Method: MorphicProject>>armsLengthCommand:withDescription: (in category 'file in/out') -----
- armsLengthCommand: aCommand withDescription: aString
- | tempProject foolingForm tempCanvas bbox crossHatchColor stride |
- "Set things up so that this aCommand is sent to self as a message
- after jumping to the parentProject. For things that can't be executed
- while in this project, such as saveAs, loadFromServer, storeOnServer. See
- ProjectViewMorph step."
-
- world borderWidth: 0. "get rid of the silly default border"
- tempProject := MorphicProject new.
- foolingForm := world imageForm. "make them think they never left"
- tempCanvas := foolingForm getCanvas.
- bbox := foolingForm boundingBox.
- crossHatchColor := Color yellow alpha: 0.3.
- stride := 20.
- 10 to: bbox width by: stride do: [ :x |
- tempCanvas fillRectangle: (x at 0 extent: 1 at bbox height) fillStyle: crossHatchColor.
- ].
- 10 to: bbox height by: stride do: [ :y |
- tempCanvas fillRectangle: (0 at y extent: bbox width at 1) fillStyle: crossHatchColor.
- ].
-
- tempProject world color: (InfiniteForm with: foolingForm).
- tempProject projectParameters
- at: #armsLengthCmd
- put: (
- DoCommandOnceMorph new
- addText: aString;
- actionBlock: [
- self doArmsLengthCommand: aCommand.
- ]
- ).
- tempProject projectParameters
- at: #deleteWhenEnteringNewProject
- put: true.
- tempProject enter
- !
Item was removed:
- ----- Method: MorphicProject>>assureFlapIntegrity (in category 'flaps support') -----
- assureFlapIntegrity
- "Make certain that the items on the disabled-global-flap list are actually global flaps, and if not, get rid of them. Also, old (and damaging) parameters that held references to actual disabled flaps are cleansed"
-
- | disabledFlapIDs currentGlobalIDs oldList |
- disabledFlapIDs := self parameterAt: #disabledGlobalFlapIDs ifAbsent: [Set new].
- currentGlobalIDs := Flaps globalFlapTabsIfAny collect: [:f | f flapID].
- oldList := Project current projectParameterAt: #disabledGlobalFlaps ifAbsent: [nil].
- oldList ifNotNil:
- [disabledFlapIDs := oldList collect: [:aFlap | aFlap flapID].
- disabledFlapIDs addAll: {'Scripting' translated. 'Stack Tools' translated. 'Painting' translated}].
- disabledFlapIDs := disabledFlapIDs select: [:anID | currentGlobalIDs includes: anID].
- self projectParameterAt: #disabledGlobalFlapIDs put: disabledFlapIDs asSet.
- self assureNavigatorPresenceMatchesPreference.
-
- projectParameters ifNotNil:
- [projectParameters removeKey: #disabledGlobalFlaps ifAbsent: []]!
Item was removed:
- ----- Method: MorphicProject>>assureMainDockingBarPresenceMatchesPreference (in category 'docking bars support') -----
- assureMainDockingBarPresenceMatchesPreference
- "Synchronize the state of the receiver's dockings with the
- preference"
- (self showWorldMainDockingBar)
- ifTrue: [self createOrUpdateMainDockingBar]
- ifFalse: [self removeMainDockingBar]!
Item was removed:
- ----- Method: MorphicProject>>assureNavigatorPresenceMatchesPreference (in category 'menu messages') -----
- assureNavigatorPresenceMatchesPreference
- "Make sure that the current project conforms to the presence/absence of the navigator"
-
- | navigator navType wantIt |
- wantIt := Preferences classicNavigatorEnabled and: [Preferences showProjectNavigator].
- navType := ProjectNavigationMorph preferredNavigator.
- navigator := world findA: navType.
- wantIt
- ifFalse:
- [navigator ifNotNil: [navigator delete]]
- ifTrue:
- [navigator isNil ifTrue:
- [(navigator := navType new)
- bottomLeft: world bottomLeft;
- openInWorld: world]]!
Item was removed:
- ----- Method: MorphicProject>>bitEdit: (in category 'editors') -----
- bitEdit: aForm
- "Create and schedule a view located in an area designated by the user
- that contains a view of the receiver magnified by 8 at 8 that can be
- modified using the Bit Editor. It also contains a view of the original
- form."
-
- aForm currentHand attachMorph: (FatBitsPaint new editForm: aForm;
- magnification: 8;
- brushColor: Color black;
- penSize: 1;
- yourself)
- !
Item was removed:
- ----- Method: MorphicProject>>bitEdit:at:scale: (in category 'editors') -----
- bitEdit: aForm at: magnifiedFormLocation scale: scaleFactor
- "Create and schedule a view whose top left corner is magnifiedLocation
- and that contains a view of aForm magnified by scaleFactor that can be
- modified using the Bit Editor. It also contains a view of the original form."
-
- self inform: 'A Morphic editor has not been implemented. Enter an MVC project to edit this form.'!
Item was removed:
- ----- Method: MorphicProject>>canApplyUserInterfaceTheme (in category 'updating') -----
- canApplyUserInterfaceTheme
-
- ^ world notNil!
Item was removed:
- ----- Method: MorphicProject>>chooseNaturalLanguage (in category 'language') -----
- chooseNaturalLanguage
- "Put up a menu allowing the user to choose the natural language for the project"
-
- | aMenu availableLanguages |
- aMenu := MenuMorph new defaultTarget: self.
- aMenu addTitle: 'choose language' translated.
- aMenu lastItem setBalloonText: 'This controls the human language in which tiles should be viewed. It is potentially extensible to be a true localization mechanism, but initially it only works in the classic tile scripting system. Each project has its own private language choice' translated.
- Preferences noviceMode
- ifFalse:[aMenu addStayUpItem].
-
- availableLanguages := NaturalLanguageTranslator availableLanguageLocaleIDs
- sorted:[:x :y | x displayName < y displayName].
-
- availableLanguages do:
- [:localeID |
- aMenu addUpdating: #stringForLanguageNameIs: target: Locale selector: #switchToID: argumentList: {localeID}].
- aMenu popUpInWorld
-
- "Project current chooseNaturalLanguage"!
Item was removed:
- ----- Method: MorphicProject>>cleanseDisabledGlobalFlapIDsList (in category 'flaps support') -----
- cleanseDisabledGlobalFlapIDsList
- "Make certain that the items on the disabled-global-flap list are actually global flaps, and if not, get rid of them"
-
- | disabledFlapIDs currentGlobalIDs oldList |
- disabledFlapIDs := self parameterAt: #disabledGlobalFlapIDs ifAbsent: [Set new].
- currentGlobalIDs := Flaps globalFlapTabsIfAny collect: [:f | f flapID].
- oldList := Project current projectParameterAt: #disabledGlobalFlaps ifAbsent: [nil].
- oldList ifNotNil:
- [disabledFlapIDs := oldList select: [:aFlap | aFlap flapID]].
- disabledFlapIDs := disabledFlapIDs select: [:anID | currentGlobalIDs includes: anID].
- self projectParameterAt: #disabledGlobalFlapIDs put: disabledFlapIDs.
-
- self removeParameter: #disabledGlobalFlaps.
- !
Item was removed:
- ----- Method: MorphicProject>>clearGlobalState (in category 'enter') -----
- clearGlobalState
- "Clean up global state. This method may be removed if the use of global state variables is eliminated."
-
- "If global World is defined, clear it now. The value is expected to be set again as a new project is entered."
- Smalltalk globals at: #World ifPresent: [:w |
- Smalltalk globals at: #World put: nil].!
Item was removed:
- ----- Method: MorphicProject>>color (in category 'accessing') -----
- color
-
- ^ self world isInMemory
- ifTrue: [Color black]
- ifFalse: [Color brown]!
Item was removed:
- ----- Method: MorphicProject>>composeDisplayTextIntoForm: (in category 'utilities') -----
- composeDisplayTextIntoForm: displayText
-
- | tmpText canvas |
- tmpText := TextMorph new contentsAsIs: displayText text deepCopy.
- displayText foregroundColor ifNotNil: [:color |
- tmpText text addAttribute: (TextColor color: color)].
- displayText backgroundColor ifNotNil: [:color |
- tmpText backgroundColor: color].
- tmpText setTextStyle: displayText textStyle.
- canvas := FormCanvas on: (Form extent: tmpText extent depth: 32).
- tmpText drawOn: canvas.
- ^ canvas form!
Item was removed:
- ----- Method: MorphicProject>>compressFilesIn:to:in: (in category 'file in/out') -----
- compressFilesIn: tempDir to: localName in: localDirectory
- "Compress all the files in tempDir making up a zip file in localDirectory named localName"
-
- | archive archiveName entry fileNames |
- archive := ZipArchive new.
- fileNames := tempDir fileNames.
- (fileNames includes: 'manifest')
- ifTrue: [fileNames := #('manifest'), (fileNames copyWithout: 'manifest')].
- fileNames do:[:fn|
- archiveName := fn.
- entry := archive addFile: (tempDir fullNameFor: fn) as: archiveName.
- entry desiredCompressionMethod: (
- fn = 'manifest'
- ifTrue: [ZipArchive compressionLevelNone]
- ifFalse: [ZipArchive compressionDeflated]).
- ].
- archive writeToFileNamed: (localDirectory fullNameFor: localName).
- archive close.
- tempDir fileNames do:[:fn|
- tempDir deleteFileNamed: fn ifAbsent:[]].
- localDirectory deleteDirectory: tempDir localName.!
Item was removed:
- ----- Method: MorphicProject>>compressFilesIn:to:in:resources: (in category 'file in/out') -----
- compressFilesIn: tempDir to: localName in: localDirectory resources: collector
- "Compress all the files in tempDir making up a zip file in localDirectory named localName"
- | archive urlMap |
- urlMap := Dictionary new.
- collector locatorsDo:[:loc|
- "map local file names to urls"
- urlMap at: (tempDir localNameFor: loc localFileName) put: loc urlString.
- ResourceManager cacheResource: loc urlString inArchive: localName].
- archive := ZipArchive new.
- tempDir fileNames do:[:fn| | archiveName entry |
- archiveName := urlMap at: fn ifAbsent:[fn].
- entry := archive addFile: (tempDir fullNameFor: fn) as: archiveName.
- entry desiredCompressionMethod: ZipArchive compressionStored.
- ].
- archive writeToFileNamed: (localDirectory fullNameFor: localName).
- archive close.
- tempDir fileNames do:[:fn|
- tempDir deleteFileNamed: fn ifAbsent:[]].
- localDirectory deleteDirectory: tempDir localName.!
Item was removed:
- ----- Method: MorphicProject>>createOrUpdateMainDockingBar (in category 'docking bars support') -----
- createOrUpdateMainDockingBar
- "Private - create a new main docking bar or update the current one"
- | w mainDockingBars |
- w := self world.
- mainDockingBars := w mainDockingBars.
- mainDockingBars isEmpty ifTrue:
- [ "no docking bar, just create a new one"
- self dockingBar createDockingBar
- openInWorld: w .
- ^ self ].
- "update if needed"
- mainDockingBars do:
- [ : each | self dockingBar updateIfNeeded: each ]!
Item was removed:
- ----- Method: MorphicProject>>createViewIfAppropriate (in category 'utilities') -----
- createViewIfAppropriate
- "Create a project view for the receiver and place it appropriately on the screen."
-
- | aMorph requiredWidth existing proposedV proposedH despair |
- ProjectViewOpenNotification signal ifTrue:
- [Preferences projectViewsInWindows
- ifTrue:
- [(ProjectViewMorph newProjectViewInAWindowFor: self) openInWorld]
- ifFalse:
- [aMorph := ProjectViewMorph on: self.
- requiredWidth := aMorph width + 10.
- existing := self currentWorld submorphs
- select: [:m | m isKindOf: ProjectViewMorph]
- thenCollect: [:m | m fullBoundsInWorld].
- proposedV := 85.
- proposedH := 10.
- despair := false.
- [despair not and: [((proposedH @ proposedV) extent: requiredWidth) intersectsAny: existing]] whileTrue:
- [proposedH := proposedH + requiredWidth.
- proposedH + requiredWidth > self currentWorld right ifTrue:
- [proposedH := 10.
- proposedV := proposedV + 90.
- proposedV > (self currentWorld bottom - 90)
- ifTrue:
- [proposedH := self currentWorld center x - 45.
- proposedV := self currentWorld center y - 30.
- despair := true]]].
- aMorph position: (proposedH @ proposedV).
- aMorph openInWorld]]!
Item was removed:
- ----- Method: MorphicProject>>currentVocabulary (in category 'protocols') -----
- currentVocabulary
-
- ^ self world currentVocabulary!
Item was removed:
- ----- Method: MorphicProject>>debuggerClass (in category 'scheduling & debugging') -----
- debuggerClass
-
- ^ Smalltalk classNamed: #MorphicDebugger!
Item was removed:
- ----- Method: MorphicProject>>deletingProject: (in category 'release') -----
- deletingProject: outgoingProject
-
- (self world submorphs
- select: [:m | m isSystemWindow and: [m model == outgoingProject]]
- thenCollect: [:window | window paneMorphs first])
- do: [:projectViewMorph |
- projectViewMorph owner "window" model: nil; delete.
- projectViewMorph abandon].
-
- super deletingProject: outgoingProject.!
Item was removed:
- ----- Method: MorphicProject>>displayScaleChangedFrom:to: (in category 'display') -----
- displayScaleChangedFrom: oldFactor to: newFactor
- "Update Morphic-specific geometry. Try to be more efficient than UI theme's #applyUserInterfaceTheme."
-
- super displayScaleChangedFrom: oldFactor to: newFactor.
-
- "Switching UI themes involves updating geometry for different fonts anyway. Maybe we can speed up this at some point by avoiding to refresh non-geometry properties such as colors."
- UserInterfaceTheme current
- basicApply;
- scaleMorphicWorldBy: newFactor / oldFactor;
- scaleMorphicToolsBy: newFactor / oldFactor.
- !
Item was removed:
- ----- Method: MorphicProject>>displayTranscripter: (in category 'transcripter') -----
- displayTranscripter: transcripter
- "A transcripter is a minimal user interface to support an emergency evaluator.
- A Morphic project uses class NewParagraph."
- transcripter morphicDisplayText!
Item was removed:
- ----- Method: MorphicProject>>do:withProgressInfoOn:label: (in category 'utilities') -----
- do: aBlock withProgressInfoOn: aMorphOrNil label: aString
- "Evaluate aBlock with a labeled progress bar"
-
- ComplexProgressIndicator new
- targetMorph: aMorphOrNil;
- historyCategory: aString;
- withProgressDo: aBlock
- !
Item was removed:
- ----- Method: MorphicProject>>dockingBar (in category 'docking bars support') -----
- dockingBar
- ^ self
- projectParameterAt: #dockingBar
- ifAbsent: [ TheWorldMainDockingBar instance ]!
Item was removed:
- ----- Method: MorphicProject>>dockingBar: (in category 'docking bars support') -----
- dockingBar: aTheWorldMainDockingBar
- self
- projectParameterAt: #dockingBar
- put: aTheWorldMainDockingBar.
- self isCurrentProject ifTrue: [ TheWorldMainDockingBar instance: aTheWorldMainDockingBar ]!
Item was removed:
- ----- Method: MorphicProject>>editCharacter:ofFont: (in category 'editors') -----
- editCharacter: character ofFont: strikeFont
- "Open a bit editor on a character in the given strike font."
- "Note that BitEditor only works in MVC currently."
-
- "(TextStyle default fontAt: 1) edit: $="
-
- self inform: 'A Morphic editor has not been implemented. Enter an MVC project to edit this font.'!
Item was removed:
- ----- Method: MorphicProject>>enableDisableGlobalFlap: (in category 'flaps support') -----
- enableDisableGlobalFlap: aFlapTab
- "For the benefit of pre-existing which-global-flap buttons from a design now left behind."
-
- self flag: #toRemove.
- ^ self inform:
- 'Sorry, this is an obsolete menu; please
- dismiss it and get a fresh menu. Thanks.'.!
Item was removed:
- ----- Method: MorphicProject>>enterAsActiveSubprojectWithin: (in category 'enter') -----
- enterAsActiveSubprojectWithin: enclosingWorld
-
- "Install my ChangeSet, Transcript, and scheduled views as current globals.
-
- If returningFlag is true, we will return to the project from whence the current project was entered; don't change its previousProject link in this case.
- If saveForRevert is true, save the ImageSegment of the project being left.
- If revertFlag is true, make stubs for the world of the project being left.
- If revertWithoutAsking is true in the project being left, then always revert."
-
- "Experimental mods for initial multi-project work:
- 1. assume in morphic (this eliminated need for <showZoom>)
- 2. assume <saveForRevert> is false (usual case) - removed <old>
- 3. assume <revertFlag> is false
- 4. assume <revertWithoutAsking> is false - <forceRevert> now auto false <seg> n.u.
- 5. no zooming
- 6. assume <projectsSentToDisk> false - could be dangerous here
- 7. assume no isolation problems (isolationHead ==)
- 8. no closing scripts
- "
-
- self isCurrentProject ifTrue: [^ self].
-
- "guards ifNotNil: [
- guards := guards reject: [:obj | obj isNil].
- guards do: [:obj | obj okayToEnterProject ifFalse: [^ self]]
- ]."
-
- "CurrentProject makeThumbnail."
- "--> Display bestGuessOfCurrentWorld triggerClosingScripts."
- CurrentProject displayDepth: Display depth.
-
- displayDepth == nil ifTrue: [displayDepth := Display depth].
- "Display newDepthNoRestore: displayDepth."
-
- "(world hasProperty: #letTheMusicPlay)
- ifTrue: [world removeProperty: #letTheMusicPlay]
- ifFalse: [Smalltalk at: #ScorePlayer ifPresent: [:playerClass |
- playerClass allSubInstancesDo: [:player | player pause]]]."
-
- "returningFlag
- ifTrue: [nextProject := CurrentProject]
- ifFalse: [previousProject := CurrentProject]."
-
- "CurrentProject saveState."
- "CurrentProject := self."
- "Smalltalk newChanges: changeSet."
- "TranscriptStream newTranscript: transcript."
- "Sensor flushKeyboard."
- "recorderOrNil := Display pauseMorphicEventRecorder."
-
- "Display changeMorphicWorldTo: world." "Signifies Morphic"
- world
- installAsActiveSubprojectIn: enclosingWorld
- titled: self name.
-
- "recorderOrNil ifNotNil: [recorderOrNil resumeIn: world]."
- world triggerOpeningScripts.
- self removeParameter: #exportState.
- "self spawnNewProcessAndTerminateOld: true"!
Item was removed:
- ----- Method: MorphicProject>>enterIfThereOrFind: (in category 'squeaklet on server') -----
- enterIfThereOrFind: aProjectName
-
- | newProject |
- newProject := Project named: aProjectName.
- newProject ifNotNil: [^newProject enter].
-
- ComplexProgressIndicator new
- targetMorph: nil;
- historyCategory: 'project loading';
- withProgressDo: [
- [
- newProject := self fromMyServerLoad: aProjectName
- ]
- on: ProjectViewOpenNotification
- do: [ :ex | ex resume: false]
- "we probably don't want a project view morph in this case"
- ].
-
- newProject ifNotNil: [^newProject enter].
- Beeper beep.!
Item was removed:
- ----- Method: MorphicProject>>exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction: (in category 'file in/out') -----
- exportSegmentInSexpWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory withoutInteraction: noInteraction
-
- | fd sexp actualName |
-
- world ifNil: [^ false].
- world presenter ifNil: [^ false].
- (world respondsTo: #sissScanObjectsAsEtoysProject) ifFalse: [^ false].
-
- Command initialize.
- world clearCommandHistory.
- world cleanseStepList.
- world localFlapTabs size = world flapTabs size ifFalse: [
- noInteraction ifTrue: [^ false].
- self error: 'Still holding onto Global flaps'].
-
- fd := aDirectory directoryNamed: self resourceDirectoryName.
- fd assureExistence.
-
- "Must activate old world because this is run at #armsLength.
- Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent
- will not be captured correctly if referenced from blocks or user code."
- world becomeActiveDuring:[
- sexp := world sissScanObjectsAsEtoysProject.
- ].
- (aFileName endsWith: '.pr') ifTrue: [
- actualName := (aFileName copyFrom: 1 to: aFileName size - 3), '.sexp'.
- ] ifFalse: [
- actualName := aFileName
- ].
-
- self
- writeForExportInSexp: sexp withSources: actualName
- inDirectory: fd
- changeSet: aChangeSetOrNil.
- SecurityManager default signFile: actualName directory: fd.
- self storeHtmlPageIn: fd.
- (world valueOfProperty: #ProjectDetails ifAbsent: [Dictionary new])
- at: 'Project-Format' put: 'S-Expression'.
- self storeManifestFileIn: fd.
- self compressFilesIn: fd to: aFileName in: aDirectory.
-
- ^ true
- !
Item was removed:
- ----- Method: MorphicProject>>exportSegmentWithChangeSet:fileName:directory: (in category 'file in/out') -----
- exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName
- directory: aDirectory
-
- ^ self exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory withoutInteraction: false!
Item was removed:
- ----- Method: MorphicProject>>exportSegmentWithChangeSet:fileName:directory:withoutInteraction: (in category 'file in/out') -----
- exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName
- directory: aDirectory withoutInteraction: noInteraction
- "Store my project out on the disk as an *exported*
- ImageSegment. All outPointers will be in a form that can be resolved
- in the target image. Name it <project name>.extSeg. Whatdo we do
- about subProjects, especially if they are out as local image
- segments? Force them to come in?
- Player classes are included automatically."
-
- | is str ans revertSeg roots holder collector fd mgr stacks |
-
- "Files out a changeSet first, so that a project can contain
- its own classes"
- world ifNil: [^ false].
- world presenter ifNil: [^ false].
-
- ScrapBook default emptyScrapBook.
- (world respondsTo: #cleanUpReferences) ifTrue:
- [world cleanUpReferences].
- world currentHand pasteBuffer: nil. "don't write the paste buffer."
- world currentHand mouseOverHandler initialize. "forget about any
- references here"
- "Display checkCurrentHandForObjectToPaste."
- Command initialize.
- world clearCommandHistory.
- world fullReleaseCachedState; releaseViewers.
- world cleanseStepList.
- world localFlapTabs size = world flapTabs size ifFalse:
- [noInteraction ifTrue: [^ false].
- self error: 'Still holding onto Global flaps'].
- world releaseSqueakPages.
- Smalltalk
- at: #ScriptEditorMorph
- ifPresent:
- [:s |
- s writingUniversalTiles: (self projectParameterAt: #universalTiles ifAbsent: [false])].
- holder := Project allProjects. "force them in to outPointers, where
- DiskProxys are made"
-
- "Just export me, not my previous version"
- revertSeg := self parameterAt: #revertToMe.
- self removeParameter: #revertToMe.
-
- roots := OrderedCollection new.
- roots
- add: self;
- add: world;
- add: transcript;
- add: aChangeSetOrNil;
- add: thumbnail;
- add: world activeHand.
-
- roots := roots reject: [ :x | x isNil]. "early saves may not have active hand or thumbnail"
-
- fd := aDirectory directoryNamed: self resourceDirectoryName.
- fd assureExistence.
- "Clean up resource references before writing out"
- mgr := self resourceManager.
- self resourceManager: nil.
- ResourceCollector current: ResourceCollector new.
- ResourceCollector current localDirectory: fd.
- ResourceCollector current baseUrl: self resourceUrl.
- ResourceCollector current initializeFrom: mgr.
- ProgressNotification signal: '2:findingResources' extra:
- '(collecting resources...)' translated.
- "Must activate old world because this is run at #armsLength.
- Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent
- will not be captured correctly if referenced from blocks or user code."
- world becomeActiveDuring:
- [is := ImageSegment copySmartRootsExport: roots asArray.
- "old way was (is := ImageSegment new copyFromRootsForExport: roots asArray)"].
- self resourceManager: mgr.
- collector := ResourceCollector current.
- ResourceCollector current: nil.
- ProgressNotification signal: '2:foundResources' extra: ''.
- is state = #tooBig ifTrue:
- [collector replaceAll.
- ^ false].
-
- str := ''.
- "considered legal to save a project that has never been entered"
- (is outPointers includes: world) ifTrue:
- [str := str, '\Project''s own world is not in the segment.' translated withCRs].
- str isEmpty ifFalse:
- [ans := Project uiManager
- chooseOptionFrom:
- {'Do not write file' translated.
- 'Write file anyway' translated.
- 'Debug' translated}
- title: str.
- ans = 1 ifTrue:
- [revertSeg ifNotNil:
- [projectParameters at: #revertToMe put: revertSeg].
- collector replaceAll.
- ^ false].
- ans = 3 ifTrue:
- [collector replaceAll.
- self halt: 'Segment not written' translated]].
- stacks := is findStacks.
-
- is
- writeForExportWithSources: aFileName
- inDirectory: fd
- changeSet: aChangeSetOrNil.
- SecurityManager default signFile: aFileName directory: fd.
- "Compress all files and update check sums"
- collector forgetObsolete.
- self storeResourceList: collector in: fd.
- self storeHtmlPageIn: fd.
- self storeManifestFileIn: fd.
- self writeStackText: stacks in: fd registerIn: collector.
- "local proj.005.myStack.t"
- self
- compressFilesIn: fd
- to: aFileName
- in: aDirectory
- resources: collector.
- "also deletes the resource directory"
- "Now update everything that we know about"
- mgr updateResourcesFrom: collector.
-
- revertSeg ifNotNil:
- [projectParameters at: #revertToMe put: revertSeg].
- collector replaceAll.
- world flapTabs do:
- [:ft |
- (ft respondsTo: #unhibernate) ifTrue:
- [ft unhibernate]].
- is arrayOfRoots do:
- [:obj |
- obj isScriptEditorMorph ifTrue:
- [obj unhibernate]].
- ^ true
- !
Item was removed:
- ----- Method: MorphicProject>>fatalDrawingError: (in category 'scheduling & debugging') -----
- fatalDrawingError: errMsg
- "Morphic drawing failed and could not be recovered. So we end up here."
-
- self primitiveError: errMsg.
-
- "Hm... we should jump into a 'safe' worldState here, but how do we find it?!!"!
Item was removed:
- ----- Method: MorphicProject>>finalEnterActions: (in category 'enter') -----
- finalEnterActions: leavingProject
- "Perform the final actions necessary as the receiver project is entered"
-
- | navigator armsLengthCmd navType thingsToUnhibernate |
- "If this image has a global World variable, update it now"
- Smalltalk globals at: #World
- ifPresent: [ :w | Smalltalk globals at: #World put: world ].
- world install.
- world transferRemoteServerFrom: leavingProject world.
- "(revertFlag | saveForRevert | forceRevert) ifFalse: [
- (Preferences valueOfFlag: #projectsSentToDisk) ifTrue: [
- self storeSomeSegment]]."
-
- "Transfer event recorder to me."
- leavingProject isMorphic ifTrue: [
- leavingProject world pauseEventRecorder ifNotNil: [:rec |
- rec resumeIn: world]].
-
- world triggerOpeningScripts.
-
-
- self initializeMenus.
- self projectParameters
- at: #projectsToBeDeleted
- ifPresent: [ :projectsToBeDeleted |
- self removeParameter: #projectsToBeDeleted.
- projectsToBeDeleted do: [:each | each delete]].
-
- Locale switchToID: self localeID.
-
- thingsToUnhibernate := world valueOfProperty: #thingsToUnhibernate ifAbsent: [#()].
- thingsToUnhibernate do: [:each | each unhibernate].
- world removeProperty: #thingsToUnhibernate.
-
- navType := ProjectNavigationMorph preferredNavigator.
- armsLengthCmd := self parameterAt: #armsLengthCmd ifAbsent: [nil].
- navigator := world findA: navType.
- (Preferences classicNavigatorEnabled and: [Preferences showProjectNavigator and: [navigator isNil]]) ifTrue:
- [(navigator := navType new)
- bottomLeft: world bottomLeft;
- openInWorld: world].
- navigator notNil & armsLengthCmd notNil ifTrue:
- [navigator color: Color lightBlue].
- armsLengthCmd notNil ifTrue:
- [Preferences showFlapsWhenPublishing
- ifFalse:
- [self flapsSuppressed: true.
- navigator ifNotNil: [navigator visible: false]].
- armsLengthCmd openInWorld: world].
- world reformulateUpdatingMenus.
- world presenter positionStandardPlayer.
- self assureMainDockingBarPresenceMatchesPreference.
-
- world repairEmbeddedWorlds.!
Item was removed:
- ----- Method: MorphicProject>>finalExitActions: (in category 'enter') -----
- finalExitActions: enteringProject
-
- world triggerClosingScripts.
-
- "Pause sound players, subject to preference settings"
- (world hasProperty: #letTheMusicPlay)
- ifTrue: [world removeProperty: #letTheMusicPlay]
- ifFalse: [SoundService stop].
-
- world sleep.
-
- (world findA: ProjectNavigationMorph)
- ifNotNil: [:navigator | navigator retractIfAppropriate].
-
- self clearGlobalState.
- EventSensor default flushEvents.
-
- self world submorphsDo: [:ea | ea removeProperty: #dropShadow].!
Item was removed:
- ----- Method: MorphicProject>>findAFolderForProject:label: (in category 'utilities') -----
- findAFolderForProject: aProject label: dialogLabel
- "Find a folder for saving or loading a project"
-
- ^DirectoryChooserDialog findAFolderForProject: aProject label: dialogLabel
- !
Item was removed:
- ----- Method: MorphicProject>>findProjectView: (in category 'utilities') -----
- findProjectView: projectDescription
- "In this world, find the morph that holds onto the project described by projectDescription.
- projectDescription can be a project, or the name of a project. The project may be
- represented by a DiskProxy. The holder morph may be at any depth in the world.."
-
- | pName |
- pName := (projectDescription isString)
- ifTrue: [projectDescription]
- ifFalse: [projectDescription name].
- world allMorphsDo: [:pvm | | dpName |
- pvm class == ProjectViewMorph ifTrue: [
- (pvm project class == Project and:
- [pvm project name = pName]) ifTrue: [^ pvm].
- pvm project class == DiskProxy ifTrue: [
- dpName := pvm project constructorArgs first.
- dpName := (dpName findTokens: '/') last.
- dpName := (Project parseProjectFileName: dpName unescapePercents) first.
- dpName = pName ifTrue: [^ pvm]]]].
- ^ nil!
Item was removed:
- ----- Method: MorphicProject>>flapsSuppressed: (in category 'flaps support') -----
- flapsSuppressed: aBoolean
- "Make the setting of the flag that governs whether global flaps are suppressed in the project be as indicated and add or remove the actual flaps"
-
- super flapsSuppressed: aBoolean.
- self == Project current
- ifFalse: "Anomalous case where this project is not the current one."
- [aBoolean
- ifTrue:
- [Flaps globalFlapTabsIfAny do:
- [:aFlapTab | Flaps removeFlapTab: aFlapTab keepInList: true]]
-
- ifFalse:
- [Smalltalk isMorphic ifTrue:
- [self currentWorld addGlobalFlaps]]].
- Project current assureNavigatorPresenceMatchesPreference!
Item was removed:
- ----- Method: MorphicProject>>formEdit: (in category 'editors') -----
- formEdit: aForm
- "Start up an instance of the form editor on a form."
-
- self inform: 'A Morphic editor has not been implemented. Enter an MVC project to edit this form or use #bitEdit'!
Item was removed:
- ----- Method: MorphicProject>>formViewClass (in category 'editors') -----
- formViewClass
- "Answer a class suitable for a view on a form or collection of forms"
-
- ^ GraphicalDictionaryMenu!
Item was removed:
- ----- Method: MorphicProject>>future:do:at:args: (in category 'futures') -----
- future: receiver do: aSelector at: deltaMSecs args: args
- "Send a message deltaSeconds into the future. No response is expected."
- | msg |
- msg := MessageSend receiver: receiver selector: aSelector arguments: args.
- deltaMSecs = 0
- ifTrue: [self addDeferredUIMessage: msg]
- ifFalse: [
- world
- addAlarm: #addDeferredUIMessage:
- withArguments: {msg}
- for: self
- at: (Time millisecondClockValue + deltaMSecs)
- ]..
- ^nil!
Item was removed:
- ----- Method: MorphicProject>>future:send:at:args: (in category 'futures') -----
- future: receiver send: aSelector at: deltaMSecs args: args
- "Send a message deltaSeconds into the future. Answers a Promise that will be resolved at some time in the future."
- | pr closure |
- pr := Promise new.
- closure := [pr fulfillWith: [receiver perform: aSelector withArguments: args]].
- deltaMSecs = 0
- ifTrue: [self addDeferredUIMessage: closure]
- ifFalse: [
- world
- addAlarm: #addDeferredUIMessage:
- withArguments: {closure}
- for: self
- at: (Time millisecondClockValue + deltaMSecs)
- ].
- ^pr
- !
Item was removed:
- ----- Method: MorphicProject>>globalFlapEnabledString: (in category 'flaps support') -----
- globalFlapEnabledString: aFlapTab
- "Answer the string to be shown in a menu to represent the status of the given flap regarding whether it it should be shown in this project."
-
- ^ (self isFlapEnabled: aFlapTab)
- ifTrue:
- ['<on>', aFlapTab wording]
- ifFalse:
- ['<off>', aFlapTab wording]!
Item was removed:
- ----- Method: MorphicProject>>globalFlapWithIDEnabledString: (in category 'flaps support') -----
- globalFlapWithIDEnabledString: aFlapID
- "Answer the string to be shown in a menu to represent the status of the given flap regarding whether it it should be shown in this project."
-
- | aFlapTab |
- aFlapTab := Flaps globalFlapTabWithID: aFlapID.
- ^ (self isFlapEnabled: aFlapTab)
- ifTrue:
- ['<on>', aFlapTab wording]
- ifFalse:
- ['<off>', aFlapTab wording]!
Item was removed:
- ----- Method: MorphicProject>>initMorphic (in category 'initialize') -----
- initMorphic
- "Written so that Morphic can still be removed. Note that #initialize is never actually called for a morphic project -- see the senders of this method."
-
- self flag: #toRemove. "check if this method still used by Etoys"
- Smalltalk verifyMorphicAvailability ifFalse: [^ nil].
- changeSet := ChangeSet new.
- transcript := TranscriptStream new.
- displayDepth := Display depth.
- parentProject := CurrentProject.
- world := PasteUpMorph newWorldForProject: self.
- Locale switchToID: CurrentProject localeID.
- self initializeProjectPreferences. "Do this *after* a world is installed so that the project will be recognized as a morphic one."
- Preferences useVectorVocabulary ifTrue: [world installVectorVocabulary]!
Item was removed:
- ----- Method: MorphicProject>>initialize (in category 'initialize') -----
- initialize
- "Initialize a new Morphic Project"
-
- super initialize.
-
- world := PasteUpMorph newWorldForProject: self.
- self setWorldBackground: true.
-
- Locale switchToID: CurrentProject localeID.
- Preferences useVectorVocabulary ifTrue: [world installVectorVocabulary].
-
- Project current isMorphic ifTrue: [
- "Only trigger tool builders etc. if we are already in the same kind of project because there is global state that cannot yet be configured in a dynamic scope such as 'ToolBuilder default'."
- self assureMainDockingBarPresenceMatchesPreference].!
Item was removed:
- ----- Method: MorphicProject>>initializeMenus (in category 'enter') -----
- initializeMenus
- "Menu setting for these classes may have been modified by another
- Morphic project, e.g. SimpleMorphic. Ensure that they are restored to the
- expected menus."
-
- Editor initialize.!
Item was removed:
- ----- Method: MorphicProject>>initializeParagraphForTranscripter: (in category 'transcripter') -----
- initializeParagraphForTranscripter: transcripter
- "A transcripter is a minimal user interface to support an emergency evaluator.
- A Morphic project uses class NewParagraph."
- transcripter morphicInitializeParagraph: NewParagraph!
Item was removed:
- ----- Method: MorphicProject>>installPasteUpAsWorld: (in category 'initialize') -----
- installPasteUpAsWorld: pasteUpMorph
- "(ProjectViewMorph newMorphicProjectOn: aPasteUpMorph) openInWorld."
-
- world := pasteUpMorph beWorldForProject: self.
- self setWorldBackground: true.!
Item was removed:
- ----- Method: MorphicProject>>interruptCleanUpFor: (in category 'scheduling & debugging') -----
- interruptCleanUpFor: interruptedProcess
- "Clean up things in case of a process interrupt."
-
- super interruptCleanUpFor: interruptedProcess.
-
- self uiProcess == interruptedProcess ifTrue: [
- self currentHand ifNotNil: [:hand | hand interrupted].
- world removeProperty: #shouldDisplayWorld.
- Preferences eToyFriendly ifTrue: [world stopRunningAll]].!
Item was removed:
- ----- Method: MorphicProject>>invalidate (in category 'display') -----
- invalidate
- "Invalidate the entire project so that a redraw will be forced later."
- world restoreMorphicDisplay.!
Item was removed:
- ----- Method: MorphicProject>>isFlapEnabled: (in category 'flaps support') -----
- isFlapEnabled: aFlapTab
- "Answer whether the given flap tab is enabled in this project"
-
- ^ self isFlapIDEnabled: aFlapTab flapID!
Item was removed:
- ----- Method: MorphicProject>>isFlapIDEnabled: (in category 'flaps support') -----
- isFlapIDEnabled: aFlapID
- "Answer whether a flap of the given ID is enabled in this project"
-
- | disabledFlapIDs |
- disabledFlapIDs := self parameterAt: #disabledGlobalFlapIDs ifAbsent: [^ true].
- ^ (disabledFlapIDs includes: aFlapID) not!
Item was removed:
- ----- Method: MorphicProject>>isIncompletelyLoaded (in category 'enter') -----
- isIncompletelyLoaded
- "Answer true if project is incomplete and should be loaded from server "
-
- (world isKindOf: StringMorph)
- ifTrue: [self inform: 'This project is not all here. I will try to load a complete version.' translated.
- ^ true].
- ^ false!
Item was removed:
- ----- Method: MorphicProject>>isMorphic (in category 'testing') -----
- isMorphic
- "Duh."
- ^true!
Item was removed:
- ----- Method: MorphicProject>>jumpToProject (in category 'utilities') -----
- jumpToProject
- "Present a list of potential projects and enter the one selected."
-
- "Project current jumpToProject"
-
- | menu |
- menu:=MenuMorph new.
- menu defaultTarget: self.
- menu := self buildJumpToMenu: menu.
- menu popUpInWorld!
Item was removed:
- ----- Method: MorphicProject>>lastDeferredUIMessage (in category 'scheduling & debugging') -----
- lastDeferredUIMessage
- "Answer the most recently scheduled deferredUIMessage."
-
- ^WorldState lastDeferredUIMessage!
Item was removed:
- ----- Method: MorphicProject>>launchSystemFiles:event: (in category 'utilities') -----
- launchSystemFiles: fileStreams event: genericMorphicEvent
- "Handle a number of files the singleton VM was invoked with again."
-
- self flag: #todo. "Do something more useful with the image here, e. g. tell the VM to load it."
- self inform: ('Cannot start a second instance of Squeak\with the image "{1}"\because the VM is configured as singleton application.' translated withCRs format: {fileStreams first localName}).!
Item was removed:
- ----- Method: MorphicProject>>loadFromServer: (in category 'file in/out') -----
- loadFromServer: newerAutomatically
- "If a newer version of me is on the server, load it."
- | pair resp server |
- self assureIntegerVersion.
-
- self isCurrentProject ifTrue: "exit, then do the command"
- [^ self armsLengthCommand: #loadFromServer withDescription: 'Loading' translated].
- server := self tryToFindAServerWithMe ifNil: [^ nil].
- pair := self class mostRecent: self name onServer: server.
- pair first ifNil:
- [^ self inform: ('can''t find file on server for {1}' translated format: {self name})].
- self currentVersionNumber > pair second ifTrue:
- [^ self inform: ('That server has an older version of the project.' translated)].
- version = (Project parseProjectFileName: pair first) second
- ifTrue: [resp := (Project uiManager
- chooseOptionFrom:
- { 'Reload anyway' translated. 'Cancel' translated withCRs}
- title: 'The only changes are the ones you made here.' translated).
- resp ~= 1 ifTrue: [^ nil]]
- ifFalse: [newerAutomatically ifFalse:
- [resp := Project uiManager
- chooseOptionFrom: {'Load it' translated. 'Cancel' translated}
- title: 'A newer version exists on the server.' translated.
- resp ~= 1 ifTrue: [^ nil]]].
-
- "let's avoid renaming the loaded change set since it will be replacing ours"
- self projectParameters at: #loadingNewerVersion put: true.
-
- ComplexProgressIndicator new
- targetMorph: nil;
- historyCategory: 'project loading';
- withProgressDo:
- [ProjectLoading
- installRemoteNamed: pair first
- from: server
- named: self name
- in: parentProject]!
Item was removed:
- ----- Method: MorphicProject>>makeThumbnail (in category 'menu messages') -----
- makeThumbnail
- "Make a thumbnail image of this project from the Display."
- world displayWorldSafely. "clean pending damage"
- super makeThumbnail.
- (Smalltalk at: #InternalThreadNavigationMorph) ifNotNil: [:tnMorph |
- tnMorph cacheThumbnailFor: self].
- ^ thumbnail!
Item was removed:
- ----- Method: MorphicProject>>myPlayerClasses (in category 'release') -----
- myPlayerClasses
- "Answer all my (non-systemDefined) player classes"
- | classes presenter |
- classes := Set new.
- presenter := self world presenter.
- presenter ifNotNil: [
- presenter flushPlayerListCache. "old and outside guys"
- presenter allExtantPlayers do:
- [:p | p class isSystemDefined ifFalse: [classes add: p class]]].
- ^classes!
Item was removed:
- ----- Method: MorphicProject>>noDisplayDuring: (in category 'display') -----
- noDisplayDuring: block
-
- self world noDisplayDuring: block.!
Item was removed:
- ----- Method: MorphicProject>>noteManifestDetailsIn: (in category 'file in/out') -----
- noteManifestDetailsIn: manifestInfo
- "The receiver is a project being loaded. From the dictionary provided, absorb and remember whether it's an 'old' (pre-olpc) project, and remember the GUID, user, and prev-GUID associated with the project when these data are available in the incoming manifest."
-
- | manifestDict oldProject |
- manifestInfo isEmptyOrNil ifTrue: [^ self projectParameterAt: #oldProject put: true].
-
- manifestDict := (manifestInfo isKindOf: Dictionary) ifTrue: [manifestInfo] ifFalse: [manifestInfo first].
-
- oldProject := ((manifestDict at: 'Squeak-Version' ifAbsent: ['']) beginsWith: 'etoys') not.
- self projectParameterAt: #oldProject put: oldProject.
-
- manifestDict at: #URI ifPresent: [:aUri | self projectParameterAt: #URI put: aUri].
- manifestDict at: #user ifPresent: [:aUser | self projectParameterAt: #user put: aUser].
- manifestDict at: #'prev-URI' ifPresent: [:aUri | self projectParameterAt: #'prev-URI' put: aUri]!
Item was removed:
- ----- Method: MorphicProject>>offerMenu:from:shifted: (in category 'utilities') -----
- offerMenu: menuSelector from: aModel shifted: aBoolean
- "Pop up a menu whose target is aModel and whose contents are provided
- by sending the menuSelector to the model. The menuSelector takes two
- arguments: a menu, and a boolean representing the shift state."
-
- | aMenu |
- aMenu := MenuMorph new defaultTarget: aModel.
- aModel perform: menuSelector with: aMenu with: aBoolean.
- aMenu popUpInWorld
- !
Item was removed:
- ----- Method: MorphicProject>>openBlankProjectNamed: (in category 'squeaklet on server') -----
- openBlankProjectNamed: projName
-
- | proj projViewer |
-
- proj := MorphicProject openViewOn: nil.
- proj changeSet name: projName.
- proj world addMorph: (
- TextMorph new
- beAllFont: ((TextStyle default fontOfSize: 26) emphasized: 1);
- color: Color red;
- contents: 'Welcome to a new project - ',projName
- ).
- proj setParent: self.
- projViewer := (self findProjectView: projName) ifNil: [^proj].
- (projViewer owner isSystemWindow) ifTrue: [
- projViewer owner model: proj].
- ^ projViewer project: proj!
Item was removed:
- ----- Method: MorphicProject>>openImage:name:saveResource: (in category 'editors') -----
- openImage: aForm name: fullName saveResource: aBoolean
- "Open a view on an image. If aBoolean is true, save the image as a project resource."
-
- aBoolean ifTrue:
- [self resourceManager
- addResource: aForm
- url: (FileDirectory urlForFileNamed: fullName) asString].
- (world drawingClass withForm: aForm) openInWorld
- !
Item was removed:
- ----- Method: MorphicProject>>openProject: (in category 'initialize') -----
- openProject: aProject
- "Create a new for a new project in the context of the receiver"
- ProjectViewMorph openOn: aProject.!
Item was removed:
- ----- Method: MorphicProject>>pointerMoved (in category 'utilities') -----
- pointerMoved
- "Pointer has moved during a drag operation. Perform any necessary updates.
- In Morphic, pay the price for reading the sensor directly."
-
- world activeHand
- newMouseFocus: nil;
- showTemporaryCursor: nil;
- flushEvents!
Item was removed:
- ----- Method: MorphicProject>>prepareForDelete (in category 'release') -----
- prepareForDelete
- "The window in which the project is housed is about to deleted. Perform
- any necessary actions to prepare for deletion."
-
- | list |
- Smalltalk at: #WonderlandCameraMorph ifPresent:[:aClass |
- world submorphs do: "special release for wonderlands"
- [:m | (m isKindOf: aClass)
- and: [m getWonderland release]]].
- "Remove Player classes and metaclasses owned by project"
- self myPlayerClasses do: [:playerCls | playerCls removeFromSystemUnlogged].
-
- !
Item was removed:
- ----- Method: MorphicProject>>previewImageForm (in category 'display') -----
- previewImageForm
-
- ^ self world imageForm scaledToSize: self viewSize!
Item was removed:
- ----- Method: MorphicProject>>recursiveError: (in category 'scheduling & debugging') -----
- recursiveError: msg
-
- "1a) If the recursion happens in a non-ui process, make sure to escalate it in the ui process."
- Processor activeProcess == self uiProcess ifFalse: [
- self addDeferredUIMessage: [super recursiveError: msg].
- ^ Processor activeProcess suspend].
-
- "1b) Normal escalation of error recursion in the ui process."
- ^ super recursiveError: msg!
Item was removed:
- ----- Method: MorphicProject>>removeMainDockingBar (in category 'docking bars support') -----
- removeMainDockingBar
- "Remove the receiver's main docking bars"
- self world mainDockingBars
- do: [:each | each delete]!
Item was removed:
- ----- Method: MorphicProject>>restore (in category 'display') -----
- restore
-
- world displayWorldSafely.!
Item was removed:
- ----- Method: MorphicProject>>restoreDisplay (in category 'scheduling & debugging') -----
- restoreDisplay
- "Give all morphs a chance to draw again."
- self world ifNotNil: [:w | w allMorphsDo: [:ea | ea removeProperty: #errorOnDraw ]].
-
- super restoreDisplay.!
Item was removed:
- ----- Method: MorphicProject>>resumeEventRecorder: (in category 'enter') -----
- resumeEventRecorder: recorder
-
- recorder ifNotNil: [:rec | rec resumeIn: world].!
Item was removed:
- ----- Method: MorphicProject>>scheduleProcessForEnter (in category 'enter') -----
- scheduleProcessForEnter
- "Complete the enter: by launching a new process"
-
- self spawnNewProcess.!
Item was removed:
- ----- Method: MorphicProject>>setAsBackground: (in category 'utilities') -----
- setAsBackground: aFormOrColorOrFillStyle
- "Set aForm as a background image."
-
- | thisWorld newFill oldFill |
- thisWorld := self world.
-
- oldFill := thisWorld fillStyle.
- thisWorld fillStyle: aFormOrColorOrFillStyle.
- newFill := thisWorld fillStyle.
-
- newFill rememberCommand:
- (Command new cmdWording: 'set background to a picture' translated;
- undoTarget: thisWorld selector: #fillStyle: argument: oldFill;
- redoTarget: thisWorld selector: #fillStyle: argument: newFill).
-
- thisWorld setProperty: #hasCustomBackground toValue: true.!
Item was removed:
- ----- Method: MorphicProject>>setFlaps (in category 'flaps support') -----
- setFlaps
-
- | flapTabs flapIDs sharedFlapTabs navigationMorph |
- self flag: #toRemove. "check if this method still used by Etoys"
-
- flapTabs := self world flapTabs.
- flapIDs := flapTabs collect: [:tab | tab knownName].
- flapTabs
- do: [:tab | (tab isMemberOf: ViewerFlapTab)
- ifFalse: [tab isGlobalFlap
- ifTrue: [Flaps removeFlapTab: tab keepInList: false.
- tab currentWorld reformulateUpdatingMenus]
- ifFalse: [| referent |
- referent := tab referent.
- referent isInWorld
- ifTrue: [referent delete].
- tab delete]]].
- sharedFlapTabs := Flaps classPool at: #SharedFlapTabs.
- flapIDs
- do: [:id |
- id = 'Navigator' translated
- ifTrue: [sharedFlapTabs add: Flaps newNavigatorFlap].
- id = 'Widgets' translated
- ifTrue: [sharedFlapTabs add: Flaps newWidgetsFlap].
- id = 'Tools' translated
- ifTrue: [sharedFlapTabs add: Flaps newToolsFlap].
- id = 'Squeak' translated
- ifTrue: [sharedFlapTabs add: Flaps newSqueakFlap].
- id = 'Supplies' translated
- ifTrue: [sharedFlapTabs add: Flaps newSuppliesFlap].
- id = 'Stack Tools' translated
- ifTrue: [sharedFlapTabs add: Flaps newStackToolsFlap].
- id = 'Painting' translated
- ifTrue: [sharedFlapTabs add: Flaps newPaintingFlap].
- id = 'Objects' translated
- ifTrue: [sharedFlapTabs add: Flaps newObjectsFlap ]].
- 2 timesRepeat: [flapIDs do: [:id | Flaps enableDisableGlobalFlapWithID: id]].
- self world flapTabs
- do: [:flapTab | flapTab isCurrentlyTextual
- ifTrue: [flapTab changeTabText: flapTab knownName]].
- Flaps positionNavigatorAndOtherFlapsAccordingToPreference.
- navigationMorph := self currentWorld findDeeplyA: ProjectNavigationMorph preferredNavigator.
- navigationMorph isNil
- ifTrue: [^ self].
- navigationMorph allMorphs
- do: [:morph | morph class == SimpleButtonDelayedMenuMorph
- ifTrue: [(morph findA: ImageMorph) isNil
- ifTrue: [| label |
- label := morph label.
- label isNil
- ifFalse: [| name |
- name := morph knownName.
- name isNil
- ifTrue: [morph name: label.
- name := label].
- morph label: name translated]]]]!
Item was removed:
- ----- Method: MorphicProject>>setWorldBackground: (in category 'initialize') -----
- setWorldBackground: force
-
- ((world hasProperty: #hasCustomBackground) and: [force not])
- ifTrue: [^ self].
-
- "If the user has a custom background, propagate it into the new project."
- ((Project current ~~ self and: [Project current isMorphic]) and: [Project current world hasProperty: #hasCustomBackground])
- ifTrue: [
- world fillStyle: Project current world fillStyle copy.
- world setProperty: #hasCustomBackground toValue: true]
- ifFalse: [
- world removeProperty: #hasCustomBackground.
- world fillStyle: (self userInterfaceTheme background ifNil: [self class defaultFill])].!
Item was removed:
- ----- Method: MorphicProject>>showImage:named: (in category 'utilities') -----
- showImage: aForm named: imageName
- "Show an image, possibly attached to the pointer for positioning"
-
- HandMorph attach: (world drawingClass withForm: aForm)
- !
Item was removed:
- ----- Method: MorphicProject>>showWorldMainDockingBar (in category 'docking bars support') -----
- showWorldMainDockingBar
-
- ^ self projectPreferenceFlagDictionary
- at: #showWorldMainDockingBar
- ifAbsent: [ true ]!
Item was removed:
- ----- Method: MorphicProject>>showWorldMainDockingBar: (in category 'docking bars support') -----
- showWorldMainDockingBar: aBooleanOrNil
- "Change the receiver to show the main docking bar"
- aBooleanOrNil
- ifNil: [self projectPreferenceFlagDictionary removeKey: #showWorldMainDockingBar ifAbsent: []]
- ifNotNil: [self projectPreferenceFlagDictionary at: #showWorldMainDockingBar put: aBooleanOrNil].
- self assureMainDockingBarPresenceMatchesPreference!
Item was removed:
- ----- Method: MorphicProject>>showWorldMainDockingBarString (in category 'docking bars support') -----
- showWorldMainDockingBarString
- ^ (self showWorldMainDockingBar
- ifTrue: ['<yes>']
- ifFalse: ['<no>'])
- , 'show main docking bar (M)' translated!
Item was removed:
- ----- Method: MorphicProject>>spawnNewProcess (in category 'active process') -----
- spawnNewProcess
-
- uiProcess := [
- [world doOneCycle. Processor yield ] repeat.
- ] newProcess priority: Processor userSchedulingPriority.
- uiProcess resume!
Item was removed:
- ----- Method: MorphicProject>>spawnNewProcessAndTerminateOld: (in category 'active process') -----
- spawnNewProcessAndTerminateOld: terminate
-
- self spawnNewProcess.
- terminate
- ifTrue: [Processor terminateActive]
- ifFalse: [Processor activeProcess suspend]!
Item was removed:
- ----- Method: MorphicProject>>spawnNewProcessIfThisIsUI: (in category 'active process') -----
- spawnNewProcessIfThisIsUI: suspendedProcess
- "Initialize a UI process if needed. Answer true if suspendedProcess was interrupted
- from a UI process."
- self uiProcess == suspendedProcess ifTrue: [
- self spawnNewProcess.
- ^true
- ].
-
- "Ensure that the UI process is running."
- self uiProcess
- ifNil: [self spawnNewProcess]
- ifNotNil: [:p | p isSuspended ifTrue: [
- self restoreDisplay.
- self uiProcess resume]].
-
- ^false "no new process was created"
- !
Item was removed:
- ----- Method: MorphicProject>>startUpActions (in category 'enter') -----
- startUpActions
-
- super startUpActions.
-
- self world install.
- self world firstHand position: 100 at 100.
-
- "April 2022: None of the currently supported graphics backends on macOS (i.e., -metal -core-graphics, -opengl) in the OSVM supports an extra display buffer at the VM side, which may result in flickering during compositing or an expensive (over-)committing at vsync boundaries. Thus, use an image-side buffer for compositing to mitigate (or avoid) these issues."
- WorldState disableDeferredUpdates: Smalltalk platformName = 'Mac OS'.!
Item was removed:
- ----- Method: MorphicProject>>storeSegment (in category 'file in/out') -----
- storeSegment
- "Store my project out on the disk as an ImageSegment. Keep the outPointers in memory. Name it <project name>.seg. *** Caller must be holding (Project alInstances) to keep subprojects from going out. ***"
-
- | currentWorld is sizeHint |
- currentWorld := Project current world.
- (currentWorld == world) ifTrue: [^ false].
- "self inform: 'Can''t send the current world out'."
- world isInMemory ifFalse: [^ false]. "already done"
- world ifNil: [^ false]. world presenter ifNil: [^ false].
-
- ScrapBook default emptyScrapBook.
- currentWorld checkCurrentHandForObjectToPaste.
- world releaseSqueakPages.
- sizeHint := self projectParameters at: #segmentSize ifAbsent: [0].
-
- is := ImageSegment
- copyFromRootsLocalFileFor: {world presenter. world} "world, and all Players"
- sizeHint: sizeHint.
-
- is state = #tooBig ifTrue: [^ false].
- is segment size < 2000 ifTrue: ["debugging"
- Transcript show: self name, ' only ', is segment size printString,
- 'bytes in Segment.'; cr].
- self projectParameters at: #segmentSize put: is segment size.
- is extract; writeToFile: self name.
- ^ true!
Item was removed:
- ----- Method: MorphicProject>>storeSegmentNoFile (in category 'file in/out') -----
- storeSegmentNoFile
- "For testing. Make an ImageSegment. Keep the outPointers in memory. Also useful if you want to enumerate the objects in the segment afterwards (allObjectsDo:)"
-
- | is currentWorld |
- currentWorld := Project current world.
- (currentWorld == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'."
- world isInMemory ifFalse: [^ self]. "already done"
- world ifNil: [^ self]. world presenter ifNil: [^ self].
-
- "Do this on project enter"
- currentWorld flapTabs do: [:ft | ft referent adaptToWorld: currentWorld].
- "Hack to keep the Menu flap from pointing at my project"
- "Preferences setPreference: #useGlobalFlaps toValue: false."
- "Utilities globalFlapTabsIfAny do:
- [:aFlapTab | Utilities removeFlapTab: aFlapTab keepInList: false].
- Utilities clobberFlapTabList. "
- "project world deleteAllFlapArtifacts."
- "self currentWorld deleteAllFlapArtifacts. "
- ScrapBook default emptyScrapBook.
- currentWorld checkCurrentHandForObjectToPaste2.
-
- is := ImageSegment
- copyFromRootsLocalFileFor: {world presenter. world} "world, and all Players"
- sizeHint: 0.
-
- is segment size < 800 ifTrue: ["debugging"
- Transcript show: self name, ' did not get enough objects'; cr. ^ Beeper beep].
-
- is extract.
- "is instVarAt: 2 put: is segment clone." "different memory"!
Item was removed:
- ----- Method: MorphicProject>>subProjects (in category 'subprojects') -----
- subProjects
- "Answer a list of all the subprojects of the receiver. "
-
- ^ (super subProjects, (world submorphs
- select: [:m | (m isSystemWindow) and: [m model isKindOf: Project]]
- thenCollect: [:m | m model])) asSet asArray.!
Item was removed:
- ----- Method: MorphicProject>>suppressFlapsString (in category 'flaps support') -----
- suppressFlapsString
- ^ (self flapsSuppressed
- ifTrue: ['<no>']
- ifFalse: ['<yes>']), 'show shared tabs (F)' translated!
Item was removed:
- ----- Method: MorphicProject>>suspendProcessForDebug (in category 'enter') -----
- suspendProcessForDebug
-
- | p |
- self assert: Processor activeProcess == uiProcess.
-
- p := uiProcess.
- uiProcess := nil.
- p suspend.!
Item was removed:
- ----- Method: MorphicProject>>syntaxError: (in category 'scheduling & debugging') -----
- syntaxError: aSyntaxErrorNotification
-
- | compilerProcess errorWasInUIProcess debugger |
- debugger := (super syntaxError: aSyntaxErrorNotification) model debugger.
-
- compilerProcess := Processor activeProcess.
- errorWasInUIProcess := self spawnNewProcessIfThisIsUI: compilerProcess.
-
- debugger errorWasInUIProcess: errorWasInUIProcess.
- compilerProcess suspend.!
Item was removed:
- ----- Method: MorphicProject>>terminateProcessForLeave (in category 'enter') -----
- terminateProcessForLeave
- "There is only one UI process. Kill it."
-
- self assert: Processor activeProcess == uiProcess.
- uiProcess := nil.
- Processor terminateActive.!
Item was removed:
- ----- Method: MorphicProject>>textWindows (in category 'utilities') -----
- textWindows
- "Answer a dictionary of all system windows for text display keyed by window title.
- Generate new window titles as required to ensure unique keys in the dictionary."
-
- | aDict windows title |
- aDict := Dictionary new.
- windows := world submorphs select: [:m | m isSystemWindow].
- windows do:
- [:w | | assoc |
- assoc := w titleAndPaneText.
- assoc ifNotNil:
- [w holdsTranscript ifFalse:
- [title := assoc key.
- (aDict includesKey: title) ifTrue: [ | newKey | "Ensure unique keys in aDict"
- (1 to: 100) detect: [:e |
- newKey := title, '-', e asString.
- (aDict includesKey: newKey) not].
- title := newKey.
- assoc := newKey -> assoc value].
- aDict add: assoc]]].
- ^ aDict
- !
Item was removed:
- ----- Method: MorphicProject>>toggleFlapsSuppressed (in category 'flaps support') -----
- toggleFlapsSuppressed
- "Project current toggleFlapsSuppressed"
-
- ^self flapsSuppressed: self flapsSuppressed not.!
Item was removed:
- ----- Method: MorphicProject>>toggleShowWorldMainDockingBar (in category 'docking bars support') -----
- toggleShowWorldMainDockingBar
- self showWorldMainDockingBar: self showWorldMainDockingBar not!
Item was removed:
- ----- Method: MorphicProject>>topMorphicProject (in category 'accessing') -----
- topMorphicProject
- parentProject == self ifTrue: [^self].
- parentProject ifNil: [self nilParentError].
- ^parentProject isMorphic
- ifTrue: [parentProject topMorphicProject]
- ifFalse: [self]!
Item was removed:
- ----- Method: MorphicProject>>uiProcess (in category 'active process') -----
- uiProcess
- ^uiProcess!
Item was removed:
- ----- Method: MorphicProject>>uiProcess: (in category 'active process') -----
- uiProcess: newUIProcess
- ^uiProcess := newUIProcess!
Item was removed:
- ----- Method: MorphicProject>>updateLocaleDependents (in category 'language') -----
- updateLocaleDependents
- "Set the project's natural language as indicated"
-
- (self world respondsTo: #isTileScriptingElement) ifTrue: "Etoys present" [
- self world allTileScriptingElements do: [:viewerOrScriptor |
- viewerOrScriptor localeChanged]].
-
- Flaps disableGlobalFlaps: false.
- (Preferences eToyFriendly or: [
- (Smalltalk classNamed: #SugarNavigatorBar) ifNotNil: [:c | c showSugarNavigator] ifNil: [false]])
- ifTrue: [
- Flaps addAndEnableEToyFlaps.
- self world addGlobalFlaps]
- ifFalse: [Flaps enableGlobalFlaps].
-
- (self isFlapIDEnabled: 'Navigator' translated)
- ifFalse: [Flaps enableDisableGlobalFlapWithID: 'Navigator' translated].
-
- ScrapBook default emptyScrapBook.
- MenuIcons initializeTranslations.
-
- super updateLocaleDependents.
-
- "self setFlaps.
- self setPaletteFor: aLanguageSymbol."!
Item was removed:
- ----- Method: MorphicProject>>viewLocFor: (in category 'display') -----
- viewLocFor: exitedProject
- "Look for a view of the exitedProject, and return its center"
-
- world submorphsDo: [:v |
- (v isSystemWindow and: [v model == exitedProject])
- ifTrue: [^ v center]].
- ^ super viewLocFor: exitedProject!
Item was removed:
- ----- Method: MorphicProject>>wakeUpTopWindow (in category 'enter') -----
- wakeUpTopWindow
- "Image has been restarted, and the startUp list has been processed. Perform
- any additional actions needed to restart the user interface."
-
- SystemWindow wakeUpTopWindowUponStartup.
- Preferences mouseOverForKeyboardFocus ifTrue:
- [ "Allow global command keys to work upon re-entry without having to cause a focus change first."
- self currentHand releaseKeyboardFocus ]!
Item was removed:
- MorphicEvent subclass: #MorphicUnknownEvent
- instanceVariableNames: 'type argument'
- classVariableNames: ''
- poolDictionaries: 'EventSensorConstants'
- category: 'Morphic-Events'!
Item was removed:
- ----- Method: MorphicUnknownEvent>>argument (in category 'accessing') -----
- argument
- ^argument!
Item was removed:
- ----- Method: MorphicUnknownEvent>>argument: (in category 'accessing') -----
- argument: arg
- argument := arg!
Item was removed:
- ----- Method: MorphicUnknownEvent>>convertToCurrentVersion:refStream: (in category 'objects from disk') -----
- convertToCurrentVersion: varDict refStream: smartRefStrm
-
- type ifNil: [type := #startSound].
- source ifNil: [source := varDict at: 'sourceHand'].
- argument ifNil: [argument := varDict at: 'sound' ifAbsent: [nil]]. "???"
- ^super convertToCurrentVersion: varDict refStream: smartRefStrm.
-
- !
Item was removed:
- ----- Method: MorphicUnknownEvent>>position (in category 'accessing') -----
- position
- ^0 at 0!
Item was removed:
- ----- Method: MorphicUnknownEvent>>setType:argument: (in category 'private') -----
- setType: evtType argument: arg
- type := evtType.
- argument := arg.!
Item was removed:
- ----- Method: MorphicUnknownEvent>>setType:argument:hand:stamp: (in category 'private') -----
- setType: evtType argument: arg hand: evtHand stamp: stamp
- type := evtType.
- argument := arg.
- source := evtHand.
- timeStamp := stamp.!
Item was removed:
- ----- Method: MorphicUnknownEvent>>storeOn: (in category 'printing') -----
- storeOn: aStream
- aStream nextPutAll: 'unknown'.
- aStream space.
- self timeStamp storeOn: aStream.
- aStream space.
- {type. argument} storeOn: aStream.!
Item was removed:
- ----- Method: MorphicUnknownEvent>>type (in category 'accessing') -----
- type
- ^type!
Item was removed:
- ----- Method: MorphicUnknownEvent>>type:readFrom: (in category 'initialize') -----
- type: eventType readFrom: aStream
- | typeAndArg |
- timeStamp := Integer readFrom: aStream.
- aStream skip: 1.
- typeAndArg := Object readFrom: aStream.
- type := typeAndArg first.
- argument := typeAndArg last.!
Item was removed:
- MouseEvent subclass: #MouseButtonEvent
- instanceVariableNames: 'whichButton nClicks'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!
Item was removed:
- ----- Method: MouseButtonEvent>>blueButtonChanged (in category 'accessing') -----
- blueButtonChanged
- "Answer true if the blue mouse button has changed. This is the third mouse button or cmd+click on the Mac."
-
- ^ whichButton anyMask: 1!
Item was removed:
- ----- Method: MouseButtonEvent>>moveRightButtonChanged (in category 'accessing') -----
- moveRightButtonChanged
- "Answer if the move right mouse button has changed. This is the move left button on gaming mice."
-
- ^ whichButton anyMask: 16!
Item was removed:
- ----- Method: MouseButtonEvent>>nClicks (in category 'accessing') -----
- nClicks
- ^nClicks ifNil: [0]!
Item was removed:
- ----- Method: MouseButtonEvent>>nClicks: (in category 'accessing') -----
- nClicks: n
- nClicks := n!
Item was removed:
- ----- Method: MouseButtonEvent>>printOn: (in category 'printing') -----
- printOn: aStream
-
- aStream nextPut: $[.
- aStream nextPutAll: self cursorPoint printString; space.
- aStream nextPutAll: type; space.
- aStream nextPutAll: self modifierString.
- aStream nextPutAll: self buttonString.
- aStream nextPutAll: self whichButtonString; space.
- aStream nextPutAll: timeStamp printString.
- aStream nextPut: $].!
Item was removed:
- ----- Method: MouseButtonEvent>>redButtonChanged (in category 'accessing') -----
- redButtonChanged
- "Answer true if the red mouse button has changed. This is the first mouse button."
-
- ^ whichButton anyMask: 4!
Item was removed:
- ----- Method: MouseButtonEvent>>sentTo: (in category 'dispatching') -----
- sentTo: anObject
- "Dispatch the receiver into anObject"
- type == #mouseDown ifTrue:[^anObject handleMouseDown: self].
- type == #mouseUp ifTrue:[^anObject handleMouseUp: self].
- ^super sentTo: anObject!
Item was removed:
- ----- Method: MouseButtonEvent>>setType:position:which:buttons:hand:stamp: (in category 'private') -----
- setType: evtType position: evtPos which: button buttons: evtButtons hand: evtHand stamp: stamp
- type := evtType.
- position := evtPos.
- buttons := evtButtons.
- source := evtHand.
- wasHandled := false.
- whichButton := button.
- timeStamp := stamp.!
Item was removed:
- ----- Method: MouseButtonEvent>>setType:position:which:buttons:nClicks:hand:stamp: (in category 'private') -----
- setType: evtType position: evtPos which: button buttons: evtButtons nClicks: numClicks hand: evtHand stamp: stamp
- type := evtType.
- position := evtPos.
- buttons := evtButtons.
- nClicks := numClicks.
- source := evtHand.
- wasHandled := false.
- whichButton := button.
- timeStamp := stamp!
Item was removed:
- ----- Method: MouseButtonEvent>>storeOn: (in category 'printing') -----
- storeOn: aStream
- super storeOn: aStream.
- aStream space.
- whichButton storeOn: aStream.!
Item was removed:
- ----- Method: MouseButtonEvent>>type:readFrom: (in category 'initialize') -----
- type: eventType readFrom: aStream
- super type: eventType readFrom: aStream.
- aStream skip: 1.
- whichButton := Integer readFrom: aStream.!
Item was removed:
- ----- Method: MouseButtonEvent>>whichButton (in category 'accessing') -----
- whichButton
- ^whichButton!
Item was removed:
- ----- Method: MouseButtonEvent>>whichButtonString (in category 'printing') -----
- whichButtonString
- "Return a string identifying the changed buttons"
-
- ^ String streamContents: [:stream |
- stream nextPutAll: '( '.
- self redButtonChanged ifTrue: [stream nextPutAll: 'red '].
- self yellowButtonChanged ifTrue: [stream nextPutAll: 'yellow '].
- self blueButtonChanged ifTrue: [stream nextPutAll: 'blue '].
- stream nextPutAll: ')']!
Item was removed:
- ----- Method: MouseButtonEvent>>yellowButtonChanged (in category 'accessing') -----
- yellowButtonChanged
- "Answer true if the yellow mouse button has changed. This is the second mouse button or option+click on the Mac."
-
- ^ whichButton anyMask: 2!
Item was removed:
- Object subclass: #MouseClickState
- instanceVariableNames: 'clickClient clickState firstClickDown firstClickUp firstClickTime clickSelector dblClickSelector dblClickTime dblClickTimeoutSelector dragSelector dragThreshold'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!
-
- !MouseClickState commentStamp: '<historical>' prior: 0!
- MouseClickState is a simple class managing the distinction between clicks, double clicks, and drag operations. It has been factored out of HandMorph due to the many instVars.
-
- Instance variables:
- clickClient <Morph> The client wishing to receive #click:, #dblClick:, or #drag messages
- clickState <Symbol> The internal state of handling the last event (#firstClickDown, #firstClickUp, #firstClickTimedOut)
- firstClickDown <MorphicEvent> The #mouseDown event after which the client wished to receive #click: or similar messages
- firstClickUp <MorphicEvent> The first mouse up event which came in before the double click time out was exceeded (it is sent if there is a timout after the first mouse up event occured)
- firstClickTime <Integer> The millisecond clock value of the first event
- clickSelector <Symbol> The selector to use for sending #click: messages
- dblClickSelector <Symbol> The selector to use for sending #doubleClick: messages
- dblClickTime <Integer> Timout in milliseconds for a double click operation
- dragSelector <Symbol> The selector to use for sending #drag: messages
- dragThreshold <Integer> Threshold used for determining if a #drag: message is sent (pixels!!)
- !
Item was removed:
- ----- Method: MouseClickState>>click (in category 'event handling') -----
- click
-
- clickSelector ifNotNil: [clickClient perform: clickSelector with: firstClickDown]!
Item was removed:
- ----- Method: MouseClickState>>client:click:dblClick:dblClickTime:dblClickTimeout:drag:threshold:event: (in category 'initialize') -----
- client: aMorph click: aClickSelector dblClick: aDblClickSelector dblClickTime: timeOut dblClickTimeout: aDblClickTimeoutSelector drag: aDragSelector threshold: aNumber event: firstClickEvent
- clickClient := aMorph.
- clickSelector := aClickSelector.
- dblClickSelector := aDblClickSelector.
- dblClickTime := timeOut.
- dblClickTimeoutSelector := aDblClickTimeoutSelector.
- dragSelector := aDragSelector.
- dragThreshold := aNumber.
- firstClickDown := firstClickEvent.
- firstClickTime := firstClickEvent timeStamp.
- clickState := #firstClickDown.!
Item was removed:
- ----- Method: MouseClickState>>doubleClick (in category 'event handling') -----
- doubleClick
-
- dblClickSelector ifNotNil: [clickClient perform: dblClickSelector with: firstClickDown]!
Item was removed:
- ----- Method: MouseClickState>>doubleClickTimeout (in category 'event handling') -----
- doubleClickTimeout
-
- dblClickTimeoutSelector ifNotNil: [
- clickClient perform: dblClickTimeoutSelector with: firstClickDown]!
Item was removed:
- ----- Method: MouseClickState>>drag: (in category 'event handling') -----
- drag: event
-
- dragSelector ifNotNil: [clickClient perform: dragSelector with: event]!
Item was removed:
- ----- Method: MouseClickState>>handleEvent:from: (in category 'event handling') -----
- handleEvent: evt from: aHand
- "Process the given mouse event to detect a click, double-click, or drag.
- Return true if the event should be processed by the sender, false if it shouldn't.
- NOTE: This method heavily relies on getting *all* mouse button events."
- | localEvt timedOut isDrag |
- timedOut := (evt timeStamp - firstClickTime) > dblClickTime.
- localEvt := evt transformedBy: (clickClient transformedFrom: aHand owner).
- isDrag := (localEvt position - firstClickDown position) r > dragThreshold.
- clickState == #firstClickDown ifTrue: [
- "Careful here - if we had a slow cycle we may have a timedOut mouseUp event"
- (timedOut and:[localEvt isMouseUp not]) ifTrue:[
- "timeout before #mouseUp -> keep waiting for drag if requested"
- clickState := #firstClickTimedOut.
- dragSelector ifNil:[
- aHand resetClickState.
- self doubleClickTimeout; click "***"].
- ^true].
- localEvt isMouseUp ifTrue:[
-
- (timedOut or:[dblClickSelector isNil]) ifTrue:[
- self click.
- aHand resetClickState.
- ^true].
- "Otherwise transfer to #firstClickUp"
- firstClickUp := evt copy.
- clickState := #firstClickUp.
- "If timedOut or the client's not interested in dbl clicks get outta here"
- self click.
- aHand handleEvent: firstClickUp.
- ^false].
- isDrag ifTrue:["drag start"
- self doubleClickTimeout. "***"
- aHand resetClickState.
- dragSelector "If no drag selector send #click instead"
- ifNil: [self click]
- ifNotNil: [self drag: firstClickDown].
- ^true].
- ^false].
-
- clickState == #firstClickTimedOut ifTrue:[
- localEvt isMouseUp ifTrue:["neither drag nor double click"
- aHand resetClickState.
- self doubleClickTimeout; click. "***"
- ^true].
- isDrag ifTrue:["drag start"
- aHand resetClickState.
- self doubleClickTimeout; drag: firstClickDown. "***"
- ^true].
- ^false].
-
- clickState = #firstClickUp ifTrue:[
- (timedOut) ifTrue:[
- "timed out after mouseUp - signal timeout and pass the event"
- aHand resetClickState.
- self doubleClickTimeout. "***"
- ^true].
- localEvt isMouseDown ifTrue:["double click"
- clickState := #secondClickDown.
- ^false]].
-
- clickState == #secondClickDown ifTrue: [
- timedOut ifTrue:[
- "timed out after second mouseDown - pass event after signaling timeout"
- aHand resetClickState.
- self doubleClickTimeout. "***"
- ^true].
- isDrag ifTrue: ["drag start"
- self doubleClickTimeout. "***"
- aHand resetClickState.
- dragSelector "If no drag selector send #click instead"
- ifNil: [self click]
- ifNotNil: [self drag: firstClickDown].
- ^true].
- localEvt isMouseUp ifTrue: ["double click"
- aHand resetClickState.
- self doubleClick.
- ^false]
- ].
-
- ^true
- !
Item was removed:
- ----- Method: MouseClickState>>printOn: (in category 'printing') -----
- printOn: aStream
- super printOn: aStream.
- aStream nextPut: $[; print: clickState; nextPut: $]
- !
Item was removed:
- UserInputEvent subclass: #MouseEvent
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!
Item was removed:
- ----- Method: MouseEvent class>>anyButton (in category 'constants') -----
- anyButton
-
- ^ EventSensor anyMouseButtonMask!
Item was removed:
- ----- Method: MouseEvent class>>blueButton (in category 'constants') -----
- blueButton
- ^ 1!
Item was removed:
- ----- Method: MouseEvent class>>numButtons (in category 'constants') -----
- numButtons
-
- ^ EventSensor numMouseButtons!
Item was removed:
- ----- Method: MouseEvent class>>redButton (in category 'constants') -----
- redButton
- ^ 4!
Item was removed:
- ----- Method: MouseEvent class>>yellowButton (in category 'constants') -----
- yellowButton
- ^ 2!
Item was removed:
- ----- Method: MouseEvent>>= (in category 'comparing') -----
- = aMorphicEvent
- super = aMorphicEvent ifFalse:[^false].
- position = aMorphicEvent position ifFalse: [^ false].
- buttons = aMorphicEvent buttons ifFalse: [^ false].
- ^ true
- !
Item was removed:
- ----- Method: MouseEvent>>anyButtonPressed (in category 'button state') -----
- anyButtonPressed
- "Answer true if any mouse button is being pressed."
-
- ^ buttons anyMask: self class anyButton!
Item was removed:
- ----- Method: MouseEvent>>asMouseEnter (in category 'converting') -----
- asMouseEnter
- ^self shallowCopy setType: #mouseEnter!
Item was removed:
- ----- Method: MouseEvent>>asMouseLeave (in category 'converting') -----
- asMouseLeave
- ^self shallowCopy setType: #mouseLeave!
Item was removed:
- ----- Method: MouseEvent>>asMouseMove (in category 'converting') -----
- asMouseMove
- "Convert the receiver into a mouse move"
- ^MouseMoveEvent new setType: #mouseMove startPoint: position endPoint: position trail: {position. position} buttons: buttons hand: source stamp: timeStamp!
Item was removed:
- ----- Method: MouseEvent>>asMouseOver (in category 'converting') -----
- asMouseOver
- "Convert the receiver into a mouse over event"
- ^MouseEvent new setType: #mouseOver position: position buttons: buttons hand: source!
Item was removed:
- ----- Method: MouseEvent>>blueButtonPressed (in category 'button state') -----
- blueButtonPressed
- "Answer true if the blue mouse button is being pressed. This is the third mouse button or cmd+click on the Mac."
-
- ^ buttons anyMask: self class blueButton!
Item was removed:
- ----- Method: MouseEvent>>cursorPoint (in category 'accessing') -----
- cursorPoint
- "Answer the location of the cursor's hotspot when this event occured."
-
- ^ position!
Item was removed:
- ----- Method: MouseEvent>>hash (in category 'comparing') -----
- hash
- ^ position hash + buttons hash!
Item was removed:
- ----- Method: MouseEvent>>isDraggingEvent (in category 'testing') -----
- isDraggingEvent
- source ifNil:[^false].
- source hasSubmorphs ifTrue:[^true].
- self anyButtonPressed ifTrue:[^true].
- ^false!
Item was removed:
- ----- Method: MouseEvent>>isMouse (in category 'testing') -----
- isMouse
- ^true!
Item was removed:
- ----- Method: MouseEvent>>isMouseDown (in category 'testing') -----
- isMouseDown
- ^self type == #mouseDown!
Item was removed:
- ----- Method: MouseEvent>>isMouseEnter (in category 'testing') -----
- isMouseEnter
- ^self type == #mouseEnter!
Item was removed:
- ----- Method: MouseEvent>>isMouseLeave (in category 'testing') -----
- isMouseLeave
- ^self type == #mouseLeave!
Item was removed:
- ----- Method: MouseEvent>>isMouseMove (in category 'testing') -----
- isMouseMove
- ^self type == #mouseMove!
Item was removed:
- ----- Method: MouseEvent>>isMouseUp (in category 'testing') -----
- isMouseUp
- ^self type == #mouseUp!
Item was removed:
- ----- Method: MouseEvent>>isMouseWheel (in category 'testing') -----
- isMouseWheel
- ^ false!
Item was removed:
- ----- Method: MouseEvent>>isMove (in category 'testing') -----
- isMove
- ^false!
Item was removed:
- ----- Method: MouseEvent>>printOn: (in category 'printing') -----
- printOn: aStream
-
- aStream nextPut: $[.
- aStream nextPutAll: self cursorPoint printString; space.
- aStream nextPutAll: type; space.
- aStream nextPutAll: self modifierString.
- aStream nextPutAll: self buttonString.
- aStream nextPutAll: timeStamp printString.
- aStream nextPut: $].!
Item was removed:
- ----- Method: MouseEvent>>redButtonPressed (in category 'button state') -----
- redButtonPressed
- "Answer true if the red mouse button is being pressed. This is the first mouse button."
-
- ^ buttons anyMask: self class redButton!
Item was removed:
- ----- Method: MouseEvent>>sentTo: (in category 'dispatching') -----
- sentTo: anObject
- "Dispatch the receiver into anObject"
- type == #mouseOver ifTrue:[^anObject handleMouseOver: self].
- type == #mouseEnter ifTrue:[^anObject handleMouseEnter: self].
- type == #mouseLeave ifTrue:[^anObject handleMouseLeave: self].
- ^super sentTo: anObject.!
Item was removed:
- ----- Method: MouseEvent>>setType: (in category 'private') -----
- setType: aSymbol
- "For quick conversion between event types"
- type := aSymbol.!
Item was removed:
- ----- Method: MouseEvent>>setType:position:buttons:hand: (in category 'private') -----
- setType: evtType position: evtPos buttons: evtButtons hand: evtHand
- type := evtType.
- position := evtPos.
- buttons := evtButtons.
- source := evtHand.
- wasHandled := false.!
Item was removed:
- ----- Method: MouseEvent>>storeOn: (in category 'printing') -----
- storeOn: aStream
-
- aStream nextPutAll: type.
- aStream space.
- self timeStamp storeOn: aStream.
- aStream space.
- position x storeOn: aStream.
- aStream space.
- position y storeOn: aStream.
- aStream space.
- buttons storeOn: aStream.!
Item was removed:
- ----- Method: MouseEvent>>targetPoint (in category 'button state') -----
- targetPoint
- "Answer the location of the cursor's hotspot, adjusted by the offset
- of the last mouseDown relative to the recipient morph."
-
- ^ position - source targetOffset!
Item was removed:
- ----- Method: MouseEvent>>type:readFrom: (in category 'initialize') -----
- type: eventType readFrom: aStream
- | x y |
- type := eventType.
- timeStamp := Integer readFrom: aStream.
- aStream skip: 1.
- x := Integer readFrom: aStream.
- aStream skip: 1.
- y := Integer readFrom: aStream.
- aStream skip: 1.
- buttons := Integer readFrom: aStream.
- position := x at y.
- !
Item was removed:
- ----- Method: MouseEvent>>yellowButtonPressed (in category 'button state') -----
- yellowButtonPressed
- "Answer true if the yellow mouse button is being pressed. This is the second mouse button or option+click on the Mac."
-
- ^ buttons anyMask: self class yellowButton!
Item was removed:
- MouseEvent subclass: #MouseMoveEvent
- instanceVariableNames: 'startPoint trail'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!
Item was removed:
- ----- Method: MouseMoveEvent>>= (in category 'comparing') -----
- = aMorphicEvent
- super = aMorphicEvent ifFalse:[^false].
- position = aMorphicEvent position ifFalse: [^ false].
- startPoint = aMorphicEvent startPoint ifFalse: [^ false].
- buttons = aMorphicEvent buttons ifFalse: [^ false].
- ^ true
- !
Item was removed:
- ----- Method: MouseMoveEvent>>endPoint (in category 'accessing') -----
- endPoint
- "Return the point where the movement ended."
- ^position!
Item was removed:
- ----- Method: MouseMoveEvent>>hash (in category 'comparing') -----
- hash
- ^ position hash + startPoint hash + buttons hash!
Item was removed:
- ----- Method: MouseMoveEvent>>isMove (in category 'testing') -----
- isMove
- ^true!
Item was removed:
- ----- Method: MouseMoveEvent>>printOn: (in category 'printing') -----
- printOn: aStream
-
- aStream nextPut: $[.
- aStream nextPutAll: self startPoint printString; space.
- aStream nextPutAll: self endPoint printString; space.
- aStream nextPutAll: self type; space.
- aStream nextPutAll: self modifierString.
- aStream nextPutAll: self buttonString.
- aStream nextPutAll: timeStamp printString.
- aStream nextPut: $].!
Item was removed:
- ----- Method: MouseMoveEvent>>sentTo: (in category 'dispatching') -----
- sentTo: anObject
- "Dispatch the receiver into anObject"
- type == #mouseMove ifTrue:[^anObject handleMouseMove: self].
- ^super sentTo: anObject.
- !
Item was removed:
- ----- Method: MouseMoveEvent>>setType:startPoint:endPoint:trail:buttons:hand:stamp: (in category 'private') -----
- setType: evtType startPoint: evtStart endPoint: evtEnd trail: evtTrail buttons: evtButtons hand: evtHand stamp: stamp
- type := evtType.
- startPoint := evtStart.
- position := evtEnd.
- trail := evtTrail.
- buttons := evtButtons.
- source := evtHand.
- wasHandled := false.
- timeStamp := stamp.!
Item was removed:
- ----- Method: MouseMoveEvent>>startPoint (in category 'accessing') -----
- startPoint
- "Return the point where the movement started."
- ^startPoint!
Item was removed:
- ----- Method: MouseMoveEvent>>storeOn: (in category 'printing') -----
- storeOn: aStream
- super storeOn: aStream.
- aStream space.
- self startPoint x storeOn: aStream.
- aStream space.
- self startPoint y storeOn: aStream.
- aStream space.
- "trail storeOn: aStream."!
Item was removed:
- ----- Method: MouseMoveEvent>>trail (in category 'accessing') -----
- trail
- "Return any immediate points that have been assembled along the move"
- ^trail ifNil:[#()]!
Item was removed:
- ----- Method: MouseMoveEvent>>transformBy: (in category 'transforming') -----
- transformBy: aMorphicTransform
- "Transform the receiver into a local coordinate system."
- position := aMorphicTransform globalPointToLocal: position.
- startPoint := aMorphicTransform globalPointToLocal: startPoint.!
Item was removed:
- ----- Method: MouseMoveEvent>>translateBy: (in category 'transforming') -----
- translateBy: delta
- "add delta to cursorPoint, and return the new event"
- position := position + delta.
- startPoint := startPoint + delta.!
Item was removed:
- ----- Method: MouseMoveEvent>>type:readFrom: (in category 'initialize') -----
- type: eventType readFrom: aStream
- | x y |
- super type: eventType readFrom: aStream.
- aStream skip: 1.
- x := Integer readFrom: aStream.
- aStream skip: 1.
- y := Integer readFrom: aStream.
- startPoint := x at y.!
Item was removed:
- Object subclass: #MouseOverHandler
- instanceVariableNames: 'mouseOverMorphs enteredMorphs overMorphs leftMorphs'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!
Item was removed:
- ----- Method: MouseOverHandler>>initialize (in category 'initialize-release') -----
- initialize
-
- mouseOverMorphs := Array new.
- self initializeTrackedMorphs!
Item was removed:
- ----- Method: MouseOverHandler>>initializeTrackedMorphs (in category 'initialize-release') -----
- initializeTrackedMorphs
-
- leftMorphs := OrderedCollection new.
- overMorphs := WriteStream on: #().
- enteredMorphs := WriteStream on: #().!
Item was removed:
- ----- Method: MouseOverHandler>>noticeMouseOver:event: (in category 'event handling') -----
- noticeMouseOver: aMorph event: anEvent
- "Remember that the mouse is currently over some morph"
-
- leftMorphs remove: aMorph ifAbsent: [
- enteredMorphs nextPut: aMorph ].
- overMorphs nextPut: aMorph.
- !
Item was removed:
- ----- Method: MouseOverHandler>>processMouseOver: (in category 'event handling') -----
- processMouseOver: anEvent
- "Re-establish the z-order for all morphs wrt the given event"
-
- | hand localEvt focus evt |
- anEvent ifNil: [^ self].
- hand := anEvent hand.
- leftMorphs := mouseOverMorphs asIdentitySet.
- "Assume some coherence for the number of objects in over list"
- overMorphs := WriteStream on: (Array new: leftMorphs size).
- enteredMorphs := WriteStream on: #().
- "Now go looking for eventual mouse overs"
- hand handleEvent: anEvent asMouseOver.
- "Get out early if there's no change"
- (leftMorphs isEmpty and: [ enteredMorphs position = 0 ])
- ifTrue: [ ^self initializeTrackedMorphs ].
- focus := hand mouseFocus.
- "Send #mouseLeave as appropriate"
- evt := anEvent asMouseLeave.
- "Keep the order of the left morphs by recreating it from the mouseOverMorphs"
- leftMorphs size > 1
- ifTrue:
- [leftMorphs := mouseOverMorphs select: [:m | leftMorphs includes: m]].
- leftMorphs do: [ :m |
- (m == focus or: [m hasOwner: focus])
- ifFalse: [ overMorphs nextPut: m ]
- ifTrue:
- [ localEvt := evt transformedBy: (m transformedFrom: hand).
- m handleEvent: localEvt ] ].
- enteredMorphs ifNil: [ "inform: was called in handleEvent:"
- ^self initializeTrackedMorphs ].
- "Send #mouseEnter as appropriate"
- evt := anEvent asMouseEnter.
- enteredMorphs contents reverseDo: [ :m |
- (m == focus or: [m hasOwner: focus]) ifTrue: [
- localEvt := evt transformedBy: (m transformedFrom: hand).
- m handleEvent: localEvt ] ].
- "And remember the over list"
- overMorphs ifNotNil: [ mouseOverMorphs := overMorphs contents ].
- self initializeTrackedMorphs!
Item was removed:
- MouseEvent subclass: #MouseWheelEvent
- instanceVariableNames: 'delta direction'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!
Item was removed:
- ----- Method: MouseWheelEvent class>>convertScrollUnits:intoScrollDelta: (in category 'utility') -----
- convertScrollUnits: scrollUnits intoScrollDelta: scrollDeltaPerMouseWheelNotch
- "Convert the scrolling units provided by the VM into scrolling delta (increment) used by Morph.
- The morph knows how many scroll delta it wants per single wheel notch.
- I know how many scrolling units is generated by a single wheel notch."
-
- ^scrollUnits abs * scrollDeltaPerMouseWheelNotch // self scrollUnitsPerMouseWheelNotch max: 1!
Item was removed:
- ----- Method: MouseWheelEvent class>>minimalScrollUnitsPerEvent (in category 'constants') -----
- minimalScrollUnitsPerEvent
- "Answer how many scroll units a single mouse wheel event can generate.
- This reflects a value hardcoded in the VM.
- The VM aggregate wheel events until this threshold is reached."
-
- ^20!
Item was removed:
- ----- Method: MouseWheelEvent class>>scrollUnitsPerMouseWheelNotch (in category 'constants') -----
- scrollUnitsPerMouseWheelNotch
- "Answer how many scroll units a single mouse wheel notch does generate.
- This reflects a value hardcoded in the VM.
- The value is chosen high enough so as to enable:
- - smoother scrolling on notch-less devices.
- - while preserving Integer arithmetic
- Interpretation (scaling) of scrolling units is left to the client morphs.
- Typically, 120 units (1 notch) represents 3 lines of text."
-
- ^120!
Item was removed:
- ----- Method: MouseWheelEvent>>horizontalScrollDelta: (in category 'accessing') -----
- horizontalScrollDelta: scrollDeltaPerMouseWheelNotch
- "Convert scrolling units into unsigned scrolling increment.
- The morph knows how many scroll delta it wants per single wheel notch.
- Note that returned increment value is always positive, regardless of direction."
- ^self class convertScrollUnits: delta x intoScrollDelta: scrollDeltaPerMouseWheelNotch!
Item was removed:
- ----- Method: MouseWheelEvent>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
- direction := 2r0000.
- delta := 0 at 0.!
Item was removed:
- ----- Method: MouseWheelEvent>>isMouseWheel (in category 'testing') -----
- isMouseWheel
- ^ true!
Item was removed:
- ----- Method: MouseWheelEvent>>isWheelDown (in category 'testing') -----
- isWheelDown
- ^ direction anyMask: 2r0100!
Item was removed:
- ----- Method: MouseWheelEvent>>isWheelLeft (in category 'testing') -----
- isWheelLeft
- ^ direction anyMask: 2r0010!
Item was removed:
- ----- Method: MouseWheelEvent>>isWheelRight (in category 'testing') -----
- isWheelRight
- ^ direction anyMask: 2r0001!
Item was removed:
- ----- Method: MouseWheelEvent>>isWheelUp (in category 'testing') -----
- isWheelUp
- ^ direction anyMask: 2r1000!
Item was removed:
- ----- Method: MouseWheelEvent>>printOn: (in category 'printing') -----
- printOn: aStream
-
- aStream nextPut: $[.
- aStream nextPutAll: self cursorPoint printString; space.
- aStream nextPutAll: type; space.
- aStream nextPutAll: self wheelString.
- aStream nextPutAll: self wheelDelta printString; space.
- aStream nextPutAll: self modifierString.
- aStream nextPutAll: self buttonString.
- aStream nextPutAll: timeStamp printString; space.
- aStream nextPut: $].!
Item was removed:
- ----- Method: MouseWheelEvent>>sentTo: (in category 'dispatching') -----
- sentTo: anObject
- "Dispatch the receiver into anObject"
- type == #mouseWheel ifTrue: [^ anObject handleMouseWheel: self].
- ^ super sentTo: anObject!
Item was removed:
- ----- Method: MouseWheelEvent>>setDirection (in category 'initialization') -----
- setDirection
- delta x > 0 ifTrue: [self setWheelRight].
- delta x < 0 ifTrue: [self setWheelLeft].
-
- delta y > 0 ifTrue: [self setWheelUp].
- delta y < 0 ifTrue: [self setWheelDown].!
Item was removed:
- ----- Method: MouseWheelEvent>>setType:position:delta:buttons:hand:stamp: (in category 'private') -----
- setType: evtType position: evtPos delta: evtDelta buttons: evtButtons hand: evtHand stamp: stamp
- type := evtType.
- position := evtPos.
- buttons := evtButtons.
- source := evtHand.
- wasHandled := false.
- direction := 2r0000.
- delta := evtDelta.
- timeStamp := stamp.
- self setDirection!
Item was removed:
- ----- Method: MouseWheelEvent>>setType:position:delta:direction:buttons:hand:stamp: (in category 'private') -----
- setType: evtType position: evtPos delta: evtDelta direction: dirFlags buttons: evtButtons hand: evtHand stamp: stamp
- type := evtType.
- position := evtPos.
- buttons := evtButtons.
- source := evtHand.
- wasHandled := false.
- direction := dirFlags.
- delta := evtDelta.
- timeStamp := stamp.!
Item was removed:
- ----- Method: MouseWheelEvent>>setWheelDown (in category 'initialization') -----
- setWheelDown
-
- direction := direction bitOr: 2r0100.!
Item was removed:
- ----- Method: MouseWheelEvent>>setWheelLeft (in category 'initialization') -----
- setWheelLeft
-
- direction := direction bitOr: 2r0010.!
Item was removed:
- ----- Method: MouseWheelEvent>>setWheelRight (in category 'initialization') -----
- setWheelRight
-
- direction := direction bitOr: 2r0001.!
Item was removed:
- ----- Method: MouseWheelEvent>>setWheelUp (in category 'initialization') -----
- setWheelUp
-
- direction := direction bitOr: 2r1000.!
Item was removed:
- ----- Method: MouseWheelEvent>>storeOn: (in category 'printing') -----
- storeOn: aStream
- "Note: We generate the same array as provided by the VM. BUT we are a subclass of MouseEvent now even if we cannot store the position right now. This is awkward. But we still store the position and the wheel delta. *sign*"
-
- super storeOn: aStream.
- aStream space.
- delta x storeOn: aStream.
- aStream space.
- delta y storeOn: aStream.
- aStream space.
- direction storeOn: aStream.
- !
Item was removed:
- ----- Method: MouseWheelEvent>>type:readFrom: (in category 'initialization') -----
- type: eventType readFrom: aStream
-
- | deltaX deltaY |
- super type: eventType readFrom: aStream.
- aStream skip: 1.
- deltaX := Integer readFrom: aStream.
- aStream skip: 1.
- deltaY := Integer readFrom: aStream.
- aStream skip: 1.
- direction := Integer readFrom: aStream.
- delta := deltaX @ deltaY.
- !
Item was removed:
- ----- Method: MouseWheelEvent>>verticalScrollDelta: (in category 'accessing') -----
- verticalScrollDelta: scrollDeltaPerMouseWheelNotch
- "Convert scrolling units into unsigned scrolling increment.
- The morph knows how many scroll delta it wants per single wheel notch.
- Note that returned increment value is always positive, regardless of direction."
- ^self class convertScrollUnits: delta y intoScrollDelta: scrollDeltaPerMouseWheelNotch!
Item was removed:
- ----- Method: MouseWheelEvent>>wheelDelta (in category 'accessing') -----
- wheelDelta
-
- ^ delta!
Item was removed:
- ----- Method: MouseWheelEvent>>wheelString (in category 'printing') -----
- wheelString
- "Return a string identifying the wheel state"
-
- ^ String streamContents: [:stream |
- self isWheelUp ifTrue: [stream nextPutAll: 'up '].
- self isWheelDown ifTrue: [stream nextPutAll: 'down '].
- self isWheelLeft ifTrue: [stream nextPutAll: 'left '].
- self isWheelRight ifTrue: [stream nextPutAll: 'right ']]!
Item was removed:
- Morph subclass: #MovieMorph
- instanceVariableNames: 'playMode msecsPerFrame rotationDegrees scalePoint frameList currentFrameIndex dwellCount'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Basic'!
Item was removed:
- ----- Method: MovieMorph>>addCustomMenuItems:hand: (in category 'menu') -----
- 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 targetPoint)
- 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
- !
Item was removed:
- ----- Method: MovieMorph>>advanceFrame (in category 'menu') -----
- advanceFrame
-
- currentFrameIndex < frameList size
- ifTrue: [self setFrame: currentFrameIndex + 1]
- ifFalse: [self setFrame: 1].
- !
Item was removed:
- ----- Method: MovieMorph>>containsPoint: (in category 'geometry testing') -----
- containsPoint: p
- | frame |
- frame := self currentFrame.
- ^ (frame notNil and: [playMode = #stop])
- ifTrue: [frame containsPoint: p]
- ifFalse: [super containsPoint: p]!
Item was removed:
- ----- Method: MovieMorph>>currentFrame (in category 'private') -----
- currentFrame
- frameList isEmpty ifTrue: [^nil].
- currentFrameIndex := currentFrameIndex min: (frameList size).
- currentFrameIndex := currentFrameIndex max: 1.
- ^frameList at: currentFrameIndex!
Item was removed:
- ----- Method: MovieMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color
- r: 1
- g: 0
- b: 1!
Item was removed:
- ----- Method: MovieMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- | frame |
- frame := self currentFrame.
- frame notNil
- ifTrue: [^frame drawOn: aCanvas]
- ifFalse: [^super drawOn: aCanvas]!
Item was removed:
- ----- Method: MovieMorph>>editDrawing (in category 'menu') -----
- editDrawing
- | frame |
- frame := self currentFrame.
- frame notNil
- ifTrue: [frame editDrawingIn: self pasteUpMorph forBackground: false]!
Item was removed:
- ----- Method: MovieMorph>>extractFrame: (in category 'menu') -----
- extractFrame: evt
-
- | f |
- f := self currentFrame.
- f ifNil: [^ self].
- frameList := frameList copyWithout: f.
- frameList isEmpty
- ifTrue: [self position: f position]
- ifFalse: [self setFrame: currentFrameIndex].
- evt hand attachMorph: f.
- !
Item was removed:
- ----- Method: MovieMorph>>form (in category 'accessing') -----
- form
-
- ^ self currentFrame form
- !
Item was removed:
- ----- Method: MovieMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- "#stop, #playOnce, or #loop"
- playMode := #stop.
- msecsPerFrame := 200.
- rotationDegrees := 0.
- scalePoint := 1.0 @ 1.0.
- frameList := Array empty.
- currentFrameIndex := 1.
- dwellCount := 0!
Item was removed:
- ----- Method: MovieMorph>>insertFrames: (in category 'private') -----
- insertFrames: newFrames
- "Insert the given collection of frames into this movie just after the currentrame."
-
- frameList isEmpty ifTrue: [
- frameList := newFrames asArray copy.
- self setFrame: 1.
- ^ self].
-
- frameList :=
- frameList
- copyReplaceFrom: currentFrameIndex + 1 "insert before"
- to: currentFrameIndex
- with: newFrames.
- !
Item was removed:
- ----- Method: MovieMorph>>insertIntoMovie: (in category 'menu') -----
- insertIntoMovie: evt
-
- | movies aTarget |
- movies :=
- (self world rootMorphsAt: evt hand targetPoint)
- 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.
- !
Item was removed:
- ----- Method: MovieMorph>>nextFrame (in category 'menu') -----
- nextFrame
-
- currentFrameIndex < frameList size
- ifTrue: [self setFrame: currentFrameIndex + 1].
- !
Item was removed:
- ----- Method: MovieMorph>>playLoop (in category 'menu') -----
- playLoop
-
- playMode := #loop.
- !
Item was removed:
- ----- Method: MovieMorph>>playOnce (in category 'menu') -----
- playOnce
-
- self setFrame: 1.
- playMode := #playOnce.
- !
Item was removed:
- ----- Method: MovieMorph>>previousFrame (in category 'menu') -----
- previousFrame
-
- currentFrameIndex > 1
- ifTrue: [self setFrame: currentFrameIndex - 1].
- !
Item was removed:
- ----- Method: MovieMorph>>rotationDegrees (in category 'rotate scale and flex') -----
- rotationDegrees
-
- ^ rotationDegrees
- !
Item was removed:
- ----- Method: MovieMorph>>scalePoint (in category 'accessing') -----
- scalePoint
-
- ^ scalePoint
- !
Item was removed:
- ----- Method: MovieMorph>>scalePoint: (in category 'accessing') -----
- scalePoint: newScalePoint
-
- | frame |
- newScalePoint ~= scalePoint ifTrue: [
- self changed.
- scalePoint := newScalePoint.
- frame := self currentFrame.
- frame ifNotNil: [frame scalePoint: newScalePoint].
- self layoutChanged.
- self changed].
- !
Item was removed:
- ----- Method: MovieMorph>>setFrame: (in category 'private') -----
- setFrame: newFrameIndex
- | oldFrame p newFrame |
- oldFrame := self currentFrame.
- oldFrame ifNil: [^self].
- self changed.
- p := oldFrame referencePosition.
- currentFrameIndex := newFrameIndex.
- currentFrameIndex := currentFrameIndex min: (frameList size).
- currentFrameIndex := currentFrameIndex max: 1.
- newFrame := frameList at: currentFrameIndex.
- newFrame referencePosition: p.
- oldFrame delete.
- self addMorph: newFrame.
- dwellCount := newFrame framesToDwell.
- self layoutChanged.
- self changed!
Item was removed:
- ----- Method: MovieMorph>>step (in category 'stepping and presenter') -----
- step
-
- playMode = #stop ifTrue: [^ self].
-
- dwellCount > 0 ifTrue: [
- dwellCount := dwellCount - 1.
- ^ self].
-
- currentFrameIndex < frameList size
- ifTrue: [^ self setFrame: currentFrameIndex + 1].
-
- playMode = #loop
- ifTrue: [self setFrame: 1]
- ifFalse: [playMode := #stop].
- !
Item was removed:
- ----- Method: MovieMorph>>stepTime (in category 'stepping and presenter') -----
- stepTime
-
- ^ msecsPerFrame
- !
Item was removed:
- ----- Method: MovieMorph>>stopPlaying (in category 'menu') -----
- stopPlaying
-
- playMode := #stop.
- self setFrame: 1.
- !
Item was removed:
- PluggableCanvas subclass: #MultiCanvas
- instanceVariableNames: 'canvases extent depth'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Support'!
-
- !MultiCanvas commentStamp: '<historical>' prior: 0!
- A canvas which forwards drawing commands to sub-canvases.!
Item was removed:
- ----- Method: MultiCanvas>>addCanvas: (in category 'accessing') -----
- addCanvas: aCanvas
- canvases add: aCanvas!
Item was removed:
- ----- Method: MultiCanvas>>allocateForm: (in category 'initialization') -----
- allocateForm: extentPoint
- "Allocate a new form which is similar to the receiver and can be used for accelerated blts"
- ^Form extent: extentPoint depth: self depth!
Item was removed:
- ----- Method: MultiCanvas>>apply: (in category 'private') -----
- apply: aCommand
-
- self flag: #roundedRudeness.
- "This rudeness is to help get rounded corners to work right on RemoteCanvases. Since the RemoteCanvas has no other way to read its bits, we are grabbing them from Display for now. To support this, we need to see that the Display is written before any RemoteCanvases"
-
- canvases do: [ :canvas |
- (canvas isKindOf: FormCanvas) ifTrue: [aCommand value: canvas]
- ].
- canvases do: [ :canvas |
- (canvas isKindOf: FormCanvas) ifFalse: [aCommand value: canvas]
- ].
- !
Item was removed:
- ----- Method: MultiCanvas>>clipRect (in category 'accessing') -----
- clipRect
-
- ^super clipRect ifNil: [
- 0 at 0 extent: 5000 at 5000
- ].!
Item was removed:
- ----- Method: MultiCanvas>>contentsOfArea:into: (in category 'accessing') -----
- contentsOfArea: aRectangle into: aForm
-
- self apply: [ :c |
- (c isKindOf: FormCanvas) ifTrue: [
- c contentsOfArea: aRectangle into: aForm.
- ^aForm
- ].
- ].
- self apply: [ :c |
- c contentsOfArea: aRectangle into: aForm.
- ^aForm.
- ].
- ^aForm!
Item was removed:
- ----- Method: MultiCanvas>>depth (in category 'accessing') -----
- depth
- ^depth!
Item was removed:
- ----- Method: MultiCanvas>>depth: (in category 'initialization') -----
- depth: newDepth
- "set the extent to be used with this canvas"
- depth := newDepth.!
Item was removed:
- ----- Method: MultiCanvas>>extent (in category 'accessing') -----
- extent
- ^extent!
Item was removed:
- ----- Method: MultiCanvas>>extent: (in category 'initialization') -----
- extent: newExtent
- "set the extent to be used with this canvas"
- extent := newExtent.!
Item was removed:
- ----- Method: MultiCanvas>>initialize (in category 'initialization') -----
- initialize
- canvases := Set new.
- extent := 600 at 400.
- depth := 32. !
Item was removed:
- ----- Method: MultiCanvas>>removeCanvas: (in category 'accessing') -----
- removeCanvas: aCanvas
- canvases remove: aCanvas ifAbsent: []!
Item was removed:
- PluggableButtonMorph subclass: #MultiWindowLabelButtonMorph
- instanceVariableNames: 'savedMultiWindowState'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
-
- !MultiWindowLabelButtonMorph commentStamp: 'eem 6/30/2010 16:13' prior: 0!
- A MultiWindowLabelButtonMorph is a means of implementing tabbed windows. It cooperates with PluggableSystemWindowWithButton to provide a drop-down menu of windows when clicking in the window label. It requires the model to create a suitable sub-instance of SavedMultiWindowState for inactive windows. To specify multi-windows use the multiWindowStyle: setter to customize a PluggableWindowSpec.
-
- Instance Variables
- savedMultiWindowState: <SavedMultiWindowState>
-
- savedMultiWindowState
- - the sequence of models in a multi-window.!
Item was removed:
- ----- Method: MultiWindowLabelButtonMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- "Be invisible."!
Item was removed:
- ----- Method: MultiWindowLabelButtonMorph>>mouseEnter: (in category 'event handling') -----
- mouseEnter: evt
-
- super mouseEnter: evt.
- evt hand showTemporaryCursor: Cursor menu.!
Item was removed:
- ----- Method: MultiWindowLabelButtonMorph>>mouseLeave: (in category 'event handling') -----
- mouseLeave: evt
-
- super mouseLeave: evt.
- evt hand showTemporaryCursor: nil.!
Item was removed:
- ----- Method: MultiWindowLabelButtonMorph>>performAction (in category 'accessing') -----
- performAction
- "Override to interpret the actionSelector as a menu accessor and to activate that menu."
-
- actionSelector ifNil: [^ self].
- (model perform: actionSelector) ifNotNil: [:menu |
- menu
- invokeModalAt: self position - (0 at 5)
- in: self currentWorld
- allowKeyboard: Preferences menuKeyboardControl]!
Item was removed:
- ----- Method: MultiWindowLabelButtonMorph>>savedMultiWindowState (in category 'accessing') -----
- savedMultiWindowState
- "Answer the value of savedMultiWindowState"
-
- ^ savedMultiWindowState!
Item was removed:
- ----- Method: MultiWindowLabelButtonMorph>>savedMultiWindowState: (in category 'accessing') -----
- savedMultiWindowState: anObject
- "Set the value of savedMultiWindowState"
-
- savedMultiWindowState := anObject!
Item was removed:
- UpdatingStringMorph subclass: #NameStringInHalo
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !NameStringInHalo commentStamp: 'kfr 10/27/2003 16:29' prior: 0!
- Shows the name of the morph in the halo. !
Item was removed:
- ----- Method: NameStringInHalo>>cancelEdits (in category 'editing') -----
- cancelEdits
- self interimContents: target externalName.
- super cancelEdits!
Item was removed:
- ----- Method: NameStringInHalo>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- aCanvas fillRectangle: self bounds color: Color white.
- super drawOn: aCanvas.!
Item was removed:
- ----- Method: NameStringInHalo>>interimContents: (in category 'accessing') -----
- interimContents: aString
- self contents: aString.
- self placeContents!
Item was removed:
- ----- Method: NameStringInHalo>>placeContents (in category 'private') -----
- placeContents
- | namePosition |
- (owner notNil and: [owner isInWorld]) ifTrue:
- [namePosition := owner basicBox bottomCenter -
- ((self width // 2) @ (owner handleSize negated // 2 - 1)).
- namePosition := namePosition min: self world viewBox bottomRight - self extent y + 2.
- self bounds: (namePosition extent: self extent)]!
Item was removed:
- Morph subclass: #NewBalloonMorph
- instanceVariableNames: 'balloonOwner textMorph orientation hasTail'
- classVariableNames: 'UseNewBalloonMorph'
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !NewBalloonMorph commentStamp: 'mt 3/31/2015 10:15' prior: 0!
- A balloon is a bubble with an optional tail. It contains rich text, which describes something about its balloon-owner.!
Item was removed:
- ----- Method: NewBalloonMorph class>>string:for: (in category 'instance creation') -----
- string: str for: morph
-
- ^ self string: str for: morph corner: #bottomLeft!
Item was removed:
- ----- Method: NewBalloonMorph class>>string:for:corner: (in category 'instance creation') -----
- string: message for: morph corner: symbol
-
- ^ self new
- balloonOwner: morph;
- setText: message;
- orientation: symbol;
- yourself!
Item was removed:
- ----- Method: NewBalloonMorph class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ super themeProperties, {
- { #borderColor. 'Colors'. 'Color of the balloon''s border.' }.
- { #borderWidth. 'Borders'. 'Width of the balloon''s border.' }.
- { #color. 'Colors', 'Color for the balloon background.' }.
- { #font. 'Fonts'. 'Font for balloon text if not overridden by text attributes.' }.
- { #textColor. 'Colors'. 'Color for the balloon text if not overridden by text attributes.' }.
- }!
Item was removed:
- ----- Method: NewBalloonMorph class>>useNewBalloonMorph (in category 'preferences') -----
- useNewBalloonMorph
-
- <preference: 'Use new-style help balloon morphs'
- category: #Morphic
- description: 'The new-style help balloon morphs are improved for better reading quality and support rich text.'
- type: #Boolean>
- ^ UseNewBalloonMorph ifNil: [true]!
Item was removed:
- ----- Method: NewBalloonMorph class>>useNewBalloonMorph: (in category 'preferences') -----
- useNewBalloonMorph: aBoolean
-
- UseNewBalloonMorph := aBoolean.!
Item was removed:
- ----- Method: NewBalloonMorph>>applyUserInterfaceTheme (in category 'updating') -----
- applyUserInterfaceTheme
-
- super applyUserInterfaceTheme.
- self setDefaultParameters.!
Item was removed:
- ----- Method: NewBalloonMorph>>balloonOwner (in category 'accessing') -----
- balloonOwner
-
- ^ balloonOwner!
Item was removed:
- ----- Method: NewBalloonMorph>>balloonOwner: (in category 'accessing') -----
- balloonOwner: aMorph
-
- balloonOwner == aMorph ifTrue: [^ self].
- balloonOwner := aMorph.
- self updateColorsForBalloonOwner.!
Item was removed:
- ----- Method: NewBalloonMorph>>bubbleBounds (in category 'geometry') -----
- bubbleBounds
-
- ^ self bounds insetBy: (0 @ self tailHeight corner: 0 @ self tailHeight)!
Item was removed:
- ----- Method: NewBalloonMorph>>bubbleInset (in category 'geometry') -----
- bubbleInset
-
- ^ (5 at 3 * RealEstateAgent scaleFactor) truncated!
Item was removed:
- ----- Method: NewBalloonMorph>>color: (in category 'accessing') -----
- color: aColor
-
- super color: aColor.
- self updateGradient.!
Item was removed:
- ----- Method: NewBalloonMorph>>drawDropShadowOn: (in category 'drawing') -----
- drawDropShadowOn: aCanvas
-
- aCanvas
- translateBy: self shadowOffset
- during: [ :shadowCanvas |
- (shadowCanvas isVisible: self bubbleBounds) ifTrue: [
- self wantsRoundedCorners
- ifTrue: [shadowCanvas fillRoundRect: self bubbleBounds radius: self cornerRadius fillStyle: self shadowColor]
- ifFalse: [shadowCanvas fillRectangle: self bubbleBounds fillStyle: self shadowColor]].
-
- self hasTail ifTrue: [
- shadowCanvas
- drawPolygon: self verticesForTail
- fillStyle: self shadowColor]].
-
- !
Item was removed:
- ----- Method: NewBalloonMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- self fillStyle isColor
- ifFalse: [self fillStyle isGradientFill
- ifTrue: [self fillStyle direction: 0 @ self height]].
- "Bubble."
- self wantsRoundedCorners
- ifTrue: [aCanvas
- frameAndFillRoundRect: self bubbleBounds
- radius: self cornerRadius fillStyle: self fillStyle borderWidth: self borderStyle width borderColor: self borderStyle color]
- ifFalse: [aCanvas
- frameAndFillRectangle: self bubbleBounds
- fillStyle: self fillStyle
- borderStyle: self borderStyle].
-
- "Tail."
- self hasTail ifTrue: [
- self verticesForTail in: [:points |
- | pixelOffset |
- pixelOffset := points first y < points second y
- ifFalse: [points first x < points second x
- ifTrue: [self borderStyle width negated @ self borderStyle width] "bottomLeft"
- ifFalse: [self borderStyle width @ self borderStyle width]] "bottomRight"
- ifTrue: [points first x < points second x
- ifTrue: [self borderStyle width negated @ self borderStyle width negated] "topLeft"
- ifFalse: [self borderStyle width @ self borderStyle width negated]]. "topRight"
-
- aCanvas
- drawPolygon: points
- fillStyle: self fillStyle.
- aCanvas
- line: points first
- to: points second + pixelOffset
- width: self borderStyle width
- color: self borderStyle color.
- aCanvas
- line: points first
- to: points third + pixelOffset
- width: self borderStyle width
- color: self borderStyle color]]!
Item was removed:
- ----- Method: NewBalloonMorph>>hasTail (in category 'accessing') -----
- hasTail
-
- ^ hasTail ifNil: [true]!
Item was removed:
- ----- Method: NewBalloonMorph>>hasTail: (in category 'accessing') -----
- hasTail: aBoolean
-
- hasTail := aBoolean.!
Item was removed:
- ----- Method: NewBalloonMorph>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
- self disableLayout: true.
- self morphicLayerNumber: self class balloonLayer.
-
- self setDefaultParameters.
-
- textMorph := TextMorph new
- hResizing: #shrinkWrap; vResizing: #shrinkWrap;
- averageLineLength: Preferences maxBalloonHelpLineLength;
- lock;
- yourself.
-
- self addMorph: textMorph.!
Item was removed:
- ----- Method: NewBalloonMorph>>move: (in category 'geometry') -----
- move: targetPoint
-
- self perform: self orientation asSimpleSetter with: targetPoint.!
Item was removed:
- ----- Method: NewBalloonMorph>>orientation (in category 'accessing') -----
- orientation
- "Encodes the position of the tail. #topLeft, #topRight, #bottomLeft, #bottomRight"
-
- ^ orientation!
Item was removed:
- ----- Method: NewBalloonMorph>>orientation: (in category 'accessing') -----
- orientation: aSymbol
-
- orientation := aSymbol.
- self changed.!
Item was removed:
- ----- Method: NewBalloonMorph>>popUp (in category 'initialization') -----
- popUp
- "No tail. Centered in the balloon owner. Do not remove other balloon helps."
-
- | w |
- self balloonOwner ifNil: [^ self].
- self balloonOwner isInWorld ifFalse: [^ self].
-
- w := self balloonOwner world.
-
- self hasTail: false.
- self center: self balloonOwner center.
- self bounds: (self bounds translatedToBeWithin: w bounds).
-
- w activeHand addBalloonHelp: self.
- self openInWorld.!
Item was removed:
- ----- Method: NewBalloonMorph>>popUpAt: (in category 'initialization') -----
- popUpAt: point
- "Do not remove other balloon helps."
-
- | w h |
- self balloonOwner ifNil: [^ self].
- self balloonOwner isInWorld ifFalse: [^ self].
-
- w := self balloonOwner world.
- h := w activeHand.
-
- self hasTail: true.
-
- #(bottomLeft topLeft bottomRight topRight) detect: [:nextOrientation |
- | pointWithOffset |
- self orientation: nextOrientation.
- pointWithOffset := point + self tailOffset.
- self move: pointWithOffset.
- self bounds: (self bounds translatedToBeWithin: w bounds).
- (self bounds perform: self orientation) = pointWithOffset] ifNone: ["Keep last try."].
-
- w activeHand addBalloonHelp: self.
- self openInWorld.!
Item was removed:
- ----- Method: NewBalloonMorph>>popUpAt:forHand: (in category 'initialization') -----
- popUpAt: point forHand: aHand
- "Pop up the receiver as balloon help for the given hand"
-
- #(bottomLeft topLeft bottomRight topRight) detect: [:nextOrientation |
- | pointWithOffset |
- self orientation: nextOrientation.
- pointWithOffset := point + self tailOffset.
- self move: pointWithOffset.
- self bounds: (self bounds translatedToBeWithin: aHand world bounds).
- (self bounds perform: self orientation) = pointWithOffset] ifNone: ["Keep last try."].
-
- aHand world addMorphFront: self.
- aHand resetBalloonHelp: self.!
Item was removed:
- ----- Method: NewBalloonMorph>>popUpFor:hand: (in category 'initialization') -----
- popUpFor: aMorph hand: aHand
- "Pop up the receiver as balloon help for the given hand. Ignore if the hand does not touch the morph."
-
- (aMorph boundsInWorld containsPoint: aHand position)
- ifFalse: [^ self "Ignore"].
-
- self balloonOwner: aMorph.
- self popUpForHand: aHand.!
Item was removed:
- ----- Method: NewBalloonMorph>>popUpForHand: (in category 'initialization') -----
- popUpForHand: aHand
-
- self popUpAt: aHand position forHand: aHand.!
Item was removed:
- ----- Method: NewBalloonMorph>>setDefaultParameters (in category 'initialization') -----
- setDefaultParameters
-
- self
- borderWidth: ((self userInterfaceTheme borderWidth ifNil: [1]) * RealEstateAgent scaleFactor) truncated;
- borderColor: (self userInterfaceTheme borderColor ifNil: [Color r: 0.46 g: 0.46 b: 0.353]);
- color: (self userInterfaceTheme color ifNil: [Color r: 0.92 g: 0.92 b: 0.706]);
- hasDropShadow: (Preferences menuAppearance3d and: [self color isTranslucent not]);
- shadowOffset: 1 at 1;
- shadowColor: (self color muchDarker muchDarker alpha: 0.333);
- orientation: #bottomLeft;
- cornerStyle: (MenuMorph roundedMenuCorners ifTrue: [#rounded] ifFalse: [#square]).!
Item was removed:
- ----- Method: NewBalloonMorph>>setText: (in category 'initialization') -----
- setText: stringOrText
-
- | text |
- text := stringOrText asText.
-
- text hasColorAttribute ifFalse: [
- text addAttribute: (TextColor color: (self userInterfaceTheme textColor ifNil: [Color black]))].
- text hasFontAttribute ifFalse: [
- text addAttribute: (TextFontReference toFont: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]))].
-
- self textMorph newContents: text.
- self updateLayout.!
Item was removed:
- ----- Method: NewBalloonMorph>>tailHeight (in category 'geometry') -----
- tailHeight
-
- ^ (8 * RealEstateAgent scaleFactor) truncated!
Item was removed:
- ----- Method: NewBalloonMorph>>tailOffset (in category 'geometry') -----
- tailOffset
-
- ^ (((Dictionary newFrom: {
- #topLeft -> (5 at 0).
- #topRight -> (-3 at 0).
- #bottomLeft -> (1@ -1).
- #bottomRight -> (-3 @ -3)}) at: self orientation) * RealEstateAgent scaleFactor) truncated!
Item was removed:
- ----- Method: NewBalloonMorph>>tailPosition (in category 'geometry') -----
- tailPosition
-
- ^ self innerBounds perform: self orientation!
Item was removed:
- ----- Method: NewBalloonMorph>>tailWidth (in category 'geometry') -----
- tailWidth
-
- ^ (15 * RealEstateAgent scaleFactor) truncated!
Item was removed:
- ----- Method: NewBalloonMorph>>textMorph (in category 'accessing - ui') -----
- textMorph
-
- ^ textMorph!
Item was removed:
- ----- Method: NewBalloonMorph>>updateColorsForBalloonOwner (in category 'updating') -----
- updateColorsForBalloonOwner
-
- self color: self balloonOwner balloonColor.
-
- "If the balloon owner has a custom balloon color, derive the balloon border color from it."
- self flag: #refactor. "mt: Add #balloonBorderColor *width etc. to Morph."
- (self balloonOwner hasProperty: #balloonColor)
- ifTrue: [self borderColor: (self color adjustBrightness: -0.2)].!
Item was removed:
- ----- Method: NewBalloonMorph>>updateGradient (in category 'updating') -----
- updateGradient
-
- | cc fill |
-
- MenuMorph gradientMenu ifFalse: [^ self].
-
- cc := self color.
- fill := GradientFillStyle ramp: {
- 0.0 -> Color white.
- 0.15 -> (cc mixed: 0.5 with: Color white).
- 0.5 -> cc.
- 0.8 -> cc twiceDarker}.
- fill
- origin: self topLeft;
- direction: 0 at self height.
- self fillStyle: fill.!
Item was removed:
- ----- Method: NewBalloonMorph>>updateLayout (in category 'layout') -----
- updateLayout
-
- self textMorph fullBounds.
- self extent: self textMorph extent + (2* self bubbleInset) + (0 @ (2*self tailHeight)).
- self textMorph center: self center.!
Item was removed:
- ----- Method: NewBalloonMorph>>verticesForTail (in category 'drawing') -----
- verticesForTail
-
- | offset factorX factorY tpos bpos |
- offset := (5 * RealEstateAgent scaleFactor) rounded + (self wantsRoundedCorners
- ifTrue: [self cornerRadius]
- ifFalse: [0]).
- tpos := self tailPosition.
- factorX := tpos x < self center x ifTrue: [1] ifFalse: [-1].
- factorY := tpos y > self center y ifTrue: [1] ifFalse: [-1].
- bpos := self bubbleBounds perform: self orientation.
-
- ^ {
- tpos.
- bpos + (((offset + self tailWidth) * factorX) @ (self borderStyle width negated * factorY)).
- bpos + ((offset * factorX) @ (self borderStyle width negated * factorY)).}!
Item was removed:
- Morph subclass: #NewColorPickerMorph
- instanceVariableNames: 'target setColorSelector hsvaMorph colorPresenter'
- classVariableNames: 'UseIt'
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !NewColorPickerMorph commentStamp: 'cmm 12/3/2010 13:36' prior: 0!
- A NewColorPickerMorph is a new widget for choosing colors in Morphic. Instantiate a NewColorPickerMorph:
-
- (NewColorPickerMorph
- on: objectToHaveItsColorSet
- getColorSelector: itsColorGetterSymbol
- setColorSelector: itsColorSetterSymbol) openInWorld
-
- !
Item was removed:
- ----- Method: NewColorPickerMorph class>>on: (in category 'create') -----
- on: anObject
- ^ self
- on: anObject
- originalColor: anObject color
- setColorSelector: #color:!
Item was removed:
- ----- Method: NewColorPickerMorph class>>on:colorSelector: (in category 'create') -----
- on: objectToHaveItsColorSet colorSelector: colorSymbol
- ^ self
- on: objectToHaveItsColorSet
- getColorSelector: colorSymbol
- setColorSelector: colorSymbol asSimpleSetter!
Item was removed:
- ----- Method: NewColorPickerMorph class>>on:getColorSelector:setColorSelector: (in category 'create') -----
- on: objectToHaveItsColorSet getColorSelector: colorGetterSymbol setColorSelector: colorSetterSymbol
- ^ self
- on: objectToHaveItsColorSet
- originalColor: (colorGetterSymbol value: objectToHaveItsColorSet)
- setColorSelector: colorSetterSymbol!
Item was removed:
- ----- Method: NewColorPickerMorph class>>on:originalColor:setColorSelector: (in category 'create') -----
- on: objectToHaveItsColorSet originalColor: originalColor setColorSelector: colorSetterSymbol
- ^ self
- on: objectToHaveItsColorSet
- originalColor: originalColor
- setColorSelector: colorSetterSymbol
- forPropertiesPanel: false!
Item was removed:
- ----- Method: NewColorPickerMorph class>>on:originalColor:setColorSelector:forPropertiesPanel: (in category 'create') -----
- on: objectToHaveItsColorSet originalColor: originalColor setColorSelector: colorSetterSymbol forPropertiesPanel: aBool
- ^ self new
- setTarget: objectToHaveItsColorSet
- originalColor: originalColor
- setColorSelector: colorSetterSymbol
- forPropertiesPanel: aBool!
Item was removed:
- ----- Method: NewColorPickerMorph class>>useIt (in category 'accessing') -----
- useIt
- <preference: 'Use the new color-picker'
- category: 'colors'
- description: 'When true, a newly-enhanced color-picker is used.'
- type: #Boolean>
- ^ UseIt ifNil: [ false ]!
Item was removed:
- ----- Method: NewColorPickerMorph class>>useIt: (in category 'accessing') -----
- useIt: aBoolean
- UseIt := aBoolean!
Item was removed:
- ----- Method: NewColorPickerMorph>>closeButtonLabel (in category 'initialize-release') -----
- closeButtonLabel
- ^ 'Close' translated!
Item was removed:
- ----- Method: NewColorPickerMorph>>colorExpression (in category 'accessing') -----
- colorExpression
- "A Smalltalk which can create this color."
- ^ self selectedColor printString!
Item was removed:
- ----- Method: NewColorPickerMorph>>colorExpression: (in category 'accessing') -----
- colorExpression: aString
- "Set my color by evaluating aString, a Smalltalk expression which results in a Color instance."
- | col |
- {aString.
- 'Color ' , aString}
- detect:
- [ : each | ([ col := Compiler evaluate: each ]
- on: Error
- do:
- [ : err | nil ]) notNil ]
- ifNone: [ nil ].
- col ifNotNil: [ self selectedColor: col ]!
Item was removed:
- ----- Method: NewColorPickerMorph>>colorSelected: (in category 'model') -----
- colorSelected: aColor
- self targetColor: aColor.
- self changed: #colorExpression!
Item was removed:
- ----- Method: NewColorPickerMorph>>initialize (in category 'initialize-release') -----
- initialize
- super initialize.
- self initializeHsvaMorph!
Item was removed:
- ----- Method: NewColorPickerMorph>>initializeHsvaMorph (in category 'initialize-release') -----
- initializeHsvaMorph
- hsvaMorph := HSVAColorSelectorMorph new
- hResizing: #spaceFill ;
- vResizing: #spaceFill ;
- yourself.
- hsvaMorph
- when: #selectedColor
- send: #colorSelected:
- to: self!
Item was removed:
- ----- Method: NewColorPickerMorph>>newBottomRow (in category 'initialize-release') -----
- newBottomRow
- ^ Morph new
- color: Color transparent ;
- changeTableLayout ;
- listDirection: #leftToRight ;
- hResizing: #spaceFill; vResizing: #shrinkWrap ;
- height: 20 ;
- cellGap: 4 ;
- addMorph: (StringMorph contents: 'Current selection:' translated) ;
- addMorphBack: self newColorPresenterMorph ;
- addMorphBack: self newCloseButton!
Item was removed:
- ----- Method: NewColorPickerMorph>>newCloseButton (in category 'initialize-release') -----
- newCloseButton
- ^ (PluggableButtonMorph
- on: self
- getState: nil
- action: #delete
- label: #closeButtonLabel)
- vResizing: #spaceFill ;
- hResizing: #spaceFill;
- yourself!
Item was removed:
- ----- Method: NewColorPickerMorph>>newColorExpressionMorph (in category 'initialize-release') -----
- newColorExpressionMorph
- | inputField builder |
- builder := ToolBuilder default.
- inputField := (builder build: (builder pluggableInputFieldSpec new
- model: self;
- getText: #colorExpression;
- setText: #colorExpression:)).
- inputField
- hResizing: #spaceFill ;
- vResizing: #rigid ;
- height: (Preferences standardDefaultTextFont height * 3/2).
- ^ inputField!
Item was removed:
- ----- Method: NewColorPickerMorph>>newColorPresenterMorph (in category 'initialize-release') -----
- newColorPresenterMorph
- ^ (ColorPresenterMorph
- on: hsvaMorph
- color: #selectedColor)
- vResizing: #rigid ; height: 20 ;
- hResizing: #spaceFill ;
- yourself!
Item was removed:
- ----- Method: NewColorPickerMorph>>selectedColor (in category 'accessing') -----
- selectedColor
- "The color selected."
- ^ hsvaMorph selectedColor!
Item was removed:
- ----- Method: NewColorPickerMorph>>selectedColor: (in category 'accessing') -----
- selectedColor: aColor
- "The color selected."
- hsvaMorph selectedColor: aColor!
Item was removed:
- ----- Method: NewColorPickerMorph>>setColorSelector (in category 'model') -----
- setColorSelector
- "Answer the value of setColorSelector"
-
- ^ setColorSelector!
Item was removed:
- ----- Method: NewColorPickerMorph>>setTarget:originalColor:setColorSelector: (in category 'initialize-release') -----
- setTarget: objectToHaveItsColorSet originalColor: aColor setColorSelector: colorSetterSymbol
- target := objectToHaveItsColorSet.
- setColorSelector := colorSetterSymbol.
- hsvaMorph selectedColor: aColor.
- self setup!
Item was removed:
- ----- Method: NewColorPickerMorph>>setTarget:originalColor:setColorSelector:forPropertiesPanel: (in category 'initialize-release') -----
- setTarget: objectToHaveItsColorSet originalColor: aColor setColorSelector: colorSetterSymbol forPropertiesPanel: aBool
- target := objectToHaveItsColorSet.
- setColorSelector := colorSetterSymbol.
- hsvaMorph selectedColor: aColor.
- aBool
- ifTrue: [self setupForProperties]
- ifFalse: [self setup]!
Item was removed:
- ----- Method: NewColorPickerMorph>>setup (in category 'initialize-release') -----
- setup
- self
- color: (Color white darker) ;
- cornerStyle: #rounded ;
- changeTableLayout ;
- hResizing: #shrinkWrap ;
- vResizing: #shrinkWrap ;
- extent: 240 at 240 ;
- addMorphBack: hsvaMorph ;
- addMorphBack: self newColorExpressionMorph ;
- addMorphBack: self newBottomRow ;
- layoutInset: 4 ;
- cellGap: 2.
-
- Preferences menuAppearance3d
- ifTrue: [self addDropShadow].
- !
Item was removed:
- ----- Method: NewColorPickerMorph>>setupForProperties (in category 'initialize-release') -----
- setupForProperties
- self
- color: (Color white darker) ;
- changeTableLayout ;
- hResizing: #shrinkWrap ;
- vResizing: #shrinkWrap ;
- extent: 240 at 240 ;
- addMorphBack: hsvaMorph ;
- layoutInset: 4 ;
- cellGap: 2.!
Item was removed:
- ----- Method: NewColorPickerMorph>>target (in category 'model') -----
- target
- "Answer the object whose color will be controlled."
- ^ target!
Item was removed:
- ----- Method: NewColorPickerMorph>>targetColor: (in category 'accessing') -----
- targetColor: aColor
- "The color of my target."
- target ifNotNil:
- [ target
- perform: setColorSelector
- with: aColor ]!
Item was removed:
- HandleMorph subclass: #NewHandleMorph
- instanceVariableNames: 'hand offset waitingForClickInside'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
Item was removed:
- ----- Method: NewHandleMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
- includeInNewMorphMenu
- ^ false!
Item was removed:
- ----- Method: NewHandleMorph>>delete (in category 'submorphs - add/remove') -----
- delete
- hand ifNotNil:[
- hand showTemporaryCursor: nil.
- ].
- super delete.!
Item was removed:
- ----- Method: NewHandleMorph>>followHand:forEachPointDo:lastPointDo: (in category 'resize/collapse') -----
- followHand: aHand forEachPointDo: block1 lastPointDo: block2
- hand := aHand.
- pointBlock := block1.
- lastPointBlock := block2.
- self position: hand lastEvent cursorPoint - (self extent // 2)!
Item was removed:
- ----- Method: NewHandleMorph>>followHand:forEachPointDo:lastPointDo:withCursor: (in category 'resize/collapse') -----
- followHand: aHand forEachPointDo: block1 lastPointDo: block2 withCursor: aCursor
-
- hand := aHand.
- hand showTemporaryCursor: aCursor "hotSpotOffset: aCursor offset negated".
-
- color := Color transparent.
- pointBlock := block1.
- lastPointBlock := block2.
-
- self borderWidth: 0.
- self position: hand lastEvent cursorPoint - (self extent // 2)!
Item was removed:
- ----- Method: NewHandleMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
-
- super initialize.
- ""
- waitingForClickInside := true.
- Preferences noviceMode
- ifTrue: [self setBalloonText: 'stretch']!
Item was removed:
- ----- Method: NewHandleMorph>>justDroppedInto:event: (in category 'dropping/grabbing') -----
- justDroppedInto: aMorph event: anEvent
- "No dropping behavior because stepping will delete me.
- Moreover it needs to be done that way to evaluate lastPointBlock"
- !
Item was removed:
- ----- Method: NewHandleMorph>>sensorMode (in category 'accessing') -----
- sensorMode
-
- "If our client is still addressing the Sensor directly, we need to do so as well"
- ^self valueOfProperty: #sensorMode ifAbsent: [false].
- !
Item was removed:
- ----- Method: NewHandleMorph>>sensorMode: (in category 'accessing') -----
- sensorMode: aBoolean
-
- "If our client is still addressing the Sensor directly, we need to do so as well"
- self setProperty: #sensorMode toValue: aBoolean.
- !
Item was removed:
- ----- Method: NewHandleMorph>>step (in category 'stepping and presenter') -----
- step
- | eventSource |
-
- eventSource := self sensorMode ifTrue: [
- Sensor
- ] ifFalse: [
- hand lastEvent
- ].
- eventSource anyButtonPressed
- ifTrue: [waitingForClickInside := false.
- self position: eventSource cursorPoint - (self extent // 2).
- pointBlock value: self center]
- ifFalse: [waitingForClickInside
- ifTrue: [(self containsPoint: eventSource cursorPoint)
- ifFalse: ["mouse wandered out before clicked"
- ^ self delete]]
- ifFalse: [lastPointBlock value: self center.
- ^ self delete]]!
Item was removed:
- ----- Method: NewHandleMorph>>undoGrabCommand (in category 'dropping/grabbing') -----
- undoGrabCommand
- ^nil!
Item was removed:
- Object subclass: #NewParagraph
- instanceVariableNames: 'text textStyle firstCharacterIndex container containerUnadjusted lines positionWhenComposed offsetToEnd maxRightX selectionStart selectionStop wantsColumnBreaks focused caretRect showCaret caretColor selectionColor unfocusedSelectionColor'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Text Support'!
-
- !NewParagraph commentStamp: '<historical>' prior: 0!
- A Paragraph represents text that has been laid out, or composed, in some container.
- text A Text with encoded per-character emphasis.
- textStyle A TextStyle with font set, line height and horizontal alignment.
- firstCharacterIndex The starting index in text for this paragraph, allowing
- composition of a long text into a number of containers.
- container A Rectangle or TextContainer that determines where text can go.
- lines An Array of TextLines comprising the final layout of the text
- after it has been composed within its container.
- positionWhenComposed As its name implies. Allows display at new locations
- without the need to recompose the text.
- Lines are ordered vertically. However, for a given y, there may be several lines in left to right order. Lines must never be empty, even if text is empty.
-
- Notes on yet another hack - 5 Feb 2001
-
- We really need to clean up #composeLinesFrom:to:delta:into:priorLines:atY:!!!!!!
-
- I added one more habdful of code to correct:
-
- This is an annoying bug that's been around for a couple of years, but I finally figured out how to duplicate the problem, so I figured I'd just report it now. (It doesn't necessarily have to be fixed for 3.0 if it looks messy, but if it's a simple fix, it would be worth it.)
-
- In Morphic, if you have the following text in a workspace:
-
- This is line 1
- This is line 2
-
- **and** you have a return character after line 2, you will normally be able to click the mouse two times below line 2 in order to select all the text. If you edit line 2 (e.g. so that it reads "line number 2"), you can still select all the text by clicking below the second line. However, if you edit line 1, you will not be able to select all the text from the bottom in the same way. Things get messed up such that the last return character seems to be gone. In this state, if you position the cursor immediately after the 2, and press the right arrow, the cursor jumps to the beginning of line 2... oof. (report by Doug Way)
-
- While I don't have a very deep understanding of the above mentioned method, I was able to determine that text ending in a CR worked better in the editor when the last entry in <lines> had a start of text size + 1 and a stop of text size. I have accordingly added code near the end to ensure this. It seems to have fixed the problem, but we do need to clean this baby up some day. - Bob
- !
Item was removed:
- ----- Method: NewParagraph>>adjustLineIndicesBy: (in category 'private') -----
- adjustLineIndicesBy: delta
- firstCharacterIndex := firstCharacterIndex + delta.
- lines do: [:line | line slide: delta].
- !
Item was removed:
- ----- Method: NewParagraph>>adjustRightX (in category 'private') -----
- adjustRightX
-
- self adjustRightXDownTo: 0.!
Item was removed:
- ----- Method: NewParagraph>>adjustRightXDownTo: (in category 'private') -----
- adjustRightXDownTo: minWidth
- | shrink minRight |
- minRight := container left + minWidth.
- shrink := container right - (maxRightX max: minRight).
- lines do: [:line | line paddingWidth: (line paddingWidth - shrink)].
- containerUnadjusted := container.
- container := container withRight: (maxRightX max: minRight).!
Item was removed:
- ----- Method: NewParagraph>>adjustedFirstCharacterIndex (in category 'access') -----
- adjustedFirstCharacterIndex
- "Return the index in the text where this paragraph WOULD begin if nothing had changed, except the size of the text -- ie if there have only been an insertion of deletion in the preceding morphs"
- offsetToEnd ifNil: [^ -1].
- ^ text size - offsetToEnd!
Item was removed:
- ----- Method: NewParagraph>>asParagraphForPostscript (in category 'display') -----
- asParagraphForPostscript
-
- ^ self!
Item was removed:
- ----- Method: NewParagraph>>asText (in category 'converting') -----
- asText
- "Answer the receiver's text after being composed. Use #text if you want to retain the layout before composition."
-
- ^ self asTextWithLineBreaks!
Item was removed:
- ----- Method: NewParagraph>>asTextWithLineBreaks (in category 'converting') -----
- asTextWithLineBreaks
- "Answer a text that has all soft line breaks converted to hard line breaks. Add the current style's default font as a text attribute only if a) the style is not the default and b) the first character has no other font set. See Text >> #asTextMorph."
-
- | result |
- result := Text streamContents: [:s | lines do: [:textLine |
- | lastChar lastIndex break |
- lastChar := text at: textLine last.
- (break := CharacterSet separators includes: lastChar)
- ifTrue: [lastIndex := textLine last - 1]
- ifFalse: [lastIndex := textLine last].
- "1) Copy text line, which may be due to a soft line break"
- s nextPutAll: (text copyFrom: textLine first to: lastIndex).
- "2) Add a hard line break."
- break ifTrue: [s nextPutAll: (String cr asText
- addAllAttributes: (text attributesAt: textLine last);
- yourself)]]].
-
- ((text fontAt: 1 withDefault: nil) isNil and: [
- textStyle defaultFamilyName ~= TextStyle default defaultFamilyName])
- ifTrue: [result addAttribute: (TextFontReference toFont: textStyle defaultFont)].
-
- ^ result!
Item was removed:
- ----- Method: NewParagraph>>attributesAt: (in category 'editing') -----
- attributesAt: aPoint
- "Answer the attributes at the given point"
- ^text attributesAt: (self characterBlockAtPoint: aPoint) stringIndex forStyle: textStyle!
Item was removed:
- ----- Method: NewParagraph>>caretColor (in category 'access') -----
- caretColor
- ^ caretColor ifNil: [Color red]!
Item was removed:
- ----- Method: NewParagraph>>caretColor: (in category 'access') -----
- caretColor: aColor
- caretColor := aColor.!
Item was removed:
- ----- Method: NewParagraph>>caretRect (in category 'access') -----
- caretRect
- "The rectangle in which the caret was last drawn,
- or nil if the last drawing drew a range-selection rather than insertion point."
- ^ caretRect!
Item was removed:
- ----- Method: NewParagraph>>caretWidth (in category 'access') -----
- caretWidth
-
- ^ Editor dumbbellCursor
- ifTrue: [ | w |
- w := (3 * RealEstateAgent scaleFactor) truncated.
- w even ifTrue: [w := w + 1] ifFalse: [w] ]
- ifFalse: [ (2 * RealEstateAgent scaleFactor) truncated ]!
Item was removed:
- ----- Method: NewParagraph>>centered (in category 'alignment') -----
- centered
- textStyle centered!
Item was removed:
- ----- Method: NewParagraph>>characterBlockAtPoint: (in category 'selection') -----
- characterBlockAtPoint: aPoint
- "Answer a CharacterBlock for the character in the text at aPoint."
- | line |
- line := lines at: (self lineIndexForPoint: aPoint).
- ^(CharacterBlockScanner new text: text textStyle: textStyle)
- characterBlockAtPoint: aPoint index: nil
- in: line!
Item was removed:
- ----- Method: NewParagraph>>characterBlockForIndex: (in category 'selection') -----
- characterBlockForIndex: index
- "Answer a CharacterBlock for the character in text at index."
- | line |
- line := lines at: (self lineIndexOfCharacterIndex: index).
- ^ (CharacterBlockScanner new text: text textStyle: textStyle)
- characterBlockAtPoint: nil index: ((index max: line first) min: text size+1)
- in: line!
Item was removed:
- ----- Method: NewParagraph>>clickAt:for:controller: (in category 'editing') -----
- clickAt: clickPoint for: model controller: editor
- "Give sensitive text a chance to fire. Display flash: (100 at 100 extent: 100 at 100)."
- | startBlock action |
- action := false.
- startBlock := self characterBlockAtPoint: clickPoint.
- (text attributesAt: startBlock stringIndex forStyle: textStyle)
- do: [:att | | range target box boxes |
- att mayActOnClick ifTrue:
- [(target := model) ifNil: [target := editor morph].
- range := text rangeOf: att startingAt: startBlock stringIndex.
- boxes := self selectionRectsFrom: (self characterBlockForIndex: range first)
- to: (self characterBlockForIndex: range last+1).
- box := boxes detect: [:each | each containsPoint: clickPoint] ifNone: [nil].
- box ifNotNil:
- [ box := (editor transformFrom: nil) invertBoundsRect: box.
- editor morph allOwnersDo: [ :m | box := box intersect: (m boundsInWorld) ].
- self flag: #fix. "mt: Make it stateful and with real events."
- Utilities awaitMouseUpIn: box
- repeating: []
- ifSucceed: [(att actOnClickFor: target in: self at: clickPoint editor: editor) ifTrue: [action := true]].
- Cursor currentCursor == Cursor webLink ifTrue:[Cursor normal show].
- ]]].
- ^ action!
Item was removed:
- ----- Method: NewParagraph>>compose:style:from:in: (in category 'composition') -----
- compose: t style: ts from: startingIndex in: textContainer
- text := t.
- textStyle := ts.
- firstCharacterIndex := startingIndex.
- offsetToEnd := text size - firstCharacterIndex.
- container := textContainer.
- containerUnadjusted := nil.
- self composeAll!
Item was removed:
- ----- Method: NewParagraph>>composeAll (in category 'composition') -----
- composeAll
- self composeLinesFrom: firstCharacterIndex to: text size delta: 0
- into: OrderedCollection new priorLines: Array new atY: container top!
Item was removed:
- ----- Method: NewParagraph>>composeAllStartingAt: (in category 'composition') -----
- composeAllStartingAt: characterIndex
- firstCharacterIndex := characterIndex.
- offsetToEnd := text size - firstCharacterIndex.
- self composeAll!
Item was removed:
- ----- Method: NewParagraph>>composeLinesFrom:to:delta:into:priorLines:atY: (in category 'composition') -----
- composeLinesFrom: start to: stop delta: delta into: lineColl priorLines: priorLines
- atY: startingY
- "While the section from start to stop has changed, composition may ripple all the way to the end of the text. However in a rectangular container, if we ever find a line beginning with the same character as before (ie corresponding to delta in the old lines), then we can just copy the old lines from there to the end of the container, with adjusted indices and y-values"
-
- | newResult |
-
- newResult := TextComposer new
- composeLinesFrom: start
- to: stop
- delta: delta
- into: lineColl
- priorLines: priorLines
- atY: startingY
- textStyle: textStyle
- text: text
- container: container
- wantsColumnBreaks: wantsColumnBreaks == true.
- lines := newResult first asArray.
- maxRightX := newResult second.
- ^maxRightX
- !
Item was removed:
- ----- Method: NewParagraph>>compositionRectangle (in category 'composition') -----
- compositionRectangle
- ^ container!
Item was removed:
- ----- Method: NewParagraph>>containsPoint: (in category 'selection') -----
- containsPoint: aPoint
- ^ (lines at: (self lineIndexForPoint: aPoint)) rectangle
- containsPoint: aPoint!
Item was removed:
- ----- Method: NewParagraph>>deepCopy (in category 'copying') -----
- deepCopy
- "Don't want to copy the container (etc) or fonts in the TextStyle."
- | new |
- new := self copy.
- new textStyle: textStyle copy
- lines: lines copy
- text: text deepCopy.
- ^ new!
Item was removed:
- ----- Method: NewParagraph>>defaultCharacterBlock (in category 'selection') -----
- defaultCharacterBlock
- ^ (CharacterBlock new stringIndex: firstCharacterIndex text: text
- topLeft: lines first topLeft extent: 0 @ 0)
- textLine: lines first!
Item was removed:
- ----- Method: NewParagraph>>displayDumbbellCursorOn:at:in: (in category 'display') -----
- displayDumbbellCursorOn: aCanvas at: leftX in: line
- "Draw a dumbbell-shaped cursor. Draw lines instead of a polygon to hopefully be faster."
-
- | w wHalf b |
- w := caretRect width.
- wHalf := w // 2.
- b := wHalf - 1.
- b even ifTrue: [b := b - 1].
- b := b max: 1.
-
- 1 to: wHalf+1 do: [:i | "Draw caret triangles at top and bottom"
- aCanvas
- line: leftX + i - 1 @ (line top + i - 1)
- to: leftX + w - i @ (line top + i - 1)
- color: self caretColor.
- aCanvas
- line: leftX + i - 1 @ (line bottom - i)
- to: leftX + w - i @ (line bottom - i)
- color: self caretColor].
-
- b = 1
- ifTrue: [
- aCanvas
- line: leftX + wHalf @ line top
- to: leftX + wHalf @ (line bottom-1)
- color: self caretColor]
- ifFalse: [ | o |
- o := leftX + wHalf - (b//2).
- aCanvas
- fillRectangle: (o @ line top corner: o + b @ line bottom)
- color: self caretColor]!
Item was removed:
- ----- Method: NewParagraph>>displayOn:using:at: (in category 'fonts-display') -----
- displayOn: aCanvas using: displayScanner at: somePosition
- "Send all visible lines to the displayScanner for display"
- | visibleRectangle offset leftInRun line |
- visibleRectangle := aCanvas clipRect.
- offset := (somePosition - positionWhenComposed) truncated.
- leftInRun := 0.
- (self lineIndexForPoint: visibleRectangle topLeft)
- to: (self lineIndexForPoint: visibleRectangle bottomRight)
- do: [:i | line := lines at: i.
- self displaySelectionInLine: line on: aCanvas.
- line first <= line last ifTrue:
- [leftInRun := displayScanner displayLine: line
- offset: offset leftInRun: leftInRun]].
- !
Item was removed:
- ----- Method: NewParagraph>>displaySelectionInLine:on: (in category 'display') -----
- displaySelectionInLine: line on: aCanvas
- | leftX rightX |
- selectionStart ifNil: [^self]. "No selection"
- aCanvas isShadowDrawing ifTrue: [ ^self ]. "don't draw selection with shadow"
- selectionStart = selectionStop
- ifTrue:
- ["Only show caret on line where clicked"
-
- selectionStart textLine ~= line ifTrue: [^self]]
- ifFalse:
- ["Test entire selection before or after here"
-
- (selectionStop stringIndex < line first
- or: [selectionStart stringIndex > (line last + 1)]) ifTrue: [^self]. "No selection on this line"
- (selectionStop stringIndex = line first
- and: [selectionStop textLine ~= line]) ifTrue: [^self]. "Selection ends on line above"
- (selectionStart stringIndex = (line last + 1)
- and: [selectionStop textLine ~= line]) ifTrue: [^self]]. "Selection begins on line below"
- leftX := (selectionStart stringIndex <= line first
- ifTrue: [line ]
- ifFalse: [selectionStart ])left.
- rightX := (selectionStop stringIndex > (line last + 1) or:
- [selectionStop stringIndex = (line last + 1)
- and: [selectionStop textLine ~= line]])
- ifTrue: [line right]
- ifFalse: [selectionStop left].
- selectionStart = selectionStop
- ifTrue: [ | w pos |
- w := caretRect ifNotNil: [caretRect width] ifNil: [self caretWidth].
- pos := leftX - (w // 2).
- caretRect := pos @ line top corner: (pos + w) @ line bottom.
- (self showCaret and: [self focused]) ifFalse: [^ self].
- Editor dumbbellCursor
- ifTrue: [self displayDumbbellCursorOn: aCanvas at: pos in: line]
- ifFalse: [self displaySimpleCursorOn: aCanvas at: pos in: line]]
- ifFalse: [
- caretRect := nil.
- aCanvas fillRectangle: (leftX @ line top corner: rightX @ line bottom)
- color: (self focused ifTrue: [self selectionColor] ifFalse: [self unfocusedSelectionColor])]!
Item was removed:
- ----- Method: NewParagraph>>displaySimpleCursorOn:at:in: (in category 'display') -----
- displaySimpleCursorOn: aCanvas at: leftX in: line
-
- | w aa |
- w := caretRect width // 2 max: 1.
- aa := caretRect width - w.
-
- w = 1
- ifFalse: [
- aCanvas
- fillRectangle: (leftX @ line top corner: leftX + w @ line bottom)
- color: self caretColor]
- ifTrue: [
- aCanvas
- line: leftX @ line top
- to: leftX @ (line bottom-1)
- color: self caretColor].
-
- aa > 0 ifTrue: [
- aa = 1
- ifFalse: [
- aCanvas
- fillRectangle: (leftX+w @ line top rect: leftX+w +aa @ line bottom)
- color: (self caretColor alpha: 0.3)]
- ifTrue: [
- aCanvas
- line: leftX+w @ line top
- to: leftX+w @ (line bottom-1)
- color: (self caretColor alpha: 0.3)]].!
Item was removed:
- ----- Method: NewParagraph>>extent (in category 'access') -----
- extent
- ^ container width @ (lines last bottom - lines first top)!
Item was removed:
- ----- Method: NewParagraph>>fastFindFirstLineSuchThat: (in category 'private') -----
- fastFindFirstLineSuchThat: lineBlock
- "Perform a binary search of the lines array and return the index
- of the first element for which lineBlock evaluates as true.
- This assumes the condition is one that goes from false to true for
- increasing line numbers (as, eg, yval > somey or start char > somex).
- If lineBlock is not true for any element, return size+1."
- lines ifNil:
- [self composeAll].
- ^lines
- findBinaryIndex: [ :each |
- (lineBlock value: each)
- ifTrue: [ -1 ]
- ifFalse: [ 1 ] ]
- ifNone: [ :lower :upper | upper ]!
Item was removed:
- ----- Method: NewParagraph>>firstCharacterIndex (in category 'access') -----
- firstCharacterIndex
- ^ firstCharacterIndex!
Item was removed:
- ----- Method: NewParagraph>>focused (in category 'access') -----
- focused
- focused ifNil: [focused := false].
- ^ focused!
Item was removed:
- ----- Method: NewParagraph>>focused: (in category 'access') -----
- focused: aBoolean
- focused := aBoolean!
Item was removed:
- ----- Method: NewParagraph>>indentationOfLineIndex:ifBlank: (in category 'private') -----
- indentationOfLineIndex: lineIndex ifBlank: aBlock
- "Answer the number of leading tabs in the line at lineIndex. If there are
- no visible characters, pass the number of tabs to aBlock and return its value.
- If the line is word-wrap overflow, back up a line and recur."
-
- | arrayIndex first last crlf |
- crlf := CharacterSet crlf.
- arrayIndex := lineIndex.
- [first := (lines at: arrayIndex) first.
- first > 1 and: [crlf includes: (text string at: first - 1)]] whileTrue: "word wrap"
- [arrayIndex := arrayIndex - 1].
- last := (lines at: arrayIndex) last.
-
- ^(text string copyFrom: first to: last) indentationIfBlank: aBlock.
- !
Item was removed:
- ----- Method: NewParagraph>>initialize (in category 'initialize-release') -----
- initialize
- self positionWhenComposed: 0 @ 0!
Item was removed:
- ----- Method: NewParagraph>>justified (in category 'alignment') -----
- justified
- textStyle justified!
Item was removed:
- ----- Method: NewParagraph>>lastCharacterIndex (in category 'access') -----
- lastCharacterIndex
- ^ lines last last!
Item was removed:
- ----- Method: NewParagraph>>lastLine (in category 'private') -----
- lastLine
-
- ^lines last!
Item was removed:
- ----- Method: NewParagraph>>leftFlush (in category 'alignment') -----
- leftFlush
- textStyle leftFlush!
Item was removed:
- ----- Method: NewParagraph>>lineIndexForPoint: (in category 'private') -----
- lineIndexForPoint: aPoint
- "Answer the index of the line in which to select the character nearest to aPoint."
- | i py |
- py := aPoint y truncated.
-
- "Find the first line at this y-value"
- i := (self fastFindFirstLineSuchThat: [:line | line bottom > py]) min: lines size.
-
- "Now find the first line at this x-value"
- [i < lines size and: [(lines at: i+1) top = (lines at: i) top
- and: [aPoint x >= (lines at: i+1) left]]]
- whileTrue: [i := i + 1].
- ^ i!
Item was removed:
- ----- Method: NewParagraph>>lineIndexOfCharacterIndex: (in category 'private') -----
- lineIndexOfCharacterIndex: index
- "Answer the index of the line in which to select the character at index."
- ^ (self fastFindFirstLineSuchThat: [:line | line first > index]) - 1 max: 1!
Item was removed:
- ----- Method: NewParagraph>>lines (in category 'private') -----
- lines
- ^ lines!
Item was removed:
- ----- Method: NewParagraph>>moveBy: (in category 'private') -----
- moveBy: delta
- lines do: [:line | line moveBy: delta].
- positionWhenComposed ifNotNil:[
- positionWhenComposed := positionWhenComposed + delta].
- container := container translateBy: delta!
Item was removed:
- ----- Method: NewParagraph>>numberOfLines (in category 'access') -----
- numberOfLines
-
- ^lines size!
Item was removed:
- ----- Method: NewParagraph>>positionWhenComposed: (in category 'private') -----
- positionWhenComposed: pos
- positionWhenComposed := pos!
Item was removed:
- ----- Method: NewParagraph>>recomposeFrom:to:delta: (in category 'composition') -----
- recomposeFrom: start to: stop delta: delta
- "Recompose this paragraph. The altered portion is between start and stop.
- Recomposition may continue to the end of the text, due to a ripple effect.
- Delta is the amount by which the current text is longer than it was
- when its current lines were composed."
- | startLine newLines |
- containerUnadjusted ifNotNil: [
- "Somebody called #adjustRightX. We must recompose everything to
- avoid strange line breaks and clipping."
- container := container topLeft extent: containerUnadjusted extent.
- self composeAll; adjustRightX.
- ^ self].
-
- "Have to recompose line above in case a word-break was affected."
- startLine := (self lineIndexOfCharacterIndex: start) - 1 max: 1.
- [startLine > 1 and: [(lines at: startLine-1) top = (lines at: startLine) top]]
- whileTrue: [startLine := startLine - 1]. "Find leftmost of line pieces"
- newLines := OrderedCollection new: lines size + 1.
- 1 to: startLine-1 do: [:i | newLines addLast: (lines at: i)].
- self composeLinesFrom: (lines at: startLine) first to: stop delta: delta
- into: newLines priorLines: lines
- atY: (lines at: startLine) top!
Item was removed:
- ----- Method: NewParagraph>>replaceFrom:to:with: (in category 'editing') -----
- replaceFrom: start to: stop with: aText
- "Edit the text, and then recompose the lines."
- text replaceFrom: start to: stop with: aText.
- self recomposeFrom: start to: start + aText size - 1 delta: aText size - (stop-start+1)!
Item was removed:
- ----- Method: NewParagraph>>replaceFrom:to:with:displaying: (in category 'editing') -----
- replaceFrom: start to: stop with: aText displaying: displayBoolean
- "Edit the text, and then recompose the lines."
- text replaceFrom: start to: stop with: aText.
- self recomposeFrom: start to: start + aText size - 1 delta: aText size - (stop-start+1)!
Item was removed:
- ----- Method: NewParagraph>>rightFlush (in category 'alignment') -----
- rightFlush
- textStyle rightFlush!
Item was removed:
- ----- Method: NewParagraph>>selectionColor (in category 'access') -----
- selectionColor
- ^ selectionColor ifNil: [Color blue muchLighter]!
Item was removed:
- ----- Method: NewParagraph>>selectionColor: (in category 'access') -----
- selectionColor: aColor
- selectionColor := aColor.!
Item was removed:
- ----- Method: NewParagraph>>selectionRects (in category 'selection') -----
- selectionRects
- "Return an array of rectangles representing the selection region."
- selectionStart ifNil: [^ Array new].
- ^ self selectionRectsFrom: selectionStart to: selectionStop!
Item was removed:
- ----- Method: NewParagraph>>selectionRectsFrom:to: (in category 'selection') -----
- selectionRectsFrom: characterBlock1 to: characterBlock2
- "Return an array of rectangles representing the area between the two character blocks given as arguments."
- | line1 line2 rects cb1 cb2 w |
- characterBlock1 <= characterBlock2
- ifTrue: [cb1 := characterBlock1. cb2 := characterBlock2]
- ifFalse: [cb2 := characterBlock1. cb1 := characterBlock2].
- cb1 = cb2 ifTrue:
- [w := self caretWidth.
- ^ Array with: (cb1 topLeft - (w at 0) corner: cb1 bottomLeft + ((w+1)@0))].
- line1 := self lineIndexOfCharacterIndex: cb1 stringIndex.
- line2 := self lineIndexOfCharacterIndex: cb2 stringIndex.
- cb1 top = (lines at: line1) top
- ifFalse:
- ["a word did not fit on prev line - start selection on prev line"
- line1 := line1 - 1 max: 1].
- line1 = line2 ifTrue:
- [^ Array with: (cb1 topLeft corner: cb2 bottomRight)].
- rects := OrderedCollection new.
- rects addLast: (cb1 topLeft corner: (lines at: line1) bottomRight).
- line1+1 to: line2-1 do: [ :i |
- | line |
- line := lines at: i.
- (line left = rects last left and: [ line right = rects last right ])
- ifTrue: [ "new line has same margins as old one -- merge them, so that the caller gets as few rectangles as possible"
- | lastRect |
- lastRect := rects removeLast.
- rects add: (lastRect bottom: line bottom) ]
- ifFalse: [ "differing margins; cannot merge"
- rects add: line rectangle ] ].
-
- rects addLast: ((lines at: line2) topLeft corner: cb2 bottomLeft).
- ^ rects!
Item was removed:
- ----- Method: NewParagraph>>selectionStart:selectionStop: (in category 'selection') -----
- selectionStart: startBlock selectionStop: stopBlock
- selectionStart := startBlock.
- selectionStop := stopBlock.!
Item was removed:
- ----- Method: NewParagraph>>showCaret (in category 'access') -----
- showCaret
- ^showCaret ifNil:[true]
- !
Item was removed:
- ----- Method: NewParagraph>>showCaret: (in category 'access') -----
- showCaret: aBool
- showCaret := aBool
- !
Item was removed:
- ----- Method: NewParagraph>>string (in category 'access') -----
- string
- ^ text string!
Item was removed:
- ----- Method: NewParagraph>>text (in category 'access') -----
- text
- ^ text!
Item was removed:
- ----- Method: NewParagraph>>textOwner: (in category 'access') -----
- textOwner: ignored "See TextOnCurve"!
Item was removed:
- ----- Method: NewParagraph>>textStyle (in category 'access') -----
- textStyle
- ^ textStyle!
Item was removed:
- ----- Method: NewParagraph>>textStyle: (in category 'access') -----
- textStyle: aTextStyle
- "Set the style by which the receiver should display its text."
- textStyle := aTextStyle!
Item was removed:
- ----- Method: NewParagraph>>textStyle:lines:text: (in category 'private') -----
- textStyle: ts lines: l text: t
- "Private -- just a service for deepCopy"
- textStyle := ts.
- lines := l.
- text := t.!
Item was removed:
- ----- Method: NewParagraph>>unfocusedSelectionColor (in category 'access') -----
- unfocusedSelectionColor
- ^ unfocusedSelectionColor ifNil: [Color gray: 0.9]!
Item was removed:
- ----- Method: NewParagraph>>unfocusedSelectionColor: (in category 'access') -----
- unfocusedSelectionColor: aColor
- unfocusedSelectionColor := aColor.!
Item was removed:
- ----- Method: NewParagraph>>wantsColumnBreaks (in category 'access') -----
- wantsColumnBreaks
-
- ^wantsColumnBreaks!
Item was removed:
- ----- Method: NewParagraph>>wantsColumnBreaks: (in category 'access') -----
- wantsColumnBreaks: aBoolean
-
- wantsColumnBreaks := aBoolean!
Item was removed:
- PluggableCanvas subclass: #NullCanvas
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Support'!
-
- !NullCanvas commentStamp: '<historical>' prior: 0!
- A canvas which ignores all drawing commands.!
Item was removed:
- ----- Method: NullCanvas>>clipBy:during: (in category 'drawing-support') -----
- clipBy: region during: aBlock
- "do this in order that timing runs work better"
- aBlock value: self!
Item was removed:
- ----- Method: NullCanvas>>clipRect (in category 'accessing') -----
- clipRect
- ^1 at 1 extent: 99 at 99!
Item was removed:
- ----- Method: NullCanvas>>copyClipRect: (in category 'copying') -----
- copyClipRect: clipRect
- "who cares what the clipping rectangle is?"
- ^self!
Item was removed:
- ----- Method: NullCanvas>>extent (in category 'accessing') -----
- extent
- ^100 at 100!
Item was removed:
- ----- Method: NullCanvas>>form (in category 'accessing') -----
- form
- ^Form extent: self extent!
Item was removed:
- ----- Method: NullCanvas>>origin (in category 'accessing') -----
- origin
- ^0 at 0!
Item was removed:
- ----- Method: NullCanvas>>transformBy:clippingTo:during:smoothing: (in category 'drawing-support') -----
- transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize
- "do this in order that timing runs work better"
- aBlock value: self!
Item was removed:
- ----- Method: NullCanvas>>translateBy:during: (in category 'drawing-support') -----
- translateBy: delta during: aBlock
- "do this in order that timing runs work better"
- aBlock value: self!
Item was removed:
- Object subclass: #NullEncoder
- instanceVariableNames: 'target filterSelector'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Support'!
Item was removed:
- ----- Method: NullEncoder class>>defaultTarget (in category 'configuring') -----
- defaultTarget
- ^OrderedCollection new.
- !
Item was removed:
- ----- Method: NullEncoder class>>filterSelector (in category 'configuring') -----
- filterSelector
- ^#writeOnFilterStream:
- !
Item was removed:
- ----- Method: NullEncoder class>>process: (in category 'processing') -----
- process:anObject
- ^self stream process:anObject.
-
- !
Item was removed:
- ----- Method: NullEncoder class>>stream (in category 'creation') -----
- stream
- ^self streamOn:self defaultTarget.
- !
Item was removed:
- ----- Method: NullEncoder class>>stream: (in category 'creation') -----
- stream:newTarget
- ^self new initWithTarget:newTarget.
- !
Item was removed:
- ----- Method: NullEncoder class>>streamOn: (in category 'creation') -----
- streamOn:newTargetCollection
- ^self new initWithTarget:newTargetCollection.
- !
Item was removed:
- ----- Method: NullEncoder class>>streamOnFile: (in category 'creation') -----
- streamOnFile:fileName
- ^self new initWithTarget:(FileStream newFileNamed: fileName).
- !
Item was removed:
- ----- Method: NullEncoder>>close (in category 'accessing') -----
- close
-
- ^target close.
- !
Item was removed:
- ----- Method: NullEncoder>>contents (in category 'accessing') -----
- contents
- ^target contents.
- !
Item was removed:
- ----- Method: NullEncoder>>forward: (in category 'writing') -----
- forward:anObject
- anObject ~= nil ifTrue:[target write:anObject].
- !
Item was removed:
- ----- Method: NullEncoder>>initWithTarget: (in category 'initialization') -----
- initWithTarget:aTarget
- target := aTarget.
- filterSelector := self class filterSelector.
- ^self.
- !
Item was removed:
- ----- Method: NullEncoder>>process: (in category 'processing') -----
- process:anObject
- self write:anObject.
- ^self contents.!
Item was removed:
- ----- Method: NullEncoder>>target (in category 'accessing') -----
- target
- ^target.!
Item was removed:
- ----- Method: NullEncoder>>write: (in category 'writing') -----
- write:anObject
- filterSelector ifNil:[filterSelector:=self class filterSelector].
- anObject ifNotNil: [anObject perform:filterSelector with:self].
- !
Item was removed:
- ----- Method: NullEncoder>>writeObject: (in category 'writing') -----
- writeObject:anObject
- ^self forward:anObject.
- !
Item was removed:
- ----- Method: Object>>asMorph (in category '*morphic') -----
- asMorph
- "Open a morph, as best one can, on the receiver"
-
- ^ self asStringMorph
-
- "
- 234 asMorph
- (ScriptingSystem formAtKey: #TinyMenu) asMorph
- 'fred' asMorph
- "
-
- !
Item was removed:
- ----- Method: Object>>asStringMorph (in category '*morphic') -----
- asStringMorph
- "Open a StringMorph, as best one can, on the receiver"
-
- ^ self asStringOrText asStringMorph
- !
Item was removed:
- ----- Method: Object>>asTextMorph (in category '*morphic') -----
- asTextMorph
- "Open a TextMorph, as best one can, on the receiver"
-
- ^ TextMorph new contentsAsIs: self asStringOrText
- !
Item was removed:
- ----- Method: Object>>currentEvent (in category '*Morphic-Kernel-accessing') -----
- currentEvent
- "Answer the current MorphicEvent. Provided that a morphic project is loaded, this method never returns nil."
-
- ^ ActiveEventVariable value!
Item was removed:
- ----- Method: Object>>currentHand (in category '*Morphic-Kernel-accessing') -----
- currentHand
- "Answer the current HandMorph. Provided that a morphic project is loaded, this method will never return nil."
-
- ^ Project current isMorphic
- ifTrue: [ActiveHandVariable value]
- ifFalse: [Sensor "MVC/ST80 fallback"]!
Item was removed:
- ----- Method: Object>>currentWorld (in category '*Morphic-Kernel-accessing') -----
- currentWorld
- "Answer the current world. This method will never return nil."
-
- ^ ActiveWorldVariable value!
Item was removed:
- ----- Method: Object>>explorerContents (in category '*Morphic-Explorer') -----
- explorerContents
- "Override that method to define which properties of the object should be shown in the
- object explorer. See for example the implementation in Integer>>#explorerContents."
-
- ^ (self class allInstVarNames asOrderedCollection withIndexCollect: [:each :index |
- ObjectExplorerWrapper
- with: (self instVarAt: index)
- name: each
- model: self]) ,
- ((1 to: self basicSize) collect: [:index |
- ObjectExplorerWrapper
- with: (self basicAt: index)
- name: index printString
- model: self ])!
Item was removed:
- ----- Method: Object>>filterEvent:for: (in category '*Morphic-Events-Filtering') -----
- filterEvent: anEvent for: aMorphOrNil
- "Get the chance to intercept the event. Note that global event filters might not be provided with the actual target. Returns the event that should be processed any further. If you want to ignore them, call #ignore on them."
-
- ^ anEvent "no change"!
Item was removed:
- ----- Method: Object>>hasContentsInExplorer (in category '*Morphic-Explorer') -----
- hasContentsInExplorer
-
- ^self basicSize > 0 or: [self class allInstVarNames isEmpty not]
- !
Item was removed:
- ----- Method: Object>>isPluggableListMorph (in category '*morphic') -----
- isPluggableListMorph
- ^ false!
Item was removed:
- ----- Method: Object>>openAsMorph (in category '*morphic') -----
- openAsMorph
- "Open a morph, as best one can, on the receiver"
-
- ^ self asMorph openInHand
-
- "
- 234 openAsMorph
- (ScriptingSystem formAtKey: #TinyMenu) openAsMorph
- 'fred' openAsMorph
- "!
Item was removed:
- ListItemWrapper subclass: #ObjectExplorerWrapper
- instanceVariableNames: 'itemName parent balloonText'
- classVariableNames: 'ShowContentsInColumns'
- poolDictionaries: ''
- category: 'Morphic-Explorer'!
-
- !ObjectExplorerWrapper commentStamp: 'pre 5/15/2017 21:23' prior: 0!
- ObjectExplorerWrappers represent an item displayed in an object explorer tree. In addition to the common ListItemWrapper behavior it adds methods to refresh the list entry with updated values from the model. It is mostly used in #explorerContents methods to describe which instance variables of an object should be displayed in the explorer.
-
- Additionally, the value displayed can be visualized with a small icon which is defined by the class of the value object through the method #iconOrThumbnailOfSize:.
-
- Contributed by Bob Arning as part of the ObjectExplorer package.
- !
Item was removed:
- ----- Method: ObjectExplorerWrapper class>>forError: (in category 'instance creation') -----
- forError: message
-
- ^ ObjectExplorerWrapper
- with: message
- name: '<error>' translated
- model: nil!
Item was removed:
- ----- Method: ObjectExplorerWrapper class>>showClassIcons (in category 'preferences') -----
- showClassIcons
- ^ Browser showClassIcons!
Item was removed:
- ----- Method: ObjectExplorerWrapper class>>showClassIcons: (in category 'preferences') -----
- showClassIcons: aBoolean
- Browser showClassIcons: aBoolean.!
Item was removed:
- ----- Method: ObjectExplorerWrapper class>>showContentsInColumns (in category 'preferences') -----
- showContentsInColumns
- <preference: 'Use columns in object explorer'
- categoryList: #(Tools exploring)
- description: 'If enabled, the object explorer will show key in the first column and values in the second column.'
- type: #Boolean>
- ^ ShowContentsInColumns ifNil: [true]!
Item was removed:
- ----- Method: ObjectExplorerWrapper class>>showContentsInColumns: (in category 'preferences') -----
- showContentsInColumns: aBoolean
-
- ShowContentsInColumns := aBoolean.!
Item was removed:
- ----- Method: ObjectExplorerWrapper class>>with:name:model: (in category 'instance creation') -----
- with: anObject name: aString model: aModel
-
- ^self new
- setItem: anObject name: aString model: aModel!
Item was removed:
- ----- Method: ObjectExplorerWrapper class>>with:name:model:parent: (in category 'instance creation') -----
- with: anObject name: aString model: aModel parent: aParent
-
- ^self new
- setItem: anObject name: aString model: aModel parent: aParent
- !
Item was removed:
- ----- Method: ObjectExplorerWrapper>>asString (in category 'converting') -----
- asString
- | explorerString label separator |
- explorerString :=
- [self objectString]
- on: Error
- do: ['<error: {1} in {2}: evaluate "{3}" to debug>' translated format: {self object class name. #asExplorerString. self itemName , ' asExplorerString'}].
- (explorerString includes: Character cr)
- ifTrue: [explorerString := explorerString withSeparatorsCompacted].
-
- label := self itemName ifNil: [''].
- (label includes: Character cr)
- ifTrue: [label := label withSeparatorsCompacted].
-
- separator := self class showContentsInColumns
- ifTrue: [String tab]
- ifFalse: [label ifEmpty: [''] ifNotEmpty: [': ']].
-
- ^ '{1}{2}{3}' format: {label. separator. explorerString}!
Item was removed:
- ----- Method: ObjectExplorerWrapper>>balloonText (in category 'accessing') -----
- balloonText
-
- ^ balloonText!
Item was removed:
- ----- Method: ObjectExplorerWrapper>>balloonText: (in category 'accessing') -----
- balloonText: stringOrNil
-
- balloonText := stringOrNil.!
Item was removed:
- ----- Method: ObjectExplorerWrapper>>contents (in category 'accessing') -----
- contents
-
- ^ [self object explorerContents
- do: [:wrapper | wrapper parent: self];
- yourself] ifError: [:msg | {self class forError: msg}]!
Item was removed:
- ----- Method: ObjectExplorerWrapper>>hasContents (in category 'accessing') -----
- hasContents
-
- ^ self object hasContentsInExplorer
-
- !
Item was removed:
- ----- Method: ObjectExplorerWrapper>>icon (in category 'accessing') -----
- icon
- "Answer a form to be used as icon"
- ^ Preferences visualExplorer
- ifTrue: [([self object iconOrThumbnailOfSize: 12] on: Error do: [nil])
- ifNil: [self class showClassIcons
- ifTrue: [ToolIcons iconNamed: self object class theNonMetaClass toolIcon]
- ifFalse: [self class showContentsInColumns
- ifTrue: [ToolIcons iconNamed: #blank]
- ifFalse: [nil]]]]
- ifFalse: [nil]!
Item was removed:
- ----- Method: ObjectExplorerWrapper>>itemName (in category 'accessing') -----
- itemName
-
- ^ self item key!
Item was removed:
- ----- Method: ObjectExplorerWrapper>>itemName: (in category 'accessing') -----
- itemName: newName
-
- self item key: newName.!
Item was removed:
- ----- Method: ObjectExplorerWrapper>>object (in category 'accessing') -----
- object
-
- ^ self item value!
Item was removed:
- ----- Method: ObjectExplorerWrapper>>object: (in category 'accessing') -----
- object: anObject
-
- self item value: anObject.!
Item was removed:
- ----- Method: ObjectExplorerWrapper>>objectString (in category 'accessing') -----
- objectString
- "Answers a string representation of the object that well be combined with #itemName when requested from the tree model. Overwrite this in custom wrappers to modify parent-specific representations without having to modify #asExplorerString in the particular object."
-
- ^ self object asExplorerString!
Item was removed:
- ----- Method: ObjectExplorerWrapper>>parent (in category 'accessing') -----
- parent
- ^ parent!
Item was removed:
- ----- Method: ObjectExplorerWrapper>>parent: (in category 'accessing') -----
- parent: aWrapper
-
- parent := aWrapper.!
Item was removed:
- ----- Method: ObjectExplorerWrapper>>refresh (in category 'monitoring') -----
- refresh
-
- self parent ifNil: [^ self].
- [model explorerContents detect: [:wrapper | wrapper itemName = self itemName]
- ifFound: [:wrapper | ^ self object: wrapper object ]
- ifNone: [^ self object: nil]]
- on: Error
- do: [ :ex | self object: nil ]!
Item was removed:
- ----- Method: ObjectExplorerWrapper>>setItem:name:model: (in category 'initialization') -----
- setItem: anObject name: aString model: aModel
-
- self setItem: aString -> anObject model: aModel.!
Item was removed:
- ----- Method: ObjectExplorerWrapper>>setItem:name:model:parent: (in category 'initialization') -----
- setItem: anObject name: aString model: aModel parent: itemParent
-
- self parent: itemParent.
- self setItem: anObject name: aString model: aModel!
Item was removed:
- ----- Method: OrderedCollection>>hasContentsInExplorer (in category '*Morphic-Explorer') -----
- hasContentsInExplorer
-
- ^self isEmpty not!
Item was removed:
- ----- Method: OrderedDictionary>>explorerContents (in category '*Morphic-Explorer') -----
- explorerContents
-
- ^self keys replace: [ :key |
- ObjectExplorerWrapper
- with: (self at: key)
- name: (key printString contractTo: 32)
- model: self ]
- !
Item was removed:
- ----- Method: OrientedFillStyle>>addFillStyleMenuItems:hand:from: (in category '*Morphic-Balloon') -----
- addFillStyleMenuItems: aMenu hand: aHand from: aMorph
- "Add the items for changing the current fill style of the receiver"
- aMenu add: 'change origin' translated target: self selector: #changeOriginIn:event: argument: aMorph.
- aMenu add: 'change orientation' translated target: self selector: #changeOrientationIn:event: argument: aMorph.!
Item was removed:
- ----- Method: OrientedFillStyle>>changeOrientationIn:event: (in category '*Morphic-Balloon') -----
- changeOrientationIn: aMorph event: evt
- "Interactively change the origin of the receiver"
- | handle |
- handle := HandleMorph new forEachPointDo:[:pt|
- self direction: pt - self origin.
- self normal: nil.
- aMorph changed].
- evt hand attachMorph: handle.
- handle startStepping.!
Item was removed:
- ----- Method: OrientedFillStyle>>changeOriginIn:event: (in category '*Morphic-Balloon') -----
- changeOriginIn: aMorph event: evt
- "Interactively change the origin of the receiver"
- | handle |
- handle := HandleMorph new forEachPointDo:[:pt|
- self origin: pt.
- aMorph changed].
- evt hand attachMorph: handle.
- handle startStepping.!
Item was removed:
- BorderedMorph subclass: #PasteUpMorph
- instanceVariableNames: 'presenter model cursor padding turtleTrailsForm turtlePen lastTurtlePositions isPartsBin indicateCursor wantsMouseOverHalos worldState'
- classVariableNames: 'GlobalCommandKeysEnabled WindowEventHandler'
- poolDictionaries: ''
- category: 'Morphic-Worlds'!
-
- !PasteUpMorph commentStamp: '<historical>' prior: 0!
- A morph whose submorphs comprise a paste-up of rectangular subparts which "show through". Anything called a 'Playfield' is a PasteUpMorph.
-
- Facilities commonly needed on pages of graphical presentations and on simulation playfields, such as the painting of new objects, turtle trails, gradient fills, background paintings, parts-bin behavior, collision-detection, etc., are (or will be) provided.
-
- A World, the entire Smalltalk screen, is a PasteUpMorph. A World responds true to isWorld. Morph subclasses that have specialized menus (BookMorph) build them in the message addBookMenuItemsTo:hand:. A PasteUpMorph that is a world, builds its menu in HandMorph buildWorldMenu.
-
- presenter A Presenter in charge of stopButton stepButton and goButton,
- mouseOverHalosEnabled soundsEnabled fenceEnabled coloredTilesEnabled.
- model <not used>
- cursor ??
- padding ??
- backgroundMorph A Form that covers the background.
- turtleTrailsForm Moving submorphs may leave trails on this form.
- turtlePen Draws the trails.
- lastTurtlePositions A Dictionary of (aPlayer -> aPoint) so turtle trails can be drawn
- only once each step cycle. The point is the start of the current stroke.
- isPartsBin If true, every object dragged out is copied.
- autoLineLayout ??
- indicateCursor ??
- resizeToFit ??
- wantsMouseOverHalos If true, simply moving the cursor over a submorph brings up its halo.
- worldState If I am also a World, keeps the hands, damageRecorder, stepList etc.
- griddingOn If true, submorphs are on a grid
-
- !
Item was removed:
- ----- Method: PasteUpMorph class>>authoringPrototype (in category 'scripting') -----
- authoringPrototype
- "Answer an instance of the receiver suitable for placing in a parts bin for authors"
-
- | proto |
- proto := self new markAsPartsDonor.
- proto color: Color green muchLighter; extent: 100 @ 80; borderColor: (Color r: 0.645 g: 0.935 b: 0.161).
- proto extent: 300 @ 240.
- proto wantsMouseOverHalos: false.
- proto beSticky.
- ^ proto!
Item was removed:
- ----- Method: PasteUpMorph class>>defaultNameStemForInstances (in category 'printing') -----
- defaultNameStemForInstances
- "Answer a basis for names of default instances of the receiver"
- ^ 'playfield' translatedNoop!
Item was removed:
- ----- Method: PasteUpMorph class>>descriptionForPartsBin (in category 'parts bin') -----
- descriptionForPartsBin
- ^ self partName: 'Playfield'
- categories: #('Presentation')
- documentation: 'A place for assembling parts or for staging animations'!
Item was removed:
- ----- Method: PasteUpMorph class>>globalCommandKeysEnabled (in category 'preferences') -----
- globalCommandKeysEnabled
- <preference: 'Enable Global Command Keys'
- category: 'Morphic'
- description: 'When true, the global command keys are enabled. Command-key help is available from the help menu.'
- type: #Boolean>
- ^ GlobalCommandKeysEnabled ifNil: [ true ]!
Item was removed:
- ----- Method: PasteUpMorph class>>globalCommandKeysEnabled: (in category 'preferences') -----
- globalCommandKeysEnabled: aBoolean
-
- GlobalCommandKeysEnabled = aBoolean ifTrue: [^ self].
- GlobalCommandKeysEnabled := aBoolean.
-
- SystemWindow allSubInstancesDo: [:ea |
- self globalCommandKeysEnabled
- ifTrue: [ea addKeyboardShortcuts]
- ifFalse: [ea removeKeyboardShortcuts]].
-
- PasteUpMorph allSubInstancesDo: [:ea |
- self globalCommandKeysEnabled
- ifTrue: [ea addKeyboardShortcuts]
- ifFalse: [ea removeKeyboardShortcuts]].!
Item was removed:
- ----- Method: PasteUpMorph class>>newWorldForProject: (in category 'project') -----
- newWorldForProject: projectOrNil
- "Return a new pasteUpMorph configured as a world (ie project notNil).
- projectOrNil is no longer used."
-
- ^ self new initForProject: WorldState new!
Item was removed:
- ----- Method: PasteUpMorph class>>postRecompileAction (in category 'recompilation') -----
- postRecompileAction
- "PasteUpMorph's worldState refers to blocks in its alarms and stepList inst vars. These should be rebuilt post recompileAll"
- Project allProjects do:
- [:project|
- project isMorphic ifTrue:
- [project world updateStatePostRecompile]].
- self currentWorld addGlobalFlaps!
Item was removed:
- ----- Method: PasteUpMorph>>abandonAllHalos (in category 'world state') -----
- abandonAllHalos
- self flag: #arNote. "Remove the method"
- ^self deleteAllHalos!
Item was removed:
- ----- Method: PasteUpMorph>>abandonCostumeHistory (in category 'misc') -----
- abandonCostumeHistory
- self allMorphsDo:
- [:m | m player ifNotNil: [m player forgetOtherCostumes]]!
Item was removed:
- ----- Method: PasteUpMorph>>acceptDroppingMorph:event: (in category 'dropping/grabbing') -----
- acceptDroppingMorph: dropped event: evt
- "The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitating event is supplied"
-
- | aMorph |
- (self isWorldMorph and: [dropped isTransferMorph]
- and: [self hasTransferMorphConverter not])
- ifTrue: [
- dropped dragTransferType = #filesAndDirectories
- ifTrue: [^ self dropFiles: dropped passenger event: evt].
- dropped dragTransferType = #sourceCode
- ifTrue: [^ self dropSourceCode: dropped passenger event: evt]].
-
- aMorph := self morphToDropFrom: dropped.
- self isWorldMorph
- ifFalse: [super acceptDroppingMorph: aMorph event: evt]
- ifTrue:
- ["Add the given morph to this world and start stepping it if it wants to be."
- aMorph isInWorld ifFalse: [aMorph position: evt position].
- self addMorphFront: aMorph.
- (aMorph fullBounds intersects: self viewBox) ifFalse:
- [Beeper beep.
- aMorph position: self bounds center]].
-
- aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]].
- aMorph allMorphsDo: "Establish any penDown morphs in new world"
- [:m | | tfm mm |
- m player ifNotNil:
- [m player getPenDown ifTrue:
- [((mm := m player costume) notNil and: [(tfm := mm owner transformFrom: self) notNil])
- ifTrue: [self noteNewLocation: (tfm localPointToGlobal: mm referencePosition)
- forPlayer: m player]]]].
-
- self isPartsBin
- ifTrue:
- [aMorph isPartsDonor: true.
- aMorph stopSteppingSelfAndSubmorphs.
- aMorph suspendEventHandler]
- ifFalse:
- [self world startSteppingSubmorphsOf: aMorph].
-
- " self presenter morph: aMorph droppedIntoPasteUpMorph: self."
- self showingListView ifTrue:
- [self sortSubmorphsBy: (self valueOfProperty: #sortOrder).
- self currentWorld abandonAllHalos].
-
- self bringTopmostsToFront.!
Item was removed:
- ----- Method: PasteUpMorph>>accommodateFlap: (in category 'flaps') -----
- accommodateFlap: aFlapTab
- "Shift submorphs over, if appropriate"
- | offset |
- aFlapTab slidesOtherObjects ifTrue:
- [offset := self offsetForAccommodating: aFlapTab referent extent onEdge: aFlapTab edgeToAdhereTo.
- self shiftSubmorphsBy: offset]!
Item was removed:
- ----- Method: PasteUpMorph>>activateObjectsTool (in category 'world menu') -----
- activateObjectsTool
- "Offer the user a parts bin of morphs -- if one already exists, bring it to the front and flash its border beckoningly; if none exists yet, create a new one and place it in the center of the screen"
-
- | anObjectTool |
- submorphs do:
- [:aMorph | (aMorph renderedMorph isKindOf: ObjectsTool)
- ifTrue:
- [aMorph comeToFront.
- aMorph flash.
- ^ self]].
- "None found, so create one"
-
- anObjectTool := ObjectsTool newStandAlone.
- self addMorphFront: anObjectTool.
- anObjectTool fullBounds.
- anObjectTool center: self center
-
- "ActiveWorld activateObjectsTool"!
Item was removed:
- ----- Method: PasteUpMorph>>adaptedToWorld: (in category 'initialization') -----
- adaptedToWorld: aWorld
- "If I refer to a world or a hand, return the corresponding items in the new world."
- self isWorldMorph ifTrue:[^aWorld].!
Item was removed:
- ----- Method: PasteUpMorph>>addAlarm:withArguments:for:at: (in category 'alarms-scheduler') -----
- addAlarm: aSelector withArguments: argArray for: aTarget at: scheduledTime
- "Add a new alarm with the given set of parameters"
- worldState addAlarm: aSelector withArguments: argArray for: aTarget at: scheduledTime.!
Item was removed:
- ----- Method: PasteUpMorph>>addAllMorphs: (in category 'submorphs - add/remove') -----
- addAllMorphs: array
-
- super addAllMorphs: array.
- self isWorldMorph
- ifTrue: [array do: [:m | self startSteppingSubmorphsOf: m]].
- !
Item was removed:
- ----- Method: PasteUpMorph>>addCenteredAtBottom:offset: (in category 'layout') -----
- addCenteredAtBottom: aMorph offset: anOffset
- "Add aMorph beneath all other morphs currently in the receiver, centered horizontally, with the vertical offset from the bottom of the previous morph given by anOffset"
- | curBot |
- curBot := 0.
- submorphs do: [:m | curBot := curBot max: m bottom].
- self addMorphBack: aMorph.
- aMorph position: ((self center x - (aMorph width // 2)) @ (curBot + anOffset))!
Item was removed:
- ----- Method: PasteUpMorph>>addCustomMenuItems:hand: (in category 'menu & halo') -----
- addCustomMenuItems: menu hand: aHandMorph
- "Add morph-specific menu itemns to the menu for the hand"
- super addCustomMenuItems: menu hand: aHandMorph.
-
- menu addLine.
- Preferences noviceMode
- ifFalse: [
- self addStackMenuItems: menu hand: aHandMorph.
- self addPenMenuItems: menu hand: aHandMorph.
- self addPlayfieldMenuItems: menu hand: aHandMorph].
-
- self isWorldMorph
- ifTrue: [
- menu addLine.
- Preferences noviceMode
- ifFalse: [(owner isKindOf: BOBTransformationMorph)
- ifTrue: [self addScalingMenuItems: menu hand: aHandMorph]].
- menu addUpdating: #showWorldMainDockingBarString action: #toggleShowWorldMainDockingBar.
-
- Flaps sharedFlapsAllowed ifTrue: [
- menu
- addUpdating: #suppressFlapsString
- target: Project current
- action: #toggleFlapsSuppressed.
- ].
-
- Preferences noviceMode ifFalse: [| twm |
- menu addLine.
-
- twm := TheWorldMenu new.
- twm world: self project: Project current hand: aHandMorph.
-
- menu add: 'old desktop menu... (W)' translated subMenu: twm buildWorldMenu.
- ].
- ].
- !
Item was removed:
- ----- Method: PasteUpMorph>>addGlobalFlaps (in category 'flaps') -----
- addGlobalFlaps
- "Must make global flaps adapt to world. Do this even if not shown, so the old world will not be pointed at by the flaps."
-
- | use thisWorld |
- use := Flaps sharedFlapsAllowed.
- Project current flapsSuppressed ifTrue: [use := false].
- "Smalltalk isMorphic ifFalse: [use := false]."
- thisWorld := use
- ifTrue: [self]
- ifFalse: [PasteUpMorph new initForProject: "fake to be flap owner"
- WorldState new;
- bounds: (0 at 0 extent: 4000 at 4000);
- viewBox: (0 at 0 extent: 4000 at 4000)].
-
- Flaps globalFlapTabsIfAny do: [:aFlapTab |
- (Project current isFlapEnabled: aFlapTab) ifTrue:
- [(aFlapTab world == thisWorld) ifFalse:
- [thisWorld addMorphFront: aFlapTab.
- aFlapTab adaptToWorld: thisWorld]. "always do"
- use ifTrue:
- [aFlapTab spanWorld.
- aFlapTab adjustPositionAfterHidingFlap.
- aFlapTab flapShowing ifTrue: [aFlapTab showFlap]]]]!
Item was removed:
- ----- Method: PasteUpMorph>>addHand: (in category 'world state') -----
- addHand: aHandMorph
- "Add the given hand to the list of hands for this world."
-
- aHandMorph owner ifNotNil:[aHandMorph owner removeHand: aHandMorph].
- worldState addHand: aHandMorph.
- aHandMorph privateOwner: self.
- !
Item was removed:
- ----- Method: PasteUpMorph>>addKeyboardShortcuts (in category 'initialization') -----
- addKeyboardShortcuts
- "Install an event capture filter to add shortcuts for global operations like opening a tool."
-
- self addKeyboardCaptureFilter: self.!
Item was removed:
- ----- Method: PasteUpMorph>>addMorph:centeredNear: (in category 'world state') -----
- addMorph: aMorph centeredNear: aPoint
- "Add the given morph to this world, attempting to keep its center as close to the given point possible while also keeping the it entirely within the bounds of this world."
-
- | trialRect delta |
- trialRect := Rectangle center: aPoint extent: aMorph fullBounds extent.
- delta := trialRect amountToTranslateWithin: bounds.
- aMorph position: trialRect origin + delta.
- self addMorph: aMorph.
- !
Item was removed:
- ----- Method: PasteUpMorph>>addMorphFront: (in category 'submorphs - add/remove') -----
- addMorphFront: aMorph
- "Overwritten to arrange submorphs in layers by default."
-
- ^ self addMorphFrontInLayer: aMorph!
Item was removed:
- ----- Method: PasteUpMorph>>addMorphInLayer: (in category 'WiW support') -----
- addMorphInLayer: aMorph
- super addMorphInLayer: aMorph.
- aMorph wantsToBeTopmost ifFalse:[self bringTopmostsToFront].!
Item was removed:
- ----- Method: PasteUpMorph>>addMorphsAndModel: (in category 'world state') -----
- addMorphsAndModel: aMorphOrList
- "Dump in submorphs, model, and stepList from aMorphOrList. Used to bring a world, paste-up, or other morph in from an object file."
-
- aMorphOrList isMorph
- ifTrue:
- [aMorphOrList isWorldMorph
- ifFalse:
- ["one morph, put on hand"
-
- "aMorphOrList installModelIn: self. a chance to install model pointers"
-
- aMorphOrList privateOwner: nil.
- self firstHand attachMorph: aMorphOrList.
- self startSteppingSubmorphsOf: aMorphOrList]
- ifTrue:
- [model isNil
- ifTrue: [self setModel: aMorphOrList modelOrNil]
- ifFalse:
- [aMorphOrList modelOrNil ifNotNil:
- [aMorphOrList modelOrNil privateOwner: nil.
- self addMorph: aMorphOrList modelOrNil]].
- aMorphOrList privateSubmorphs reverseDo:
- [:m |
- m privateOwner: nil.
- self addMorph: m.
- m changed].
- (aMorphOrList instVarNamed: 'stepList')
- do: [:entry | entry first startSteppingIn: self]]]
- ifFalse:
- ["list, add them all"
-
- aMorphOrList reverseDo:
- [:m |
- m privateOwner: nil.
- self addMorph: m.
- self startSteppingSubmorphsOf: m. "It may not want this!!"
- m changed]]!
Item was removed:
- ----- Method: PasteUpMorph>>addMouseShortcuts (in category 'initialization') -----
- addMouseShortcuts
-
- self addMouseCaptureFilter: self.!
Item was removed:
- ----- Method: PasteUpMorph>>addPenMenuItems:hand: (in category 'menu & halo') -----
- addPenMenuItems: menu hand: aHandMorph
- "Add a pen-trails-within submenu to the given menu"
-
- menu add: 'pen trails...' translated target: self selector: #putUpPenTrailsSubmenu.
- menu balloonTextForLastItem: 'its governing pen trails drawn within' translated!
Item was removed:
- ----- Method: PasteUpMorph>>addPenTrailsMenuItemsTo: (in category 'menu & halo') -----
- addPenTrailsMenuItemsTo: aMenu
- "Add items relating to pen trails to aMenu"
-
- | oldTarget |
- oldTarget := aMenu defaultTarget.
- aMenu defaultTarget: self.
- aMenu add: 'clear pen trails' translated action: #clearTurtleTrails.
- aMenu addLine.
- aMenu add: 'all pens up' translated action: #liftAllPens.
- aMenu add: 'all pens down' translated action: #lowerAllPens.
- aMenu addLine.
- aMenu add: 'all pens show lines' translated action: #linesForAllPens.
- aMenu add: 'all pens show arrowheads' translated action: #arrowsForAllPens.
- aMenu add: 'all pens show arrows' translated action: #linesAndArrowsForAllPens.
- aMenu add: 'all pens show dots' translated action: #dotsForAllPens.
- aMenu addLine.
- aMenu addUpdating: #batchPenTrailsString action: #toggleBatchPenTrails.
- aMenu balloonTextForLastItem: 'if true, detailed movement of pens between display updates is ignored. Thus multiple line segments drawn within a script may not be seen individually.' translated.
-
- aMenu defaultTarget: oldTarget!
Item was removed:
- ----- Method: PasteUpMorph>>addPlayfieldMenuItems:hand: (in category 'menu & halo') -----
- addPlayfieldMenuItems: menu hand: aHandMorph
- "Add playfield-related items to the menu"
-
- menu add: 'playfield options...' translated target: self action: #presentPlayfieldMenu.
- (self hasProperty: #donorTextMorph) ifTrue:
- [menu add: 'send contents back to donor' translated action: #sendTextContentsBackToDonor]!
Item was removed:
- ----- Method: PasteUpMorph>>addRemoteClient: (in category 'Nebraska') -----
- addRemoteClient: aClient
- self addHand: aClient hand.
- worldState addRemoteCanvas: aClient canvas.
- aClient canvas fullDrawMorph: self.
- self changed. "force a redraw"
- !
Item was removed:
- ----- Method: PasteUpMorph>>addScalingMenuItems:hand: (in category 'menu & halo') -----
- addScalingMenuItems: menu hand: aHandMorph
-
- | subMenu |
-
- (subMenu := MenuMorph new)
- defaultTarget: self;
- add: 'show application view' translated action: #showApplicationView;
- add: 'show factory view' translated action: #showFactoryView;
- add: 'show whole world view' translated action: #showFullView;
- add: 'expand' translated action: #showExpandedView;
- add: 'reduce' translated action: #showReducedView;
- addLine;
- add: 'define application view' translated action: #defineApplicationView;
- add: 'define factory view' translated action: #defineFactoryView.
- menu
- add: 'world scale and clip...' translated
- subMenu: subMenu!
Item was removed:
- ----- Method: PasteUpMorph>>addStackMenuItems:hand: (in category 'menu & halo') -----
- addStackMenuItems: menu hand: aHandMorph
- "Add appropriate stack-related items to the given menu"
-
- self isStackBackground
- ifTrue:
- [menu add: 'card & stack...' target: self action: #presentCardAndStackMenu]!
Item was removed:
- ----- Method: PasteUpMorph>>addUndoItemsTo: (in category 'world menu') -----
- addUndoItemsTo: aWorldMenu
- "Add undo-related items to the given menu. Will add zero, one or two items, depending on the settings of the #useUndo and #infiniteUndo preferences"
-
- Preferences useUndo ifFalse: [^ self].
- Preferences infiniteUndo
- ifFalse:
- [aWorldMenu addUpdating: #undoOrRedoMenuWording target: self commandHistory action: #undoOrRedoCommand]
- ifTrue:
- [aWorldMenu addUpdating: #undoMenuWording target: self commandHistory action: #undoLastCommand.
- aWorldMenu addUpdating: #redoMenuWording target: self commandHistory action: #redoNextCommand.
- self flag: #deferred. "The following feature to be unblocked in due course"
- "aWorldMenu add: 'undo to...' target: self commandHistory action: #undoTo"].
- aWorldMenu addLine!
Item was removed:
- ----- Method: PasteUpMorph>>addWorldHaloMenuItemsTo:hand: (in category 'menu & halo') -----
- addWorldHaloMenuItemsTo: aMenu hand: aHandMorph
- "Add standard halo items to the menu, given that the receiver is a World"
-
- | unlockables |
- self addFillStyleMenuItems: aMenu hand: aHandMorph.
- self addLayoutMenuItems: aMenu hand: aHandMorph.
-
- aMenu addLine.
- self addWorldToggleItemsToHaloMenu: aMenu.
- aMenu addLine.
- self addCopyItemsTo: aMenu.
- self addPlayerItemsTo: aMenu.
- self addExportMenuItems: aMenu hand: aHandMorph.
- self addStackItemsTo: aMenu.
- self addMiscExtrasTo: aMenu.
-
- Preferences noviceMode ifFalse:
- [self addDebuggingItemsTo: aMenu hand: aHandMorph].
-
- aMenu addLine.
- aMenu defaultTarget: self.
-
- aMenu addLine.
-
- unlockables := self submorphs select:
- [:m | m isLocked].
- unlockables size = 1 ifTrue:
- [aMenu add: ('unlock "{1}"' translated format:{unlockables first externalName})action: #unlockContents].
- unlockables size > 1 ifTrue:
- [aMenu add: 'unlock all contents' translated action: #unlockContents.
- aMenu add: 'unlock...' translated action: #unlockOneSubpart].
-
- aMenu defaultTarget: aHandMorph.
- !
Item was removed:
- ----- Method: PasteUpMorph>>addWorldToggleItemsToHaloMenu: (in category 'menu & halo') -----
- addWorldToggleItemsToHaloMenu: aMenu
- "Add toggle items for the world to the halo menu"
-
- #(
- (hasDragAndDropEnabledString changeDragAndDrop 'whether I am open to having objects dropped into me')
- (roundedCornersString toggleCornerRounding 'whether the world should have rounded corners')) do:
-
- [:trip | aMenu addUpdating: trip first action: trip second.
- aMenu balloonTextForLastItem: trip third]!
Item was removed:
- ----- Method: PasteUpMorph>>allMorphsDo: (in category 'submorphs - accessing') -----
- allMorphsDo: aBlock
- "Enumerate all morphs in the world, including those held in hands."
-
- super allMorphsDo: aBlock.
- self isWorldMorph
- ifTrue: [worldState handsReverseDo: [:h | h allMorphsDo: aBlock]].
- !
Item was removed:
- ----- Method: PasteUpMorph>>allNonFlapRelatedSubmorphs (in category 'world state') -----
- allNonFlapRelatedSubmorphs
- "Answer all non-window submorphs that are not flap-related"
-
- ^submorphs
- select: [:m | (m isSystemWindow) not and: [m wantsToBeTopmost not]]!
Item was removed:
- ----- Method: PasteUpMorph>>allScriptEditors (in category 'misc') -----
- allScriptEditors
- ^ self allMorphs select:
- [:s | s isScriptEditorMorph]!
Item was removed:
- ----- Method: PasteUpMorph>>allScriptors (in category 'misc') -----
- allScriptors
- "Answer a list of all active scriptors running on behalf of the receiver. This is a hook used in past demos and with a future life which however presently is vacuous"
-
- ^ #()
- "
- ^ self allMorphs select: [:m | m isKindOf: Scriptor]"!
Item was removed:
- ----- Method: PasteUpMorph>>allTileScriptingElements (in category 'scripting') -----
- allTileScriptingElements
- "Answer a list of all the morphs that pertain to tile-scripting. A sledge-hammer"
-
- | all morphs |
- morphs := IdentitySet new: 400.
- self allMorphsAndBookPagesInto: morphs.
- all := morphs select: [:s | s isTileScriptingElement].
- " self closedViewerFlapTabs do:
- [:aTab | all addAll: aTab referent allTileScriptingElements].
- "
- ^ all asOrderedCollection!
Item was removed:
- ----- Method: PasteUpMorph>>alwaysShowThumbnail (in category 'misc') -----
- alwaysShowThumbnail
- ^ self hasProperty: #alwaysShowThumbnail!
Item was removed:
- ----- Method: PasteUpMorph>>assureFlapTabsFitOnScreen (in category 'flaps') -----
- assureFlapTabsFitOnScreen
- self flapTabs do:
- [:m | m fitOnScreen]!
Item was removed:
- ----- Method: PasteUpMorph>>assureFlapWidth: (in category 'accessing') -----
- assureFlapWidth: requestedWidth
- | tab |
- self width: requestedWidth.
- tab := self flapTab ifNil:[^self].
- tab flapShowing ifTrue:[tab hideFlap; showFlap].!
Item was removed:
- ----- Method: PasteUpMorph>>assureNotPaintingElse: (in category 'world state') -----
- assureNotPaintingElse: aBlock
- "If painting is already underway in the receiver, put up an informer to that effect and evalute aBlock"
- self sketchEditorOrNil ifNotNil:
- [self inform: 'Sorry, you can only paint
- one object at a time' translated.
- Cursor normal show.
- ^ aBlock value]
- !
Item was removed:
- ----- Method: PasteUpMorph>>assureNotPaintingEvent: (in category 'world state') -----
- assureNotPaintingEvent: evt
- "If painting is already underway
- in the receiver, put up an informer to that effect and evalute aBlock"
- | editor |
- (editor := self sketchEditorOrNil) ifNotNil:[
- editor save: evt.
- Cursor normal show.
- ].!
Item was removed:
- ----- Method: PasteUpMorph>>assuredCanvas (in category 'world state') -----
- assuredCanvas
-
- ^worldState assuredCanvas!
Item was removed:
- ----- Method: PasteUpMorph>>autoLineLayout (in category 'options') -----
- autoLineLayout
- | layout |
- layout := self layoutPolicy ifNil:[^false].
- layout isTableLayout ifFalse:[^false].
- self listDirection == #leftToRight ifFalse:[^false].
- self wrapDirection == #topToBottom ifFalse:[^false].
- ^true!
Item was removed:
- ----- Method: PasteUpMorph>>autoLineLayout: (in category 'options') -----
- autoLineLayout: aBoolean
- "Make the receiver be viewed with auto-line-layout, which means that its submorphs will be laid out left-to-right and then top-to-bottom in the manner of a word processor, or (if aBoolean is false,) cease applying auto-line-layout"
-
- aBoolean ifTrue:
- [self viewingNormally ifTrue: [self saveBoundsOfSubmorphs]].
- aBoolean ifTrue:[
- self layoutPolicy: TableLayout new.
- self layoutInset: 8; cellGap: 4.
- self listDirection: #leftToRight; wrapDirection: #topToBottom.
- ] ifFalse:[
- self layoutPolicy: nil.
- self layoutInset: 0; cellGap: 0.
- ].
- !
Item was removed:
- ----- Method: PasteUpMorph>>autoLineLayoutString (in category 'menu & halo') -----
- autoLineLayoutString
- "Answer the string to be shown in a menu to represent the
- auto-line-layout status"
- ^ (self autoLineLayout
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'auto-line-layout' translated!
Item was removed:
- ----- Method: PasteUpMorph>>automaticPhraseExpansion (in category 'dropping/grabbing') -----
- automaticPhraseExpansion
- ^ self hasProperty: #automaticPhraseExpansion!
Item was removed:
- ----- Method: PasteUpMorph>>automaticViewing (in category 'e-toy support') -----
- automaticViewing
- ^ self hasProperty: #automaticViewing!
Item was removed:
- ----- Method: PasteUpMorph>>beWorldForProject: (in category 'world state') -----
- beWorldForProject: aProject
-
- self privateOwner: nil.
- worldState := WorldState new.
- self addHand: HandMorph new.
- self setProperty: #automaticPhraseExpansion toValue: true.
- self setProperty: #optimumExtentFromAuthor toValue: Display extent.
- self startSteppingSubmorphsOf: self!
Item was removed:
- ----- Method: PasteUpMorph>>becomeActiveDuring: (in category 'initialization') -----
- becomeActiveDuring: aBlock
- "Make the receiver the active world during the evaluation of aBlock."
-
- ^ ActiveWorldVariable value: self during: aBlock!
Item was removed:
- ----- Method: PasteUpMorph>>behaveLikeHolder (in category 'options') -----
- behaveLikeHolder
-
- self vResizeToFit: true; autoLineLayout: true; indicateCursor: true!
Item was removed:
- ----- Method: PasteUpMorph>>behaveLikeHolder: (in category 'options') -----
- behaveLikeHolder: aBoolean
- "Change the receiver's viewing properties such that they conform to what we commonly call a Holder, viz: resize-to-fit, do auto-line-layout, and indicate the 'cursor'"
-
- self vResizeToFit: aBoolean; autoLineLayout: aBoolean; indicateCursor: aBoolean
- !
Item was removed:
- ----- Method: PasteUpMorph>>behavingLikeAHolder (in category 'options') -----
- behavingLikeAHolder
- "Answer whether the receiver is currently behaving like a Holder"
-
- ^ self resizeToFit and: [self indicateCursor and: [self autoLineLayout]]!
Item was removed:
- ----- Method: PasteUpMorph>>bringTopmostsToFront (in category 'flaps') -----
- bringTopmostsToFront
- submorphs
- select:[:m| m wantsToBeTopmost]
- thenDo:[:m| self addMorphInLayer: m].!
Item was removed:
- ----- Method: PasteUpMorph>>bringWindowsFullOnscreen (in category 'world menu') -----
- bringWindowsFullOnscreen
- "Make ever SystemWindow on the desktop be totally on-screen, whenever possible."
-
- (SystemWindow windowsIn: self satisfying: [:w | true]) do:
- [:aWindow |
- aWindow right: (aWindow right min: bounds right).
- aWindow bottom: (aWindow bottom min: bounds bottom).
- aWindow left: (aWindow left max: bounds left).
- aWindow top: (aWindow top max: bounds top)]!
Item was removed:
- ----- Method: PasteUpMorph>>browseAllScriptsTextually (in category 'world menu') -----
- browseAllScriptsTextually
- "Put up a browser showing all scripts in the project textually"
-
- self presenter browseAllScriptsTextually
-
- "ActiveWorld browseAllScriptsTextually"!
Item was removed:
- ----- Method: PasteUpMorph>>buildDebugMenu: (in category 'menu & halo') -----
- buildDebugMenu: aHandMorph
- | aMenu |
- aMenu := super buildDebugMenu: aHandMorph.
- aMenu add: 'abandon costume history' translated target: self action: #abandonCostumeHistory.
- ^ aMenu!
Item was removed:
- ----- Method: PasteUpMorph>>buildWorldMenu: (in category 'world menu') -----
- buildWorldMenu: evt
- ^(TheWorldMenu new
- world: self
- project: (self project ifNil: [Project current]) "mvc??"
- hand: evt hand) buildWorldMenu.!
Item was removed:
- ----- Method: PasteUpMorph>>cachedOrNewThumbnailFrom: (in category 'misc') -----
- cachedOrNewThumbnailFrom: newThumbnail
- "If I have a cached thumbnail, and it is of the desired extent, then ruturn it.
- Otherwise produce one in newThumbnail and return it (after caching).
- This code parallels what happens in page: to match resultant extent."
- | cachedThumbnail scale ext |
- scale := newThumbnail height / self fullBounds height.
- ext := (self fullBounds extent * scale) truncated.
- (cachedThumbnail := self valueOfProperty: #cachedThumbnail) ifNotNil:
- [cachedThumbnail extent = ext ifTrue: [^ cachedThumbnail]].
- self setProperty: #cachedThumbnail toValue: (newThumbnail page: self).
- ^ newThumbnail!
Item was removed:
- ----- Method: PasteUpMorph>>canHaveFillStyles (in category 'visual properties') -----
- canHaveFillStyles
- "Return true if the receiver can have general fill styles; not just colors.
- This method is for gradually converting old morphs."
- ^ true!
Item was removed:
- ----- Method: PasteUpMorph>>canvas (in category 'project state') -----
- canvas
-
- ^ worldState canvas!
Item was removed:
- ----- Method: PasteUpMorph>>canvas: (in category 'project state') -----
- canvas: aCanvas
- "Set this world's canvas"
-
- worldState canvas: aCanvas.
- !
Item was removed:
- ----- Method: PasteUpMorph>>cartesianOrigin (in category 'misc') -----
- cartesianOrigin
- ^ self originAtCenter
- ifFalse:
- [self bottomLeft]
- ifTrue:
- [self center]!
Item was removed:
- ----- Method: PasteUpMorph>>checkCurrentHandForObjectToPaste (in category 'world state') -----
- checkCurrentHandForObjectToPaste
-
- | response |
- self primaryHand pasteBuffer ifNil: [^self].
- response := Project uiManager
- chooseOptionFrom: #('Delete' 'Keep')
- title: 'Hand is holding a Morph in its paste buffer:\' withCRs,
- self primaryHand pasteBuffer printString.
- response = 1 ifTrue:
- [self primaryHand pasteBuffer: nil].
- !
Item was removed:
- ----- Method: PasteUpMorph>>checkCurrentHandForObjectToPaste2 (in category 'world state') -----
- checkCurrentHandForObjectToPaste2
-
- self primaryHand pasteBuffer ifNil: [^self].
- self inform: 'Hand is holding a Morph in its paste buffer:\' withCRs,
- self primaryHand pasteBuffer printString.
-
- !
Item was removed:
- ----- Method: PasteUpMorph>>chooseClickTarget (in category 'world state') -----
- chooseClickTarget
- Cursor crossHair showWhile:
- [Sensor waitButton].
- Cursor down showWhile:
- [Sensor anyButtonPressed].
- ^ (self morphsAt: Sensor cursorPoint) first topRendererOrSelf!
Item was removed:
- ----- Method: PasteUpMorph>>cleanseStepList (in category 'stepping') -----
- cleanseStepList
- "Remove morphs from the step list that are not in this World. Often were in a flap that has moved on to another world."
-
- worldState cleanseStepListForWorld: self!
Item was removed:
- ----- Method: PasteUpMorph>>clearCommandHistory (in category 'undo') -----
- clearCommandHistory
-
- worldState ifNotNil: [worldState clearCommandHistory]!
Item was removed:
- ----- Method: PasteUpMorph>>closeUnchangedWindows (in category 'world menu') -----
- closeUnchangedWindows
- "Present a menu of window titles for all windows with changes,
- and activate the one that gets chosen."
- (UIManager default confirm:
- 'Do you really want to close all windows
- except those with unaccepted edits?' translated)
- ifFalse: [^ self].
-
- (SystemWindow windowsIn: self satisfying: [:w | w model canDiscardEdits])
- do: [:w | w delete]!
Item was removed:
- ----- Method: PasteUpMorph>>closedViewerFlapTabs (in category 'misc') -----
- closedViewerFlapTabs
- "Answer all the viewer flap tabs in receiver that are closed"
-
- ^ self submorphs select:
- [:m | (m isKindOf: ViewerFlapTab) and: [m flapShowing not]]!
Item was removed:
- ----- Method: PasteUpMorph>>collapseAll (in category 'world menu') -----
- collapseAll
- "Collapse all windows"
- (SystemWindow windowsIn: self satisfying: [:w | w isCollapsed not])
- reverseDo: [:w | w collapseOrExpand. self displayWorld].
- self collapseNonWindows!
Item was removed:
- ----- Method: PasteUpMorph>>collapseNonWindows (in category 'world menu') -----
- collapseNonWindows
- self allNonFlapRelatedSubmorphs do:
- [:m | m collapse]!
Item was removed:
- ----- Method: PasteUpMorph>>colorAt:belowMorph: (in category 'world state') -----
- colorAt: aPoint belowMorph: aMorph
- "Return the color of the pixel immediately behind the given morph at the given point.
- NOTE: due to some bounds wobble in flexing, we take the middle of 3x3 rect."
- ^ (self patchAt: (aPoint-1 extent: 3) without: aMorph andNothingAbove: true)
- colorAt: 1 at 1
- !
Item was removed:
- ----- Method: PasteUpMorph>>commandHistory (in category 'undo') -----
- commandHistory
- "Return the command history for the receiver"
- ^self isWorldMorph
- ifTrue:[worldState commandHistory]
- ifFalse:[super commandHistory]!
Item was removed:
- ----- Method: PasteUpMorph>>commandKeySelectors (in category 'world menu') -----
- commandKeySelectors
- "Answer my command-key table"
-
- | aDict |
- aDict := self valueOfProperty: #commandKeySelectors ifAbsentPut: [self initializeDesktopCommandKeySelectors].
- ^ aDict!
Item was removed:
- ----- Method: PasteUpMorph>>connectRemoteUser (in category 'world menu') -----
- connectRemoteUser
-
- ^self
- connectRemoteUserWithName: nil
- picture: nil
- andIPAddress: nil
- !
Item was removed:
- ----- Method: PasteUpMorph>>connectRemoteUserWithName:picture:andIPAddress: (in category 'world menu') -----
- connectRemoteUserWithName: nameStringOrNil picture: aFormOrNil andIPAddress: aStringOrNil
- "Prompt for the initials to be used to identify the cursor of a remote user, then create a cursor for that user and wait for a connection."
-
- | initials addr h |
- initials := nameStringOrNil.
- initials isEmptyOrNil ifTrue: [
- initials := UIManager default request: 'Enter initials for remote user''s cursor?'.
- ].
- initials isEmpty ifTrue: [^ self]. "abort"
- addr := 0.
- aStringOrNil isEmptyOrNil ifFalse: [
- addr := NetNameResolver addressForName: aStringOrNil timeout: 30
- ].
- addr = 0 ifTrue: [
- addr := NetNameResolver promptUserForHostAddress.
- ].
- addr = 0 ifTrue: [^ self]. "abort"
-
- (RemoteHandMorph ensureNetworkConnected) ifFalse: [^ self]. "abort"
-
- h := RemoteHandMorph new userInitials: initials andPicture: aFormOrNil.
- self addHand: h.
- h changed.
- h startListening.
- h startTransmittingEventsTo: addr.
- !
Item was removed:
- ----- Method: PasteUpMorph>>convertAlignment (in category 'layout') -----
- convertAlignment
- self
- clipSubmorphs: true ;
- layoutPolicy: nil ;
- layoutInset: 0 ;
- cellInset: 0 ;
- vResizing: #rigid!
Item was removed:
- ----- Method: PasteUpMorph>>convertRemoteClientToBuffered: (in category 'Nebraska') -----
- convertRemoteClientToBuffered: aClient
-
- worldState removeRemoteCanvas: aClient canvas.
- aClient convertToBuffered.
- worldState addRemoteCanvas: aClient canvas.
- self changed. "force a redraw"
- !
Item was removed:
- ----- Method: PasteUpMorph>>convertToCurrentVersion:refStream: (in category 'objects from disk') -----
- convertToCurrentVersion: varDict refStream: smartRefStrm
-
- "transition from project to worldState (8/16/1999)"
- worldState ifNil: [varDict at: 'project' ifPresent: [ :x | worldState := x]].
-
- "elimination of specific gradient stuff (5/6/2000)"
- varDict at: 'fillColor2' ifPresent: [ :color2 |
- (color isColor and: [color2 isColor and: [color ~= color2]]) ifTrue: [
- self useGradientFill.
- self fillStyle
- colorRamp: {0.0 -> color. 1.0 -> color2};
- radial: false;
- origin: self position;
- direction: ((varDict at: 'gradientDirection') == #vertical
- ifTrue:[0 at self height]
- ifFalse:[self width at 0]).
- ]
- ].
-
- "support shortcuts with the new event filters (5/24/2018)"
- self
- initializeKeyboardShortcuts;
- initializeMouseShortcuts.
-
- ^super convertToCurrentVersion: varDict refStream: smartRefStrm.
- !
Item was removed:
- ----- Method: PasteUpMorph>>correspondingFlapTab (in category 'flaps') -----
- correspondingFlapTab
- "If there is a flap tab whose referent is me, return it, else return nil. Will also work for flaps on the edge of embedded subareas such as within scripting-areas, but more slowly."
-
- self currentWorld flapTabs do:
- [:aTab | aTab referent == self ifTrue: [^ aTab]].
-
- "Catch guys in embedded worldlets"
- self currentWorld allMorphs do:
- [:aTab | ((aTab isKindOf: FlapTab) and: [aTab referent == self]) ifTrue: [^ aTab]].
-
- ^ nil!
Item was removed:
- ----- Method: PasteUpMorph>>couldMakeSibling (in category 'classification') -----
- couldMakeSibling
-
- ^ self isWorldMorph not!
Item was removed:
- ----- Method: PasteUpMorph>>createCustomModel (in category 'model') -----
- createCustomModel
- "Create a model object for this world if it does not yet have one. A model object is an initially empty subclass of MorphicModel. As the user names parts and adds behavior, instance variables and methods are added to this class."
-
- model isNil ifFalse: [^self].
- model := MorphicModel newSubclass new!
Item was removed:
- ----- Method: PasteUpMorph>>currentlyUsingVectorVocabulary (in category 'menu & halo') -----
- currentlyUsingVectorVocabulary
- "Answer whether this world is currently set up to use the vector vocabulary"
-
- ^ (self valueOfProperty: #currentVocabularySymbol) == #Vector!
Item was removed:
- ----- Method: PasteUpMorph>>cursor (in category 'e-toy support') -----
- cursor
- ^ cursor
- !
Item was removed:
- ----- Method: PasteUpMorph>>cursor: (in category 'e-toy support') -----
- cursor: aNumber
- "for backward compatibility"
-
- self cursorWrapped: aNumber!
Item was removed:
- ----- Method: PasteUpMorph>>cursorWrapped: (in category 'cursor') -----
- cursorWrapped: aNumber
- "Set the cursor to the given number, modulo the number of items I
- contain. Fractional cursor values are allowed."
- | oldRect newRect offset |
- cursor = aNumber
- ifTrue: [^ self].
- self hasSubmorphs
- ifFalse: [cursor := 1.
- ^ self].
- oldRect := self selectedRect.
- offset := (self asNumber: aNumber) - 1 \\ submorphs size.
- cursor := offset + 1.
- newRect := self selectedRect.
- self indicateCursor
- ifTrue: [self invalidRect: oldRect;
- invalidRect: newRect]!
Item was removed:
- ----- Method: PasteUpMorph>>deEmphasizeViewMVC: (in category 'world state') -----
- deEmphasizeViewMVC: asTwoTone
- self flag: #arNote. "Probably unnecessary"
- worldState handsDo: "free dependents links if any"
- [:h | h releaseKeyboardFocus].
- worldState canvas: nil. "free model's canvas to save space"
- self fullReleaseCachedState.
- asTwoTone ifTrue: [
- "draw deEmphasized as a two-tone (monochrome) form"
- self displayWorldAsTwoTone].
- !
Item was removed:
- ----- Method: PasteUpMorph>>defaultBorderColor (in category 'initialization') -----
- defaultBorderColor
- "answer the default border color/fill style for the receiver"
- ^ Color
- r: 0.861
- g: 1.0
- b: 0.722!
Item was removed:
- ----- Method: PasteUpMorph>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- "answer the default border width for the receiver"
- ^ 1!
Item was removed:
- ----- Method: PasteUpMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Preferences defaultWorldColor muchLighter.!
Item was removed:
- ----- Method: PasteUpMorph>>defaultNameStemForInstances (in category 'viewer') -----
- defaultNameStemForInstances
- "Answer a basis for names of default instances of the receiver"
- ^ self isWorldMorph
- ifFalse:
- [super defaultNameStemForInstances]
- ifTrue:
- ['world' translatedNoop]!
Item was removed:
- ----- Method: PasteUpMorph>>defersHaloOnClickTo: (in category 'halos and balloon help') -----
- defersHaloOnClickTo: aSubMorph
- "If a cmd-click on aSubMorph would make it a preferred recipient of the halo, answer true"
- ^ true
- !
Item was removed:
- ----- Method: PasteUpMorph>>defineApplicationView (in category 'menu & halo') -----
- defineApplicationView
-
- | r |
- r := Rectangle fromUser.
- self
- setProperty: #applicationViewBounds
- toValue: ((self transformFromOutermostWorld) globalBoundsToLocal: r) truncated !
Item was removed:
- ----- Method: PasteUpMorph>>defineFactoryView (in category 'menu & halo') -----
- defineFactoryView
-
- | r |
- r := Rectangle fromUser.
- self
- setProperty: #factoryViewBounds
- toValue: ((self transformFromOutermostWorld) globalBoundsToLocal: r) truncated !
Item was removed:
- ----- Method: PasteUpMorph>>delayedInvokeWorldMenu: (in category 'world menu') -----
- delayedInvokeWorldMenu: evt
- self
- addAlarm: #invokeWorldMenu:
- with: evt
- after: 200!
Item was removed:
- ----- Method: PasteUpMorph>>deleteAllHalos (in category 'world state') -----
- deleteAllHalos
- self haloMorphs do:
- [ : m | m target isSelectionMorph ifTrue: [ m target delete ] ].
- self hands do:
- [ : each | each removeHalo ]!
Item was removed:
- ----- Method: PasteUpMorph>>deleteBalloonTarget: (in category 'menu & halo') -----
- deleteBalloonTarget: aMorph
- "Delete the balloon help targeting the given morph"
- self handsDo:[:h| h deleteBalloonTarget: aMorph].!
Item was removed:
- ----- Method: PasteUpMorph>>deleteGlobalFlapArtifacts (in category 'flaps') -----
- deleteGlobalFlapArtifacts
- "Delete all flap-related detritus from the world"
-
- | localFlaps |
- localFlaps := self localFlapTabs collect: [:m | m referent].
- self submorphs do:
- [:m |
- ((m isFlapTab) and: [m isGlobalFlap]) ifTrue: [m delete].
- m isFlap ifTrue:[(localFlaps includes: m) ifFalse: [m delete]]]
-
- "ActiveWorld deleteGlobalFlapArtifacts"
-
- !
Item was removed:
- ----- Method: PasteUpMorph>>deleteNonWindows (in category 'world menu') -----
- deleteNonWindows
- (UIManager default confirm:
- 'Do you really want to discard all objects
- that are not in windows?' translated)
- ifFalse: [^ self].
-
- self allNonFlapRelatedSubmorphs do:
- [:m | m delete]!
Item was removed:
- ----- Method: PasteUpMorph>>detachableScriptingSpace (in category 'world menu') -----
- detachableScriptingSpace
- ScriptingSystem newScriptingSpace openInWorld: self!
Item was removed:
- ----- Method: PasteUpMorph>>disconnectAllRemoteUsers (in category 'world menu') -----
- disconnectAllRemoteUsers
- "Disconnect all remote hands and stop transmitting events."
- self world handsDo: [:h |
- (h isKindOf: RemoteHandMorph)
- ifTrue: [h withdrawFromWorld]].!
Item was removed:
- ----- Method: PasteUpMorph>>disconnectRemoteUser (in category 'world menu') -----
- disconnectRemoteUser
- "Prompt for the initials of the remote user, then remove the remote hand with those initials, breaking its connection."
-
- "select hand to remove"
- | initials handToRemove |
- initials := UIManager default request: 'Enter initials for remote user''s cursor?'.
- initials isEmpty ifTrue: [^ self]. "abort"
- handToRemove := nil.
- self handsDo: [:h |
- h userInitials = initials ifTrue: [handToRemove := h]].
- handToRemove ifNil: [^ self]. "no hand with those initials"
- handToRemove withdrawFromWorld.
- !
Item was removed:
- ----- Method: PasteUpMorph>>dispatchCommandKeyInWorld:event: (in category 'world menu') -----
- dispatchCommandKeyInWorld: aChar event: evt
- "Dispatch the desktop command key if possible. Answer whether handled"
-
- | aMessageSend |
- aMessageSend := self commandKeySelectors at: aChar ifAbsent: [^ false].
- aMessageSend selector numArgs = 0
- ifTrue:
- [aMessageSend value]
- ifFalse:
- [aMessageSend valueWithArguments: (Array with: evt)].
- ^ true
- !
Item was removed:
- ----- Method: PasteUpMorph>>displayWorld (in category 'world state') -----
- displayWorld
-
- self outermostWorldMorph privateOuterDisplayWorld
- !
Item was removed:
- ----- Method: PasteUpMorph>>displayWorldAsTwoTone (in category 'world state') -----
- displayWorldAsTwoTone
- "Display the world in living black-and-white. (This is typically done to save space.)"
-
- worldState displayWorldAsTwoTone: self submorphs: submorphs color: color
- !
Item was removed:
- ----- Method: PasteUpMorph>>displayWorldNonIncrementally (in category 'world state') -----
- displayWorldNonIncrementally
- "Display the morph world non-incrementally. Used for testing."
-
- (worldState canvas isNil or:
- [worldState canvas extent ~= self viewBox extent
- or: [worldState canvas form depth ~= Display depth]])
- ifTrue:
- ["allocate a new offscreen canvas the size of the window"
-
- worldState
- canvas: (Display defaultCanvasClass extent: self viewBox extent)].
- worldState canvas fillColor: color.
- submorphs reverseDo: [:m | worldState canvas fullDrawMorph: m].
- worldState handsReverseDo: [:h | worldState canvas fullDrawMorph: h].
- worldState canvas form displayOn: Display at: self viewBox origin.
- self fullRepaintNeeded. "don't collect damage"
- Display forceDisplayUpdate!
Item was removed:
- ----- Method: PasteUpMorph>>displayWorldSafely (in category 'world state') -----
- displayWorldSafely
-
- worldState displayWorldSafely: self.
- !
Item was removed:
- ----- Method: PasteUpMorph>>doOneCycle (in category 'world state') -----
- doOneCycle
- "see the comment in doOneCycleFor:"
-
- worldState doOneCycleFor: self!
Item was removed:
- ----- Method: PasteUpMorph>>doOneCycleInBackground (in category 'world state') -----
- doOneCycleInBackground
-
- worldState doOneCycleInBackground
- !
Item was removed:
- ----- Method: PasteUpMorph>>doOneCycleNow (in category 'interaction loop') -----
- doOneCycleNow
- "see the comment in doOneCycleNowFor:"
- worldState doOneCycleNowFor: self.
- !
Item was removed:
- ----- Method: PasteUpMorph>>doOneSubCycle (in category 'world state') -----
- doOneSubCycle
- "Like doOneCycle, but preserves activeHand."
-
- worldState doOneSubCycleFor: self!
Item was removed:
- ----- Method: PasteUpMorph>>dragThroughOnDesktop: (in category 'world state') -----
- dragThroughOnDesktop: evt
- "Draw out a selection rectangle"
- | selection |
- selection := SelectionMorph newBounds: (evt cursorPoint extent: 8 at 8).
- self addMorph: selection.
- ^ selection extendByHand: evt hand
- !
Item was removed:
- ----- Method: PasteUpMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- "Draw in order:
- - background color
- - Update and draw the turtleTrails form. See the comment in updateTrailsForm.
- - cursor box if any
-
- Later (in drawSubmorphsOn:) I will skip drawing the background sketch."
-
- "draw background fill"
- super drawOn: aCanvas.
-
- "draw turtle trails"
- (lastTurtlePositions isNil or: [lastTurtlePositions isEmpty]) ifFalse:[
- self updateTrailsForm.
- ].
- turtleTrailsForm
- ifNotNil: [aCanvas paintImage: turtleTrailsForm at: self position].
-
- "draw cursor"
- (submorphs notEmpty and: [self indicateCursor])
- ifTrue:
- [aCanvas
- frameRectangle: self selectedRect
- width: 2
- color: Color black]!
Item was removed:
- ----- Method: PasteUpMorph>>drawingClass (in category 'world menu') -----
- drawingClass
-
- ^ SketchMorph!
Item was removed:
- ----- Method: PasteUpMorph>>dropEnabled (in category 'dropping/grabbing') -----
- dropEnabled
- "Get this morph's ability to add and remove morphs via drag-n-drop."
-
- ^ (self valueOfProperty: #dropEnabled) ~~ false
- !
Item was removed:
- ----- Method: PasteUpMorph>>dropFiles:event: (in category 'event handling') -----
- dropFiles: filesAndDirectories event: anEvent
- "Handle a number of dropped files from the OS."
-
- filesAndDirectories do: [ :file |
- self handleDroppedItem: file event: anEvent].!
Item was removed:
- ----- Method: PasteUpMorph>>dropSourceCode:event: (in category 'event handling') -----
- dropSourceCode: anObject event: evt
-
- (anObject isMethodReference and: [anObject isValid])
- ifTrue: [^ self dropSourceCode: anObject compiledMethod event: evt].
-
- (anObject isBehavior or: [anObject isCompiledMethod])
- ifTrue: [
- | tool window |
- tool := anObject isBehavior
- ifTrue: [Browser new
- setClass: anObject]
- ifFalse: [CodeHolder new
- setClass: anObject methodClass
- selector: anObject selector].
- window := ToolBuilder open: tool.
- window center: evt position.
- window bounds: (window bounds translatedToBeWithin: self bounds)].
-
- anObject isString
- ifTrue: [anObject edit].!
Item was removed:
- ----- Method: PasteUpMorph>>dumpPresenter (in category 'accessing') -----
- dumpPresenter
- "Dump my current presenter"
- presenter := nil.!
Item was removed:
- ----- Method: PasteUpMorph>>embeddedProjectDisplayMode (in category 'world state') -----
- embeddedProjectDisplayMode
-
- "#naked - the embedded project/world is just a pasteup in the outer p/w
- #window - the embedded p/w is in a system window in the outer p/w
- #frame - the embedded p/w is in a green frame and clipped
- #scaled - the embedded p/w is in a green frame and scaled to fit"
-
- ^#scaled
- !
Item was removed:
- ----- Method: PasteUpMorph>>enableGlobalFlaps (in category 'flaps') -----
- enableGlobalFlaps
- "Restore saved global flaps, or obtain brand-new system defaults if necessary"
-
- Flaps globalFlapTabs. "If nil, creates new ones"
- self addGlobalFlaps "put them on screen"!
Item was removed:
- ----- Method: PasteUpMorph>>endDrawing: (in category 'world state') -----
- endDrawing: evt
- "If painting is already underway
- in the receiver, finish and save it."
- | editor |
- (editor := self sketchEditorOrNil) ifNotNil:[
- editor save: evt.
- Cursor normal show.
- ].!
Item was removed:
- ----- Method: PasteUpMorph>>exit (in category 'world state') -----
- exit
-
- Project current exit
- !
Item was removed:
- ----- Method: PasteUpMorph>>expandAll (in category 'world menu') -----
- expandAll
- "Expand all windows"
- (SystemWindow windowsIn: self satisfying: [:w | w isCollapsed])
- reverseDo: [:w | w collapseOrExpand. self displayWorld]!
Item was removed:
- ----- Method: PasteUpMorph>>extent: (in category 'geometry') -----
- extent: aPoint
-
- super extent: aPoint.
- worldState ifNotNil: [
- worldState viewBox ifNotNil: [
- worldState canvas: nil.
- worldState viewBox: bounds
- ].
- ].!
Item was removed:
- ----- Method: PasteUpMorph>>extractScreenRegion:andPutSketchInHand: (in category 'world menu') -----
- extractScreenRegion: poly andPutSketchInHand: hand
- "The user has specified a polygonal area of the Display.
- Now capture the pixels from that region, and put in the hand as a Sketch."
- | screenForm outline topLeft innerForm exterior |
- outline := poly shadowForm.
- topLeft := outline offset.
- exterior := (outline offset: 0 at 0) anyShapeFill reverse.
- screenForm := Form fromDisplay: (topLeft extent: outline extent).
- screenForm eraseShape: exterior.
- innerForm := screenForm trimBordersOfColor: Color transparent.
- self currentHand showTemporaryCursor: nil.
- innerForm isAllWhite ifFalse:
- [hand attachMorph: (self drawingClass withForm: innerForm)]!
Item was removed:
- ----- Method: PasteUpMorph>>fillStyle: (in category 'visual properties') -----
- fillStyle: aFormOrColorOrFillStyle
-
- ^ super fillStyle: (aFormOrColorOrFillStyle isForm
- ifTrue: [InfiniteForm with: aFormOrColorOrFillStyle]
- ifFalse: [aFormOrColorOrFillStyle isColor
- ifTrue: [SolidFillStyle color: aFormOrColorOrFillStyle]
- ifFalse: [aFormOrColorOrFillStyle]])!
Item was removed:
- ----- Method: PasteUpMorph>>filterEvent:for: (in category 'events-processing') -----
- filterEvent: mouseOrKeyboardEvent for: anObject
-
- "1) Mouse shortcuts"
- mouseOrKeyboardEvent isMouse ifTrue: [
-
- "Only accept mouse down, no up."
- mouseOrKeyboardEvent isMouseDown
- ifFalse: [^ mouseOrKeyboardEvent].
-
- mouseOrKeyboardEvent blueButtonPressed
- ifTrue: [ self tryInvokeHalo: mouseOrKeyboardEvent]
- ifFalse: [mouseOrKeyboardEvent controlKeyPressed
- ifTrue: [self tryInvokeMetaMenu: mouseOrKeyboardEvent]].
-
- ^ mouseOrKeyboardEvent].
-
- "2) Keyboard shortcuts"
- mouseOrKeyboardEvent isKeyboard ifTrue: [
-
- "Delegate keyboard shortcuts to my docking bars."
- self submorphsDo: [:ea | ea isDockingBar ifTrue: [
- ea filterEvent: mouseOrKeyboardEvent for: anObject. "No support for converting events here!!"
- mouseOrKeyboardEvent wasIgnored ifTrue: [^ mouseOrKeyboardEvent "early out"]]].
-
- "Only accept key strokes as shortcuts, no down/up."
- mouseOrKeyboardEvent isKeystroke
- ifFalse: [^ mouseOrKeyboardEvent].
-
- self tryInvokeKeyboardShortcut: mouseOrKeyboardEvent.
-
- ^ mouseOrKeyboardEvent].
-
- "Should not be necessary if this filter is correctly configured."
- ^ mouseOrKeyboardEvent!
Item was removed:
- ----- Method: PasteUpMorph>>findAChangeSorter: (in category 'world menu') -----
- findAChangeSorter: evt
- "Locate a change sorter, open it, and bring it to the front. Create one if necessary"
-
- self findAWindowSatisfying:
- [:aWindow | (aWindow model isMemberOf: ChangeSorter) or:
- [aWindow model isKindOf: DualChangeSorter]] orMakeOneUsing: [DualChangeSorter open]!
Item was removed:
- ----- Method: PasteUpMorph>>findAFileList: (in category 'world menu') -----
- findAFileList: evt
- "Bring a file list to the foreground, reusing an existing one if possible."
- self
- findAWindowSatisfying: [ : aWindow | (aWindow model class = FileList) and: [ aWindow model hasUnacceptedEdits not ] ]
- orMakeOneUsing: [ FileList prototypicalToolWindow openInWorld ]!
Item was removed:
- ----- Method: PasteUpMorph>>findAMessageNamesWindow: (in category 'world menu') -----
- findAMessageNamesWindow: evt
- "Locate a MessageNames tool, open it, and bring it to the front. Create one if necessary"
-
- self findAWindowSatisfying:
- [:aWindow | aWindow model isKindOf: MessageNames] orMakeOneUsing: [MessageNames openMessageNames]!
Item was removed:
- ----- Method: PasteUpMorph>>findAPreferencesPanel: (in category 'world menu') -----
- findAPreferencesPanel: evt
- "Locate a Preferences Panel, open it, and bring it to the front. Create one if necessary"
- Smalltalk at: #PreferenceBrowser ifPresent:[:pb|
- self findAWindowSatisfying:[:aWindow | aWindow model isKindOf: pb]
- orMakeOneUsing:[pb open]
- ].!
Item was removed:
- ----- Method: PasteUpMorph>>findATranscript: (in category 'world menu') -----
- findATranscript: evt
- "Locate a transcript, open it, and bring it to the front. Create one if necessary"
-
- self findAWindowSatisfying:
- [:aWindow | aWindow model == Transcript] orMakeOneUsing: [Transcript openLabel: 'Transcript']!
Item was removed:
- ----- Method: PasteUpMorph>>findAWindowSatisfying:orMakeOneUsing: (in category 'world menu') -----
- findAWindowSatisfying: qualifyingBlock orMakeOneUsing: makeBlock
- "Locate a window satisfying a block, open it, and bring it to the front. Create one if necessary, by using the makeBlock"
-
- submorphs do:
- [:aMorph | | aWindow |
- (((aWindow := aMorph renderedMorph) isSystemWindow)
- and: [qualifyingBlock value: aWindow]) ifTrue:
- [aWindow isCollapsed ifTrue: [aWindow expand].
- self addMorphFront: aWindow.
- aWindow beKeyWindow.
- ^self]].
- "None found, so create one"
- makeBlock value!
Item was removed:
- ----- Method: PasteUpMorph>>findDirtyBrowsers: (in category 'world menu') -----
- findDirtyBrowsers: evt
- "Present a menu of window titles for browsers with changes,
- and activate the one that gets chosen."
-
- | menu |
- menu := MenuMorph new.
- (SystemWindow windowsIn: self
- satisfying: [:w | (w model isKindOf: Browser) and: [w model canDiscardEdits not]])
- do:
- [:w |
- menu
- add: w label
- target: w
- action: #beKeyWindow].
- menu submorphs notEmpty ifTrue: [menu popUpEvent: evt in: self]!
Item was removed:
- ----- Method: PasteUpMorph>>findDirtyWindows: (in category 'world menu') -----
- findDirtyWindows: evt
- "Present a menu of window titles for all windows with changes,
- and activate the one that gets chosen."
-
- | menu |
- menu := MenuMorph new.
- (SystemWindow windowsIn: self
- satisfying: [:w | w model canDiscardEdits not]) do:
- [:w |
- menu
- add: w label
- target: w
- action: #beKeyWindow].
- menu submorphs notEmpty ifTrue: [menu popUpEvent: evt in: self]!
Item was removed:
- ----- Method: PasteUpMorph>>findWindow: (in category 'world menu') -----
- findWindow: evt
- "Present a menu names of windows and naked morphs, and activate the one that gets chosen. Collapsed windows appear below line, expand if chosen; naked morphs appear below second line; if any of them has been given an explicit name, that is what's shown, else the class-name of the morph shows; if a naked morph is chosen, bring it to front and have it don a halo."
- | menu expanded collapsed nakedMorphs |
- menu := MenuMorph new.
- expanded := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed not].
- collapsed := SystemWindow windowsIn: self satisfying: [:w | w isCollapsed].
- nakedMorphs := self submorphsSatisfying:
- [:m | (m isSystemWindow not and: [(m isStickySketchMorph) not]) and:
- [(m isFlapTab) not]].
- (expanded isEmpty & (collapsed isEmpty & nakedMorphs isEmpty)) ifTrue: [^ Beeper beep].
- (expanded sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do:
- [:w | menu add: (w label contractTo: 80) target: w action: #beKeyWindow.
- w model canDiscardEdits ifFalse: [menu lastItem color: Color red]].
- (expanded isEmpty | (collapsed isEmpty & nakedMorphs isEmpty)) ifFalse: [menu addLine].
- (collapsed sort: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) do:
- [:w | menu add: (w label contractTo: 80) target: w action: #collapseOrExpand.
- w model canDiscardEdits ifFalse: [menu lastItem color: Color red]].
- nakedMorphs isEmpty ifFalse: [menu addLine].
- (nakedMorphs sort: [:w1 :w2 | w1 nameForFindWindowFeature caseInsensitiveLessOrEqual: w2 nameForFindWindowFeature]) do:
- [:w | menu add: (w nameForFindWindowFeature contractTo: 80) target: w action: #comeToFrontAndAddHalo].
- menu addTitle: 'find window' translated.
-
- menu popUpEvent: evt in: self.!
Item was removed:
- ----- Method: PasteUpMorph>>firstHand (in category 'project state') -----
- firstHand
-
- ^ worldState hands first!
Item was removed:
- ----- Method: PasteUpMorph>>fixUponLoad:seg: (in category 'objects from disk') -----
- fixUponLoad: aProject seg: anImageSegment
- "We are in an old project that is being loaded from disk.
- Fix up conventions that have changed."
- | weakMessage |
- self isWorldMorph
- ifTrue: [(self valueOfProperty: #soundAdditions)
- ifNotNil: [:additions | SampledSound assimilateSoundsFrom: additions]].
- self actionMap
- ifNotNil: [:aDictionary |
- weakMessage := aDictionary
- at: #aboutToLeaveWorld
- ifAbsent: [].
- weakMessage
- ifNotNil: [weakMessage selector = #removeModalWindow
- ifTrue: [weakMessage receiver: nil]]].
- ^ super fixUponLoad: aProject seg: anImageSegment!
Item was removed:
- ----- Method: PasteUpMorph>>flapTab (in category 'accessing') -----
- flapTab
- "Answer the tab affilitated with the receiver. Normally every flap tab is expected to have a PasteUpMorph which serves as its 'referent.'"
-
- | ww |
- self isFlap ifFalse: [^ nil].
- ww := self presenter associatedMorph ifNil: [self].
- ^ ww flapTabs
- detect: [:any| any referent == self]
- ifNone: [nil]!
Item was removed:
- ----- Method: PasteUpMorph>>flapTabs (in category 'flaps') -----
- flapTabs
- ^ self submorphs select:[:m| m isFlapTab]!
Item was removed:
- ----- Method: PasteUpMorph>>flashRects:color: (in category 'world state') -----
- flashRects: rectangleList color: aColor
- "For testing. Flashes the given list of rectangles on the Display so you can watch incremental redisplay at work."
- "Details: Uses two reverses so that the display is restored to its original state. This is necessary when in deferred update mode."
-
- | blt |
- blt := (BitBlt toForm: Display)
- sourceForm: nil;
- sourceOrigin: 0 at 0;
- clipRect: self viewBox;
- combinationRule: Form reverse.
- rectangleList do: [:r | | screenRect |
- screenRect := r translateBy: self viewBox origin.
- blt destRect: screenRect; copyBits.
- Display forceToScreen: screenRect; forceDisplayUpdate.
- (Delay forMilliseconds: 15) wait.
- blt destRect: screenRect; copyBits.
- Display forceToScreen: screenRect; forceDisplayUpdate].
- !
Item was removed:
- ----- Method: PasteUpMorph>>fullContainsPoint: (in category 'geometry testing') -----
- fullContainsPoint: pt
- "The world clips its children"
-
- worldState ifNil: [^super fullContainsPoint: pt].
- ^bounds containsPoint: pt
-
- !
Item was removed:
- ----- Method: PasteUpMorph>>fullRepaintNeeded (in category 'world state') -----
- fullRepaintNeeded
-
- worldState doFullRepaint.
- SystemWindow windowsIn: self
- satisfying: [:w | w makeMeVisible. false].
-
- !
Item was removed:
- ----- Method: PasteUpMorph>>getWorldMenu: (in category 'world menu') -----
- getWorldMenu: aSymbol
- ^(TheWorldMenu new
- world: self
- project: (self project ifNil: [Project current]) "mvc??"
- hand: self primaryHand) perform: aSymbol!
Item was removed:
- ----- Method: PasteUpMorph>>goBack (in category 'world state') -----
- goBack
-
- Project returnToPreviousProject.
- !
Item was removed:
- ----- Method: PasteUpMorph>>grabDrawingFromScreen: (in category 'world menu') -----
- grabDrawingFromScreen: evt
- "Allow the user to specify a rectangular area of the Display, capture the pixels from that area, and use them to create a new drawing morph. Attach the result to the hand."
- | m |
- m := self drawingClass new form: Form fromUser.
- evt hand position: Sensor cursorPoint. "update hand pos after Sensor loop in fromUser"
- evt hand attachMorph: m.!
Item was removed:
- ----- Method: PasteUpMorph>>grabFloodFromScreen: (in category 'world menu') -----
- grabFloodFromScreen: evt
- "Allow the user to plant a flood seed on the Display, and create a new drawing morph from the resulting region. Attach the result to the hand."
- | screenForm exterior p1 box |
- p1 := Cursor crossHair showWhile: [Sensor waitButton].
- box := Display floodFill: Color transparent at: p1.
- exterior := ((Display copy: box) makeBWForm: Color transparent) reverse.
- self world invalidRect: box; displayWorldSafely.
- (box area > (Display boundingBox area // 2))
- ifTrue: [^ UIManager default notify: 'Sorry, the region was too big'].
- (exterior deepCopy reverse anyShapeFill reverse) "save interior bits"
- displayOn: exterior at: 0 at 0 rule: Form and.
- screenForm := Form fromDisplay: box.
- screenForm eraseShape: exterior.
- screenForm isAllWhite ifFalse:
- [evt hand attachMorph: (self drawingClass withForm: screenForm)]!
Item was removed:
- ----- Method: PasteUpMorph>>grabLassoFromScreen: (in category 'world menu') -----
- grabLassoFromScreen: evt
- "Allow the user to specify a polygonal area of the Display, capture the pixels from that area, and use them to create a new drawing morph. Attach the result to the hand."
-
- self extractScreenRegion: (PolygonMorph fromHandFreehand: evt hand)
- andPutSketchInHand: evt hand
- !
Item was removed:
- ----- Method: PasteUpMorph>>grabRubberBandFromScreen: (in category 'world menu') -----
- grabRubberBandFromScreen: evt
- "Allow the user to specify a polygonal area of the Display, capture the pixels from that area, and use them to create a new drawing morph. Attach the result to the hand."
-
- self extractScreenRegion: (PolygonMorph fromHand: evt hand)
- andPutSketchInHand: evt hand!
Item was removed:
- ----- Method: PasteUpMorph>>gradientFillColor: (in category 'display') -----
- gradientFillColor: aColor
- "For backwards compatibility with GradientFillMorph"
-
- self flag: #fixThis.
- self useGradientFill.
- self fillStyle colorRamp: {0.0 -> self fillStyle colorRamp first value. 1.0 -> aColor}.
- self setAsBackground: self fillStyle.
- self changed!
Item was removed:
- ----- Method: PasteUpMorph>>haloMorphs (in category 'world state') -----
- haloMorphs
- ^ self hands collect:[:h| h halo] thenSelect:[:halo| halo notNil]!
Item was removed:
- ----- Method: PasteUpMorph>>handleDroppedItem:event: (in category 'event handling') -----
- handleDroppedItem: anItem event: anEvent
-
- (ExternalDropHandler lookupExternalDropHandler: anItem)
- ifNotNil: [:handler | handler handle: anItem in: self dropEvent: anEvent].!
Item was removed:
- ----- Method: PasteUpMorph>>handlesKeyboard: (in category 'event handling') -----
- handlesKeyboard: evt
- ^self isWorldMorph or:[evt keyCharacter == Character tab and:[self tabAmongFields]]!
Item was removed:
- ----- Method: PasteUpMorph>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: evt
- ^true!
Item was removed:
- ----- Method: PasteUpMorph>>hands (in category 'project state') -----
- hands
-
- ^ worldState hands!
Item was removed:
- ----- Method: PasteUpMorph>>handsDo: (in category 'project state') -----
- handsDo: aBlock
-
- ^ worldState ifNotNil: [ worldState handsDo: aBlock ]!
Item was removed:
- ----- Method: PasteUpMorph>>handsReverseDo: (in category 'project state') -----
- handsReverseDo: aBlock
-
- ^ worldState ifNotNil: [ worldState handsReverseDo: aBlock ]!
Item was removed:
- ----- Method: PasteUpMorph>>hasRemoteServer (in category 'Nebraska') -----
- hasRemoteServer
- ^self remoteServer notNil!
Item was removed:
- ----- Method: PasteUpMorph>>hasTransferMorphConverter (in category 'dropping/grabbing') -----
- hasTransferMorphConverter
- ^ self transferMorphConverter ~= #yourself!
Item was removed:
- ----- Method: PasteUpMorph>>heightForThumbnails (in category 'misc') -----
- heightForThumbnails
- ^ self valueOfProperty: #heightForThumbnails ifAbsent: [50]!
Item was removed:
- ----- Method: PasteUpMorph>>hideFlapsOtherThan:ifClingingTo: (in category 'misc') -----
- hideFlapsOtherThan: aFlapTab ifClingingTo: anEdgeSymbol
- "Hide flaps on the given edge unless they are the given one"
-
- self flapTabs do:
- [:aTab | (aTab edgeToAdhereTo == anEdgeSymbol)
- ifTrue:
- [aTab == aFlapTab
- ifFalse:
- [aTab hideFlap]]]!
Item was removed:
- ----- Method: PasteUpMorph>>hideViewerFlaps (in category 'misc') -----
- hideViewerFlaps
- self flapTabs do:[:aTab |
- (aTab isKindOf: ViewerFlapTab) ifTrue:[aTab hideFlap]]!
Item was removed:
- ----- Method: PasteUpMorph>>hideViewerFlapsOtherThanFor: (in category 'misc') -----
- hideViewerFlapsOtherThanFor: aPlayer
- self flapTabs do:
- [:aTab | (aTab isKindOf: ViewerFlapTab)
- ifTrue:
- [aTab scriptedPlayer == aPlayer
- ifFalse:
- [aTab hideFlap]]]!
Item was removed:
- ----- Method: PasteUpMorph>>icon (in category 'thumbnail') -----
- icon
- "Answer a form with an icon to represent the receiver"
- ^ self isWorldMorph
- ifTrue: [MenuIcons homeIcon]
- ifFalse: [MenuIcons projectIcon]!
Item was removed:
- ----- Method: PasteUpMorph>>indicateCursor (in category 'options') -----
- indicateCursor
- ^ indicateCursor == true!
Item was removed:
- ----- Method: PasteUpMorph>>indicateCursor: (in category 'options') -----
- indicateCursor: aBoolean
- indicateCursor := aBoolean.
- self changed.!
Item was removed:
- ----- Method: PasteUpMorph>>indicateCursorString (in category 'menu & halo') -----
- indicateCursorString
- "Answer the string to be shown in a menu to represent the
- whether-to-indicate-cursor status"
- ^ (self indicateCursor
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'indicate cursor' translated!
Item was removed:
- ----- Method: PasteUpMorph>>initForProject: (in category 'world state') -----
- initForProject: aWorldState
-
- worldState := aWorldState.
- self viewBox: Display boundingBox.
- self color: Preferences defaultWorldColor.
- self addHand: HandMorph new.
- self setProperty: #automaticPhraseExpansion toValue: true.
- self setProperty: #optimumExtentFromAuthor toValue: Display extent.
- self wantsMouseOverHalos: Preferences mouseOverHalos.
- self borderWidth: 0.
- model := nil.
- !
Item was removed:
- ----- Method: PasteUpMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
- cursor := 1.
- padding := 3.
- self enableDragNDrop.
- self isWorldMorph
- ifTrue: [self setProperty: #automaticPhraseExpansion toValue: true].
- self clipSubmorphs: true.
- self initializeKeyboardShortcuts.
- self initializeMouseShortcuts.!
Item was removed:
- ----- Method: PasteUpMorph>>initializeDesktopCommandKeySelectors (in category 'world menu') -----
- initializeDesktopCommandKeySelectors
- "Provide the starting settings for desktop command key selectors. Answer the dictionary."
-
- "ActiveWorld initializeDesktopCommandKeySelectors"
- | dict |
- dict := IdentityDictionary new.
- self defaultDesktopCommandKeyTriplets do: [:trip |
- | messageSend |
- messageSend := MessageSend receiver: trip second selector: trip third.
- dict at: trip first put: messageSend].
- self setProperty: #commandKeySelectors toValue: dict.
- ^ dict!
Item was removed:
- ----- Method: PasteUpMorph>>initializeKeyboardShortcuts (in category 'initialization') -----
- initializeKeyboardShortcuts
- "Install an event capture filter to add shortcuts for global operations like opening a tool."
-
- PasteUpMorph globalCommandKeysEnabled
- ifTrue: [self addKeyboardShortcuts].!
Item was removed:
- ----- Method: PasteUpMorph>>initializeMouseShortcuts (in category 'initialization') -----
- initializeMouseShortcuts
-
- self addMouseShortcuts.!
Item was removed:
- ----- Method: PasteUpMorph>>initializeToStandAlone (in category 'parts bin') -----
- initializeToStandAlone
- "Answer an instance of the receiver suitable for placing in a parts bin for authors"
-
- self initialize.
- self color: Color green muchLighter; extent: 100 @ 80; borderColor: (Color r: 0.645 g: 0.935 b: 0.161).
- self extent: 300 @ 240.
- self beSticky!
Item was removed:
- ----- Method: PasteUpMorph>>innocuousName (in category 'misc') -----
- innocuousName
- ^ (self isFlap)
- ifTrue:
- ['flap' translated]
- ifFalse:
- [super innocuousName]!
Item was removed:
- ----- Method: PasteUpMorph>>install (in category 'world state') -----
- install
-
- owner := nil. "since we may have been inside another world previously"
-
- submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]].
- "Transcript that was in outPointers and then got deleted."
- self viewBox: Display boundingBox.
- EventSensor default flushEvents.
- worldState handsDo: [:h | h initForEvents].
- self installFlaps.
- self borderWidth: 0. "default"
- (Preferences showSecurityStatus
- and: [SecurityManager default isInRestrictedMode])
- ifTrue:
- [self
- borderWidth: 2;
- borderColor: Color red].
- self presenter allExtantPlayers do: [:player | player prepareToBeRunning].
- SystemWindow noteTopWindowIn: self.!
Item was removed:
- ----- Method: PasteUpMorph>>installAsActiveSubprojectIn:at:titled: (in category 'WiW support') -----
- installAsActiveSubprojectIn: enclosingWorld at: newBounds titled: aString
- | window howToOpen tm boundsForWorld |
- howToOpen := self embeddedProjectDisplayMode.
- "#scaled may be the only one that works at the moment"
- submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]].
- "Transcript that was in outPointers and then got deleted."
- boundsForWorld := howToOpen == #naked ifTrue: [newBounds] ifFalse: [bounds].
- worldState canvas: nil.
- worldState viewBox: boundsForWorld.
- self bounds: boundsForWorld.
-
- "self viewBox: Display boundingBox."
- "worldState handsDo: [:h | h initForEvents]."
- self installFlaps.
-
- "SystemWindow noteTopWindowIn: self."
- "self displayWorldSafely."
- howToOpen == #naked ifTrue: [enclosingWorld addMorphFront: self].
- howToOpen == #window
- ifTrue:
- [window := (SystemWindow labelled: aString) model: self.
- window addMorph: self frame: (0 @ 0 extent: 1.0 @ 1.0).
- window openInWorld: enclosingWorld].
- howToOpen == #frame
- ifTrue:
- [window := (AlignmentMorphBob1 new)
- minWidth: 100;
- minHeight: 100;
- borderWidth: 8;
- borderColor: Color green;
- bounds: newBounds.
- window addMorph: self.
- window openInWorld: enclosingWorld].
- howToOpen == #scaled
- ifTrue:
- [self position: 0 @ 0.
- window := (EmbeddedWorldBorderMorph new)
- minWidth: 100;
- minHeight: 100;
- borderWidth: 8;
- borderColor: Color green;
- bounds: newBounds.
- tm := BOBTransformationMorph new.
- window addMorph: tm.
- tm addMorph: self.
- window openInWorld: enclosingWorld.
- tm changeWorldBoundsToShow: bounds.
- self arrangeToStartSteppingIn: enclosingWorld
- "tm scale: (tm width / self width min: tm height / self height) asFloat."]!
Item was removed:
- ----- Method: PasteUpMorph>>installAsActiveSubprojectIn:titled: (in category 'WiW support') -----
- installAsActiveSubprojectIn: enclosingWorld titled: aString
-
- | opt newWidth |
-
- opt := self optimumExtentFromAuthor.
- (opt x > (enclosingWorld width * 0.7) or:
- [opt y > (enclosingWorld height * 0.7)]) ifTrue: [
- newWidth := enclosingWorld width // 2.
- opt := newWidth @ (opt y * newWidth / opt x) truncated
- ].
- ^self
- installAsActiveSubprojectIn: enclosingWorld
- at: (enclosingWorld topLeft + (enclosingWorld extent - opt // 2) extent: opt)
- titled: aString!
Item was removed:
- ----- Method: PasteUpMorph>>installFlaps (in category 'world state') -----
- installFlaps
- "Get flaps installed within the bounds of the receiver"
-
- | localFlapTabs |
- Project current assureFlapIntegrity.
- self addGlobalFlaps.
- localFlapTabs := self localFlapTabs.
- localFlapTabs do: [:each | each visible: false].
-
- localFlapTabs keysAndValuesDo: [:i :each |
- each adaptToWorld.
- each visible: true.
- self changed].
-
- self assureFlapTabsFitOnScreen.
- self bringTopmostsToFront!
Item was removed:
- ----- Method: PasteUpMorph>>invalidRect:from: (in category 'change reporting') -----
- invalidRect: damageRect from: aMorph
- "Clip damage reports to my bounds, since drawing is clipped to my bounds."
- self isWorldMorph
- ifTrue: [worldState recordDamagedRect: damageRect].
- ^super invalidRect: damageRect from: aMorph!
Item was removed:
- ----- Method: PasteUpMorph>>invokeWorldMenu: (in category 'world menu') -----
- invokeWorldMenu: evt
- "Put up the world menu, triggered by the passed-in event. But don't do it if the eToyFriendly preference is set to true."
-
- Preferences eToyFriendly ifFalse:
- [self putUpWorldMenu: evt]!
Item was removed:
- ----- Method: PasteUpMorph>>isEasySelecting (in category 'testing') -----
- isEasySelecting
- "This is to isolate easySelection predicate.
- Selectors in holders make no sense so we are limiting easy selection to the worldMorph.
- It would also make sense in playfield so feel free to adjust this predicate. Selection can always be forced by using the shift before mouse down."
-
- ^ self isWorldMorph and: [ Preferences easySelection ]!
Item was removed:
- ----- Method: PasteUpMorph>>isPartsBin (in category 'parts bin') -----
- isPartsBin
- ^ isPartsBin == true!
Item was removed:
- ----- Method: PasteUpMorph>>isPartsBin: (in category 'options') -----
- isPartsBin: aBoolean
- isPartsBin := aBoolean!
Item was removed:
- ----- Method: PasteUpMorph>>isPartsBinString (in category 'menu & halo') -----
- isPartsBinString
- "Answer the string to be shown in a menu to represent the
- parts-bin status"
- ^ (self isPartsBin
- ifTrue: ['<on>']
- ifFalse: ['<off>']), 'parts bin' translated!
Item was removed:
- ----- Method: PasteUpMorph>>isPlayfieldLike (in category 'classification') -----
- isPlayfieldLike
- ^ true!
Item was removed:
- ----- Method: PasteUpMorph>>isStepping: (in category 'project state') -----
- isStepping: aMorph
- ^ worldState isStepping: aMorph!
Item was removed:
- ----- Method: PasteUpMorph>>isStepping:selector: (in category 'project state') -----
- isStepping: aMorph selector: aSelector
- ^ worldState isStepping: aMorph selector: aSelector!
Item was removed:
- ----- Method: PasteUpMorph>>isWorldMorph (in category 'classification') -----
- isWorldMorph
-
- ^ worldState notNil!
Item was removed:
- ----- Method: PasteUpMorph>>jumpToProject (in category 'world state') -----
- jumpToProject
-
- Project current jumpToProject.
- !
Item was removed:
- ----- Method: PasteUpMorph>>justDroppedInto:event: (in category 'dropping/grabbing') -----
- justDroppedInto: aMorph event: anEvent
- "This message is sent to a dropped morph after it has been dropped on--and been accepted by--a drop-sensitive morph"
-
- super justDroppedInto: aMorph event: anEvent.
- self isPartsBin ifTrue: [self setPartsBinStatusTo: true] "gets some things right about the subtle case of dropping a parts bin"
- !
Item was removed:
- ----- Method: PasteUpMorph>>keyStroke: (in category 'event handling') -----
- keyStroke: anEvent
- "A keystroke has been made. Service event handlers and, if it's a keystroke presented to the world, dispatch it to #unfocusedKeystroke:"
-
- | selected |
- super keyStroke: anEvent. "Give event handlers a chance"
-
- selected := self selectedObject.
- selected isNil
- ifFalse:[ selected moveOrResizeFromKeystroke: anEvent ].
-
- (anEvent keyCharacter == Character tab) ifTrue:
- [self tabAmongFields
- ifTrue:[^ self tabHitWithEvent: anEvent]].
- self isWorldMorph ifTrue:
- [self keystrokeInWorld: anEvent]!
Item was removed:
- ----- Method: PasteUpMorph>>keyboardNavigationHandler (in category 'world menu') -----
- keyboardNavigationHandler
- "Answer the receiver's existing keyboardNavigationHandler, or nil if none."
-
- | aHandler |
- aHandler := self valueOfProperty: #keyboardNavigationHandler ifAbsent: [^ nil].
- (aHandler hasProperty: #moribund) ifTrue: "got clobbered in another project"
- [self removeProperty: #keyboardNavigationHander.
- ^ nil].
- ^ aHandler!
Item was removed:
- ----- Method: PasteUpMorph>>keyboardNavigationHandler: (in category 'world menu') -----
- keyboardNavigationHandler: aHandler
- "Set the receiver's keyboard navigation handler as indicated. A nil argument means to remove the handler"
-
- aHandler
- ifNil:
- [self removeProperty: #keyboardNavigationHandler]
- ifNotNil:
- [self setProperty: #keyboardNavigationHandler toValue: aHandler]!
Item was removed:
- ----- Method: PasteUpMorph>>keystrokeInWorld: (in category 'world menu') -----
- keystrokeInWorld: evt
- "A keystroke was hit when no keyboard focus was set, so it is sent here to the world instead."
-
- | aChar isCmd ascii |
- aChar := evt keyCharacter.
- (ascii := aChar asciiValue) = Character escape asciiValue ifTrue:
- [evt commandKeyPressed ifFalse: [^ self putUpWorldMenuFromEscapeKey]].
- (evt controlKeyPressed not
- and: [(#(1 4 8 28 29 30 31 32) includes: ascii) "home, end, backspace, arrow keys, space"
- and: [self keyboardNavigationHandler notNil]])
- ifTrue: [self keyboardNavigationHandler navigateFromKeystroke: aChar].
-
- isCmd := evt commandKeyPressed and: [Preferences cmdKeysInText].
- (evt commandKeyPressed and: [Preferences eToyFriendly])
- ifTrue:
- [(aChar == $W) ifTrue: [^ self putUpWorldMenu: evt]].
- (isCmd and: [Preferences honorDesktopCmdKeys]) ifTrue:
- [^ self dispatchCommandKeyInWorld: aChar event: evt].
-
- "It was unhandled. Remember the keystroke."
- self lastKeystroke: evt keyString.
- self triggerEvent: #keyStroke!
Item was removed:
- ----- Method: PasteUpMorph>>lastKeystroke (in category 'accessing') -----
- lastKeystroke
- "Answer the last keystroke fielded by the receiver"
-
- ^ self valueOfProperty: #lastKeystroke ifAbsent: ['']!
Item was removed:
- ----- Method: PasteUpMorph>>lastKeystroke: (in category 'accessing') -----
- lastKeystroke: aString
- "Remember the last keystroke fielded by the receiver"
-
- ^ self setProperty: #lastKeystroke toValue: aString!
Item was removed:
- ----- Method: PasteUpMorph>>laySubpartsOutInOneRow (in category 'layout') -----
- laySubpartsOutInOneRow
- | aPosition |
- aPosition := 0 @ padding.
- submorphs do:
- [:aMorph |
- aMorph position: (aPosition + (padding @ 0)).
- aPosition := aMorph topRight]!
Item was removed:
- ----- Method: PasteUpMorph>>layoutChanged (in category 'layout') -----
- layoutChanged
- "The receiver's layout changed; inform above and below"
- super layoutChanged.
- (self valueOfProperty: #SqueakPage) ifNotNil: [
- self setProperty: #pageDirty toValue: true].
- "I am the morph of a SqueakPage, I have changed and
- need to be written out again"
- !
Item was removed:
- ----- Method: PasteUpMorph>>listOfSteppingMorphs (in category 'project state') -----
- listOfSteppingMorphs
- ^ worldState listOfSteppingMorphs
-
- "self currentWorld listOfSteppingMorphs"!
Item was removed:
- ----- Method: PasteUpMorph>>localFlapTabs (in category 'flaps') -----
- localFlapTabs
- "Answer a list of local flap tabs in the current project"
-
- | globalList aList |
- globalList := Flaps globalFlapTabsIfAny.
- aList := OrderedCollection new.
- submorphs do:
- [:m | | aFlapTab |
- ((m isFlapTab) and: [(globalList includes: m) not])
- ifTrue:
- [aList add: m]
- ifFalse:
- [((m isFlap) and:
- [(aFlapTab := m submorphs detect: [:n | n isFlapTab] ifNone: [nil]) notNil])
- ifTrue:
- [aList add: aFlapTab]]].
- ^ aList!
Item was removed:
- ----- Method: PasteUpMorph>>makeNewDrawing: (in category 'world menu') -----
- makeNewDrawing: evt
- ^self makeNewDrawing: evt at: evt position!
Item was removed:
- ----- Method: PasteUpMorph>>makeNewDrawing:at: (in category 'world menu') -----
- makeNewDrawing: evt at: aPoint
- "make a new drawing, triggered by the given event, with the painting area centered around the given point"
-
- | w newSketch newPlayer sketchEditor aPalette rect aPaintBox aPaintTab aWorld |
- w := self world.
- w assureNotPaintingElse: [^ self].
- rect := self paintingBoundsAround: aPoint.
- aPalette := self standardPalette.
- aPalette ifNotNil: [aPalette showNoPalette; layoutChanged].
- w prepareToPaint.
-
- newSketch := self drawingClass new.
- Smalltalk at: #UnscriptedPlayer ifPresent:[:aClass|
- newSketch player: (newPlayer := aClass newUserInstance).
- newPlayer costume: newSketch.
- ].
- newSketch nominalForm: (Form extent: rect extent depth: w assuredCanvas depth).
- newSketch bounds: rect.
- sketchEditor := SketchEditorMorph new.
- w addMorphFront: sketchEditor.
- sketchEditor initializeFor: newSketch inBounds: rect pasteUpMorph: self.
- sketchEditor
- afterNewPicDo: [:aForm :aRect | | tfx whereToPresent |
- whereToPresent := self presenter.
- newSketch form: aForm.
- tfx := self transformFrom: w.
- newSketch position: (tfx globalPointToLocal: aRect origin).
- newSketch rotationStyle: sketchEditor rotationStyle.
- newSketch forwardDirection: sketchEditor forwardDirection.
-
- newPlayer ifNotNil:[newPlayer setHeading: sketchEditor forwardDirection].
- (aPaintTab := (aWorld := self world) paintingFlapTab)
- ifNotNil:[aPaintTab hideFlap]
- ifNil:[(aPaintBox := aWorld paintBox) ifNotNil:[aPaintBox delete]].
-
- self addMorphFront: (newPlayer ifNil:[newSketch] ifNotNil:[newPlayer costume]).
- w startSteppingSubmorphsOf: newSketch.
- whereToPresent drawingJustCompleted: newSketch]
- ifNoBits:[
- (aPaintTab := (aWorld := self world) paintingFlapTab)
- ifNotNil:[aPaintTab hideFlap]
- ifNil:[(aPaintBox := aWorld paintBox) ifNotNil:[aPaintBox delete]].
- aPalette ifNotNil: [aPalette showNoPalette].]!
Item was removed:
- ----- Method: PasteUpMorph>>makeNewDrawingWithin (in category 'painting') -----
- makeNewDrawingWithin
- "Start a painting session in my interior which will result in a new SketchMorph being created as one of my submorphs"
-
- | evt |
- evt := MouseEvent new setType: nil position: self center buttons: 0 hand: self world activeHand.
- self makeNewDrawing: evt!
Item was removed:
- ----- Method: PasteUpMorph>>maxHeightToAvoidThumbnailing (in category 'misc') -----
- maxHeightToAvoidThumbnailing
- ^ self valueOfProperty: #maxHeightToAvoidThumbnailing ifAbsent: [80]!
Item was removed:
- ----- Method: PasteUpMorph>>maximumThumbnailWidth (in category 'misc') -----
- maximumThumbnailWidth
- ^ self valueOfProperty: #maximumThumbnailWidth ifAbsent: [200 min: (self width - 10)]!
Item was removed:
- ----- Method: PasteUpMorph>>modalLockTo: (in category 'polymorph') -----
- modalLockTo: aSystemWindow
- "Don't lock the world!! Lock the submorphs.
- The modal window gets opened afterwards so is OK."
-
- |lockStates|
- lockStates := IdentityDictionary new.
- self submorphsDo: [:m |
- lockStates at: m put: m isLocked.
- m lock].
- self
- setProperty: #submorphLockStates
- toValue: lockStates!
Item was removed:
- ----- Method: PasteUpMorph>>modalUnlockFrom: (in category 'polymorph') -----
- modalUnlockFrom: aSystemWindow
- "Don't unlock the world!! Unlock the submorphs
- that were not originally locked."
-
- |lockStates|
- lockStates := self
- valueOfProperty: #submorphLockStates
- ifAbsent: [^self].
- self removeProperty: #submorphLockStates.
- lockStates keysAndValuesDo: [:m :locked |
- locked ifFalse: [m unlock]]!
Item was removed:
- ----- Method: PasteUpMorph>>model (in category 'model') -----
- model
- "Return the model object for this world. If the world has no model, then create one."
-
- self createCustomModel.
- ^ model!
Item was removed:
- ----- Method: PasteUpMorph>>modelOrNil (in category 'accessing') -----
- modelOrNil
- "Return the model object for this world, or nil if it doesn't have one."
-
- ^ model
- !
Item was removed:
- ----- Method: PasteUpMorph>>modelWakeUp (in category 'user interface') -----
- modelWakeUp
- "I am the model of a SystemWindow, that has just been activated"
-
- | aWindow |
- owner isNil ifTrue: [^self]. "Not in Morphic world"
- (owner isKindOf: TransformMorph) ifTrue: [^self viewBox: self fullBounds].
- (aWindow := self containingWindow) ifNotNil:
- [self viewBox = aWindow panelRect
- ifFalse: [self viewBox: aWindow panelRect]]!
Item was removed:
- ----- Method: PasteUpMorph>>morphToDropForTransferMorph: (in category 'dropping/grabbing') -----
- morphToDropForTransferMorph: aTransferMorph
- "aTransferMorph has been dragged directly onto the desktop. TransferMorphs, by nature, are about transferring a 'logical object' from another source. Answer the Morph that should actually be dropped on to the desktop."
- ^ self
- perform: self transferMorphConverter
- with: aTransferMorph!
Item was removed:
- ----- Method: PasteUpMorph>>morphToDropFrom: (in category 'dropping/grabbing') -----
- morphToDropFrom: aMorph
- "Given a morph being carried by the hand which the hand is about to drop, answer the actual morph to be deposited. Normally this would be just the morph itself, but several unusual cases arise, which this method is designed to service."
-
- | aNail representee handy posBlock |
- handy := self isWorldMorph
- ifTrue: [self primaryHand]
- ifFalse: [self currentHand].
- posBlock :=
- [:z | | tempPos |
- tempPos := handy position
- - ((handy targetOffset - aMorph formerPosition)
- * (z extent / aMorph extent)) rounded.
- self pointFromWorld: tempPos].
- self alwaysShowThumbnail
- ifTrue:
- [aNail := aMorph
- representativeNoTallerThan: self maxHeightToAvoidThumbnailing
- norWiderThan: self maximumThumbnailWidth
- thumbnailHeight: self heightForThumbnails.
- aNail == aMorph
- ifFalse:
- [aMorph formerPosition: aMorph position.
- aNail position: (posBlock value: aNail)].
- ^aNail].
- ((aMorph isKindOf: MorphThumbnail)
- and: [(representee := aMorph morphRepresented) owner isNil])
- ifTrue:
- [representee position: (posBlock value: representee).
- ^representee].
- self showingListView
- ifTrue:
- [^aMorph
- listViewLineForFieldList: (self valueOfProperty: #fieldListSelectors)].
- (aMorph hasProperty: #newPermanentScript)
- ifTrue: [^aMorph asEmptyPermanentScriptor].
- ((aMorph isPhraseTileMorph) or: [aMorph isSyntaxMorph])
- ifFalse: [^aMorph morphToDropInPasteUp: self].
- aMorph userScriptSelector isEmptyOrNil
- ifTrue:
- ["non-user"
-
- self automaticPhraseExpansion ifFalse: [^aMorph]].
- ^aMorph morphToDropInPasteUp: self!
Item was removed:
- ----- Method: PasteUpMorph>>morphToGrab: (in category 'event handling') -----
- morphToGrab: event
- "Return the morph to grab from a mouse down event. If none, return nil."
- self submorphsDo:[:m|
- ((m rejectsEvent: event) not and:[m fullContainsPoint: event cursorPoint]) ifTrue:[^m].
- ].
- ^nil!
Item was removed:
- ----- Method: PasteUpMorph>>morphsInFrontOf:overlapping:do: (in category 'submorphs - accessing') -----
- morphsInFrontOf: someMorph overlapping: aRectangle do: aBlock
- "Include hands if the receiver is the World"
- self handsDo:[:m|
- m == someMorph ifTrue:["Try getting out quickly"
- owner ifNil:[^self].
- ^owner morphsInFrontOf: self overlapping: aRectangle do: aBlock].
- "The hand only overlaps if it's not the hardware cursor"
- m needsToBeDrawn ifTrue:[
- (m fullBoundsInWorld intersects: aRectangle)
- ifTrue:[aBlock value: m]]].
- ^super morphsInFrontOf: someMorph overlapping: aRectangle do: aBlock!
Item was removed:
- ----- Method: PasteUpMorph>>mouseDown: (in category 'event handling') -----
- mouseDown: evt
- "Handle a mouse down event."
- | grabbedMorph handHadHalos |
-
- (Preferences generalizedYellowButtonMenu
- and: [evt yellowButtonPressed])
- ifTrue: [^ self yellowButtonActivity: evt shiftPressed].
-
- grabbedMorph := self morphToGrab: evt.
- grabbedMorph ifNotNil:[
- grabbedMorph isSticky ifTrue:[^self].
- self isPartsBin ifFalse:[^evt hand grabMorph: grabbedMorph].
- grabbedMorph := grabbedMorph partRepresented duplicate.
- grabbedMorph restoreSuspendedEventHandler.
- (grabbedMorph fullBounds containsPoint: evt position)
- ifFalse:[grabbedMorph position: evt position].
- "Note: grabbedMorph is ownerless after duplicate so use #grabMorph:from: instead"
- ^ evt hand grabMorph: grabbedMorph from: self].
-
- (super handlesMouseDown: evt)
- ifTrue:[^super mouseDown: evt].
-
- handHadHalos := evt hand halo notNil.
-
- evt hand removeHalo. "shake off halos"
- evt hand releaseKeyboardFocus. "shake of keyboard foci"
-
- self submorphs
- select:[:each | each hasProperty: #morphHierarchy]
- thenDo:[:each | each delete].
-
- Preferences noviceMode
- ifTrue:[
- self submorphs
- select:[:each | (each isKindOf: MenuMorph) and:[each stayUp not]]
- thenDo:[:each | each delete].
- ].
-
- (evt shiftPressed not
- and:[ self isWorldMorph not
- and:[ self wantsEasySelection not ]])
- ifTrue:[
- "explicitly ignore the event if we're not the world and we'll not select,
- so that we could be picked up if need be"
- evt wasHandled: false.
- ^ self.
- ].
-
- ( evt shiftPressed or: [ self wantsEasySelection ] ) ifTrue:[
- "We'll select on drag, let's decide what to do on click"
- | clickSelector |
-
- clickSelector := nil.
-
- evt shiftPressed ifTrue:[
- clickSelector := #findWindow:.
- ]
- ifFalse:[
- self isWorldMorph ifTrue:[
- clickSelector := handHadHalos
- ifTrue: [ #delayedInvokeWorldMenu: ]
- ifFalse: [ #invokeWorldMenu: ]
- ]
- ].
-
- evt hand
- waitForClicksOrDrag: self
- event: evt
- selectors: { clickSelector. nil. nil. #dragThroughOnDesktop: }
- threshold: HandMorph dragThreshold.
- ]
- ifFalse:[
- "We wont select, just bring world menu if I'm the world"
- self isWorldMorph ifTrue:[
- handHadHalos
- ifTrue: [ self delayedInvokeWorldMenu: evt ]
- ifFalse: [ self invokeWorldMenu: evt ]
- ]
- ].
- !
Item was removed:
- ----- Method: PasteUpMorph>>mouseOverHalosString (in category 'menu & halo') -----
- mouseOverHalosString
- "Answer the string to be shown in a menu to represent the
- mouse-over-halos status"
- ^ (self wantsMouseOverHalos
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'mouse-over halos' translated!
Item was removed:
- ----- Method: PasteUpMorph>>mouseUp: (in category 'event handling') -----
- mouseUp: evt
- self isWorldMorph ifTrue:[self removeAlarm: #invokeWorldMenu:].
- super mouseUp: evt.!
Item was removed:
- ----- Method: PasteUpMorph>>mouseX (in category 'misc') -----
- mouseX
- "Answer the x-coordinate of the mouse, in my coordinate system"
-
- ^ self isInWorld
- ifTrue:
- [((self pointFromWorld: self cursorPoint) x) - self cartesianOrigin x]
- ifFalse:
- [0]!
Item was removed:
- ----- Method: PasteUpMorph>>mouseY (in category 'misc') -----
- mouseY
- "Answer the y-coordinate of the mouse, in my coordinate system"
-
- ^ self isInWorld
- ifTrue:
- [self cartesianOrigin y - ((self pointFromWorld: self cursorPoint) y)]
- ifFalse:
- [0]!
Item was removed:
- ----- Method: PasteUpMorph>>nameForCopyIfAlreadyNamed: (in category 'misc') -----
- nameForCopyIfAlreadyNamed: aMorph
- "Answer a name to set for a copy of aMorph if aMorph itself is named, else nil"
-
- | aName usedNames |
- ^ (aName := aMorph knownName) ifNotNil:
- [usedNames := self allKnownNames.
- Utilities keyLike: aName satisfying: [:f | (usedNames includes: f) not]]!
Item was removed:
- ----- Method: PasteUpMorph>>newDrawingFromMenu: (in category 'world menu') -----
- newDrawingFromMenu: evt
- self assureNotPaintingElse: [^ self].
- evt hand attachMorph: PaintInvokingMorph new markAsPartsDonor!
Item was removed:
- ----- Method: PasteUpMorph>>newResourceLoaded (in category 'initialization') -----
- newResourceLoaded
- "Some resource has just been loaded. Notify all morphs in case somebody wants to update accordingly."
- self allMorphsDo:[:m| m resourceJustLoaded ].
- self fullRepaintNeeded.!
Item was removed:
- ----- Method: PasteUpMorph>>nextPage (in category 'world state') -----
- nextPage
- "backstop for smart next-page buttons that look up the containment hierarchy until they find somone who is willing to field this command. If we get here, the 'next' button was not embedded in a book, so we can do nothing useful"
-
- Beeper beep!
Item was removed:
- ----- Method: PasteUpMorph>>noDisplayDuring: (in category 'world state') -----
- noDisplayDuring: block
- "Some morphs insist on updating the display like the system progress bar does. However, some code might be in an inconsistent state. For this, you can use this method to be safe."
-
- self
- setProperty: #shouldDisplayWorld
- toValue: false.
-
- block ensure: [self removeProperty: #shouldDisplayWorld].!
Item was removed:
- ----- Method: PasteUpMorph>>numberAtCursor (in category 'cursor') -----
- numberAtCursor
- "Answer the number represented by the object at my current cursor position"
-
- | chosenMorph |
- submorphs isEmpty ifTrue: [^ 0].
- chosenMorph := submorphs at: ((cursor truncated max: 1) min: submorphs size).
- ^ chosenMorph getNumericValue
- !
Item was removed:
- ----- Method: PasteUpMorph>>offsetForAccommodating:onEdge: (in category 'flaps') -----
- offsetForAccommodating: anExtent onEdge: edgeSymbol
- "Answer a delta to be applied to my submorphs in order tfor anExtent to be slid inboard on the indicated edge"
- edgeSymbol == #left ifTrue: [^ anExtent x @ 0].
- edgeSymbol == #right ifTrue: [^ anExtent x negated @ 0].
- edgeSymbol == #top ifTrue: [^ 0 @ anExtent y].
- edgeSymbol == #bottom ifTrue: [^ 0 @ anExtent y negated].!
Item was removed:
- ----- Method: PasteUpMorph>>onceAgainDismiss: (in category 'undo') -----
- onceAgainDismiss: aMorph
- "Occasioned by a redo of a dismiss-via-halo"
-
- aMorph dismissMorph.
- TrashCanMorph preserveTrash ifTrue:
- [TrashCanMorph slideDismissalsToTrash
- ifTrue:[aMorph slideToTrash: nil]
- ifFalse:[TrashCanMorph moveToTrash: aMorph]]!
Item was removed:
- ----- Method: PasteUpMorph>>openScrapsBook: (in category 'world menu') -----
- openScrapsBook: evt
- "Open up the Scraps book in the center of the screen"
-
- evt hand world addMorphCentered: ScrapBook default scrapBook!
Item was removed:
- ----- Method: PasteUpMorph>>optimumExtentFromAuthor (in category 'world state') -----
- optimumExtentFromAuthor
-
-
- ^self
- valueOfProperty: #optimumExtentFromAuthor
- ifAbsent: [ | opt |
- opt := bounds extent.
- self setProperty: #optimumExtentFromAuthor toValue: opt.
- ^opt
- ]
-
- !
Item was removed:
- ----- Method: PasteUpMorph>>originAtCenter (in category 'dropping/grabbing') -----
- originAtCenter
- ^ self hasProperty: #originAtCenter!
Item was removed:
- ----- Method: PasteUpMorph>>originAtCenterString (in category 'menu & halo') -----
- originAtCenterString
- "Answer the string to be shown in a menu to represent the
- origin-at-center status"
- ^ ((self hasProperty: #originAtCenter)
- ifTrue: ['<on>']
- ifFalse: ['<off>']), 'origin-at-center' translated!
Item was removed:
- ----- Method: PasteUpMorph>>padding: (in category 'misc') -----
- padding: aNumber
- padding := aNumber!
Item was removed:
- ----- Method: PasteUpMorph>>paintArea (in category 'world state') -----
- paintArea
- "What rectangle should the user be allowed to create a new painting in??
- An area beside the paintBox. Allow playArea to override with its own
- bounds!! "
- | playfield paintBoxBounds |
- playfield := self
- submorphNamed: 'playfield'
- ifNone: [].
- playfield
- ifNotNil: [^ playfield bounds].
- paintBoxBounds := self paintBox bounds.
- self firstHand targetPoint x < paintBoxBounds center x
- ifTrue: [^ bounds topLeft corner: paintBoxBounds left @ bounds bottom"paint on left side"]
- ifFalse: [^ paintBoxBounds right @ bounds top corner: bounds bottomRight]!
Item was removed:
- ----- Method: PasteUpMorph>>paintAreaFor: (in category 'world state') -----
- paintAreaFor: aSketchMorph
- "Answer the area to comprise the onion-skinned canvas for painting/repainting aSketchMorph"
-
- | itsOwner |
- ((itsOwner := aSketchMorph owner) notNil and: [itsOwner isPlayfieldLike])
- ifTrue: [^itsOwner bounds]. "handles every plausible situation"
- ^self paintArea!
Item was removed:
- ----- Method: PasteUpMorph>>paintBox (in category 'world state') -----
- paintBox
- "Return the painting controls widget (PaintBoxMorph) to be used for painting in this world. If there is not already a PaintBox morph, or if it has been deleted from this world, create a new one."
-
- | newPaintBox refPoint aPalette |
- self allMorphsDo: [:m | (m isKindOf: PaintBoxMorph) ifTrue: [^ m]].
- refPoint := (aPalette := self standardPalette)
- ifNotNil:
- [aPalette showNoPalette.
- aPalette topRight + (0 @ 12)]
- ifNil:
- [self topRight].
- newPaintBox := PaintBoxMorph new.
- newPaintBox position: (refPoint - (newPaintBox width @ 0)).
- self addMorph: newPaintBox.
- ^ newPaintBox
- !
Item was removed:
- ----- Method: PasteUpMorph>>paintBoxOrNil (in category 'world state') -----
- paintBoxOrNil
- "Return the painting controls widget (PaintBoxMorph) to be used for painting in this world. If there is not already a PaintBox morph return nil"
-
- self allMorphsDo: [:m | (m isKindOf: PaintBoxMorph) ifTrue: [^ m]].
- ^ nil
- !
Item was removed:
- ----- Method: PasteUpMorph>>paintingBoundsAround: (in category 'painting') -----
- paintingBoundsAround: aPoint
- "Return a rectangle for painting centered on the given point. Both the argument point and the result rectangle are in world coordinates."
-
- | paintExtent maxPaintArea myBnds |
- paintExtent := self reasonablePaintingExtent.
- maxPaintArea := paintExtent x * paintExtent y.
- myBnds := self boundsInWorld.
- (myBnds area <= maxPaintArea) ifTrue: [^ myBnds].
- ^ (aPoint - (paintExtent // 2) extent: paintExtent) intersect: myBnds
- !
Item was removed:
- ----- Method: PasteUpMorph>>paintingFlapTab (in category 'flaps') -----
- paintingFlapTab
- "If the receiver has a flap which has a paintbox, return it, else return nil"
- self flapTabs do:
- [:aTab | aTab referent submorphsDo:
- [:aMorph | (aMorph isKindOf: PaintBoxMorph) ifTrue: [^ aTab]]].
- ^ nil!
Item was removed:
- ----- Method: PasteUpMorph>>patchAt:without:andNothingAbove: (in category 'world state') -----
- patchAt: patchRect without: stopMorph andNothingAbove: stopThere
- "Return a complete rendering of this patch of the display screen
- without stopMorph, and possibly without anything above it."
-
- | c |
- c := ColorPatchCanvas
- extent: patchRect extent
- depth: Display depth
- origin: patchRect topLeft negated
- clipRect: (0 at 0 extent: patchRect extent).
- c stopMorph: stopMorph.
- c doStop: stopThere.
-
- (self bounds containsRect: patchRect) ifFalse:
- ["Need to fill area outside bounds with black."
- c form fillColor: Color black].
- (self bounds intersects: patchRect) ifFalse:
- ["Nothing within bounds to show."
- ^ c form].
- self fullDrawOn: c.
- stopThere ifFalse: [ self world handsReverseDo: [:h | h drawSubmorphsOn: c]].
- ^c form
- !
Item was removed:
- ----- Method: PasteUpMorph>>pauseEventRecorder (in category 'world state') -----
- pauseEventRecorder
- "Suspend any event recorder, and return it if found"
-
-
- worldState handsDo: [:h | | er | (er := h pauseEventRecorderIn: self) ifNotNil: [^ er]].
- ^ nil!
Item was removed:
- ----- Method: PasteUpMorph>>position: (in category 'geometry') -----
- position: aPoint
- "Prevent moving a world (e.g. via HandMorph>>specialGesture:)"
-
- "for now, let's allow it and see what happens"
-
- self isWorldMorph ifFalse: [^super position: aPoint].
- super position: aPoint.
- self viewBox ifNotNil: [self viewBox: (aPoint extent: self viewBox extent)].
-
- !
Item was removed:
- ----- Method: PasteUpMorph>>positionNear:forExtent:adjustmentSuggestion: (in category 'dropping/grabbing') -----
- positionNear: aPoint forExtent: anExtent adjustmentSuggestion: adjustmentPoint
- "Compute a plausible positioning for adding a subpart of size anExtent, somewhere near aPoint, using adjustmentPoint as the unit of adjustment"
-
- | adjustedPosition |
- adjustedPosition := aPoint.
- [((self morphsAt: (adjustedPosition + (anExtent // 2))) size > 1) and: "that 1 is self here"
- [bounds containsPoint: adjustedPosition]]
- whileTrue:
- [adjustedPosition := adjustedPosition + adjustmentPoint].
-
- ^ adjustedPosition!
Item was removed:
- ----- Method: PasteUpMorph>>prepareToBeSaved (in category 'misc') -----
- prepareToBeSaved
- "Prepare for export via the ReferenceStream mechanism"
-
- | exportDict soundKeyList players |
- super prepareToBeSaved.
- turtlePen := nil.
- self isWorldMorph
- ifTrue:
- [self removeProperty: #scriptsToResume.
- soundKeyList := Set new.
- (players := self presenter allExtantPlayers)
- do: [:aPlayer | aPlayer slotInfo
- associationsDo: [:assoc | assoc value type == #Sound
- ifTrue: [soundKeyList
- add: (aPlayer instVarNamed: assoc key)]]].
- players
- do: [:p | p allScriptEditors
- do: [:e | (e allMorphs
- select: [:m | m isSoundTile])
- do: [:aTile | soundKeyList add: aTile literal]]].
- (self allMorphs
- select: [:m | m isSoundTile])
- do: [:aTile | soundKeyList add: aTile literal].
- soundKeyList removeAllFoundIn: SampledSound universalSoundKeys.
- soundKeyList
- removeAllSuchThat: [:aKey | (SampledSound soundLibrary includesKey: aKey) not].
- soundKeyList isEmpty
- ifFalse: [exportDict := Dictionary new.
- soundKeyList
- do: [:aKey | exportDict
- add: (SampledSound soundLibrary associationAt: aKey)].
- self setProperty: #soundAdditions toValue: exportDict]]!
Item was removed:
- ----- Method: PasteUpMorph>>prepareToPaint (in category 'painting') -----
- prepareToPaint
- "We're about to start painting. Do a few preparations that make the system more responsive."
-
- ^ self prepareToPaint: Preferences keepTickingWhilePainting not!
Item was removed:
- ----- Method: PasteUpMorph>>prepareToPaint: (in category 'painting') -----
- prepareToPaint: stopRunningScripts
- "We're about to start painting. Do a few preparations that make the system more responsive."
-
- self hideViewerFlaps. "make room"
- stopRunningScripts ifTrue:
- [self setProperty: #scriptsToResume toValue: self presenter allCurrentlyTickingScriptInstantiations. "We'll restart these when painting is done"
- self stopRunningAll]. "stop scripts"
- self abandonAllHalos. "no more halos"!
Item was removed:
- ----- Method: PasteUpMorph>>presentCardAndStackMenu (in category 'menu & halo') -----
- presentCardAndStackMenu
- "Put up a menu holding card/stack-related options."
-
- | aMenu |
- aMenu := MenuMorph new defaultTarget: self.
- aMenu addStayUpItem.
- aMenu addTitle: 'card and stack' translated.
- aMenu add: 'add new card' translated action: #insertCard.
- aMenu add: 'delete this card' translated action: #deleteCard.
- aMenu add: 'go to next card' translated action: #goToNextCardInStack.
- aMenu add: 'go to previous card' translated action: #goToPreviousCardInStack.
- aMenu addLine.
- aMenu add: 'show foreground objects' translated action: #showForegroundObjects.
- aMenu add: 'show background objects' translated action: #showBackgroundObjects.
- aMenu add: 'show designations' translated action: #showDesignationsOfObjects.
- aMenu add: 'explain designations' translated action: #explainDesignations.
- aMenu popUpInWorld: (self world ifNil: [self currentWorld])!
Item was removed:
- ----- Method: PasteUpMorph>>presentPlayfieldMenu (in category 'menu & halo') -----
- presentPlayfieldMenu
-
- self playfieldOptionsMenu popUpForHand: self activeHand in: self world!
Item was removed:
- ----- Method: PasteUpMorph>>presenter (in category 'accessing') -----
- presenter
- "Normally only the world will have a presenter, but the architecture supports individual localized presenters as well"
-
- ^ presenter ifNil:
- [self isWorldMorph
- ifTrue: [presenter := Presenter defaultPresenterClass new associatedMorph: self]
- ifFalse: [super presenter]]!
Item was removed:
- ----- Method: PasteUpMorph>>previousPage (in category 'world state') -----
- previousPage
- "backstop for smartprev-page buttons that look up the containment hierarchy until they find somone who is willing to field this command. If we get here, the button was not embedded in a book, so we can do nothing useful"
-
- Beeper beep!
Item was removed:
- ----- Method: PasteUpMorph>>primaryHand (in category 'structure') -----
- primaryHand
-
- ^ self hands at: 1 ifAbsent: [nil]!
Item was removed:
- ----- Method: PasteUpMorph>>printOn: (in category 'printing') -----
- printOn: aStream
- "Reimplemented to add a tag showing that the receiver is currently functioning as a 'world', if it is"
-
- super printOn: aStream.
- self isWorldMorph ifTrue: [aStream nextPutAll: ' [world]']!
Item was removed:
- ----- Method: PasteUpMorph>>printScriptSummary (in category 'world menu') -----
- printScriptSummary
- "Put up a window with summaries of all scripts in the world"
-
- self presenter reportPlayersAndScripts
-
- "self currentWorld printScriptSummary"!
Item was removed:
- ----- Method: PasteUpMorph>>privateFullMoveBy: (in category 'private') -----
- privateFullMoveBy: delta
- "Private. Overridden to prevent drawing turtle trails when a playfield is moved"
- self setProperty: #turtleTrailsDelta toValue: delta.
- super privateFullMoveBy: delta.
- self removeProperty: #turtleTrailsDelta.
- !
Item was removed:
- ----- Method: PasteUpMorph>>privateMoveBy: (in category 'private') -----
- privateMoveBy: delta
-
- super privateMoveBy: delta.
- worldState ifNotNil: [
- worldState viewBox ifNotNil: [
- worldState viewBox: bounds
- ].
- ].!
Item was removed:
- ----- Method: PasteUpMorph>>privateOuterDisplayWorld (in category 'world state') -----
- privateOuterDisplayWorld
-
- (self valueOfProperty: #shouldDisplayWorld ifAbsent: [true])
- ifTrue: [worldState displayWorld: self submorphs: submorphs].!
Item was removed:
- ----- Method: PasteUpMorph>>processEvent:using: (in category 'events-processing') -----
- processEvent: anEvent using: defaultDispatcher
- "Reimplemented to install the receiver as the new active world if it is one"
-
- self isWorldMorph ifFalse: [
- ^ super processEvent: anEvent using: defaultDispatcher].
-
- ^ self becomeActiveDuring: [
- super processEvent: anEvent using: defaultDispatcher]!
Item was removed:
- ----- Method: PasteUpMorph>>project (in category 'project') -----
- project
- "Find the project that owns me. Not efficient to call this."
-
- ^ Project ofWorld: self!
Item was removed:
- ----- Method: PasteUpMorph>>putUpNewMorphMenu (in category 'world menu') -----
- putUpNewMorphMenu
- "Put up the New Morph menu in the world"
-
- TheWorldMenu new adaptToWorld: self; newMorph!
Item was removed:
- ----- Method: PasteUpMorph>>putUpPenTrailsSubmenu (in category 'menu & halo') -----
- putUpPenTrailsSubmenu
- "Put up the pen trails menu"
-
- | aMenu |
- aMenu := MenuMorph new defaultTarget: self.
- aMenu title: 'pen trails' translated.
- aMenu addStayUpItem.
- self addPenTrailsMenuItemsTo: aMenu.
- ^ aMenu popUpInWorld: self!
Item was removed:
- ----- Method: PasteUpMorph>>putUpWorldMenu: (in category 'world menu') -----
- putUpWorldMenu: evt
- "Put up a menu in response to a click on the desktop, triggered by evt."
-
- | menu |
- self bringTopmostsToFront.
- evt isMouse ifTrue:
- [evt yellowButtonPressed
- ifTrue: [^ self yellowButtonClickOnDesktopWithEvent: evt].
- evt shiftPressed ifTrue:[^ self findWindow: evt]].
- "put up screen menu"
- menu := self buildWorldMenu: evt.
- menu addTitle: Preferences desktopMenuTitle translated.
- menu popUpEvent: evt in: self.
- ^ menu!
Item was removed:
- ----- Method: PasteUpMorph>>putUpWorldMenuFromEscapeKey (in category 'world menu') -----
- putUpWorldMenuFromEscapeKey
- Preferences noviceMode
- ifFalse: [self putUpWorldMenu: self currentEvent]!
Item was removed:
- ----- Method: PasteUpMorph>>reasonablePaintingExtent (in category 'painting') -----
- reasonablePaintingExtent
- ^ Preferences unlimitedPaintArea
- ifTrue:
- [3000 @ 3000]
- ifFalse:
- [Preferences defaultPaintingExtent]!
Item was removed:
- ----- Method: PasteUpMorph>>rectifyCursor (in category 'cursor') -----
- rectifyCursor
- cursor := ((cursor truncated max: 1) min: submorphs size)
- !
Item was removed:
- ----- Method: PasteUpMorph>>referencePlayfield (in category 'e-toy support') -----
- referencePlayfield
- "Answer a pasteup morph to be used as the reference for cartesian coordinates.
- Do not get fooled by other morphs (like viewers) that happen to be named 'playfield'."
-
- ^self isWorldMorph
- ifTrue: [ self submorphThat: [ :s | (s knownName = 'playfield') and: [ s isPlayfieldLike] ] ifNone: [self]]
- ifFalse: [ super referencePlayfield ]!
Item was removed:
- ----- Method: PasteUpMorph>>referencePool (in category 'objects from disk') -----
- referencePool
- ^ self
- valueOfProperty: #References
- ifAbsentPut: [WeakValueDictionary new]
- !
Item was removed:
- ----- Method: PasteUpMorph>>reformulateUpdatingMenus (in category 'menu & halo') -----
- reformulateUpdatingMenus
- "Give any updating menu morphs in the receiver a fresh kiss of life"
-
- (self submorphs select: [:m | m isKindOf: UpdatingMenuMorph]) do:
- [:m | m updateMenu]
-
- "NB: to do the perfect job here one might well want to extend across allMorphs here, but the expense upon project entry is seemingly too high a price to pay at this point"!
Item was removed:
- ----- Method: PasteUpMorph>>reintroduceIntoWorld: (in category 'undo') -----
- reintroduceIntoWorld: aMorph
- "The given morph is being raised from the dead. Bring it back to life."
-
- (aMorph valueOfProperty: #lastPosition) ifNotNil:
- [:pos | aMorph position: pos].
- aMorph openInWorld; goHome
-
- !
Item was removed:
- ----- Method: PasteUpMorph>>releaseCachedState (in category 'caching') -----
- releaseCachedState
- super releaseCachedState.
- presenter ifNotNil:[presenter flushPlayerListCache].
- self isWorldMorph ifTrue:[self cleanseStepList].!
Item was removed:
- ----- Method: PasteUpMorph>>releaseRemoteServer (in category 'Nebraska') -----
- releaseRemoteServer
- "My server has been transferred to some other world. Release pending references"
- ^worldState releaseRemoteServer.!
Item was removed:
- ----- Method: PasteUpMorph>>releaseSqueakPages (in category 'project') -----
- releaseSqueakPages
-
- "If this world has a book with SqueakPages, then clear the SqueakPageCache"
-
- submorphs do: [:sub | | uu |
- (sub isKindOf: BookMorph) ifTrue: [
- uu := sub valueOfProperty: #url ifAbsent: [nil].
- uu ifNotNil: [(SqueakPageCache pageCache includesKey: uu) ifTrue: [
- SqueakPageCache initialize]]]]. "wipe the cache"!
Item was removed:
- ----- Method: PasteUpMorph>>releaseViewers (in category 'flaps') -----
- releaseViewers
- "In preparation for saving, make the flapTabs release their viewers."
-
- self flapTabs do: [:ft |
- (ft respondsTo: #hibernate) ifTrue: [ft hibernate]]!
Item was removed:
- ----- Method: PasteUpMorph>>remoteServer (in category 'Nebraska') -----
- remoteServer
- ^worldState remoteServer.!
Item was removed:
- ----- Method: PasteUpMorph>>remoteServer: (in category 'Nebraska') -----
- remoteServer: aNebraskaServer
-
- | h |
-
- worldState remoteServer: aNebraskaServer.
- h := self primaryHand.
- aNebraskaServer ifNil:[
- (h hasProperty: #representingTheServer) ifTrue: [
- h removeProperty: #representingTheServer.
- h userInitials: '' andPicture: nil.
- ]
- ] ifNotNil:[
- (h hasProperty: #representingTheServer) ifFalse: [
- h setProperty: #representingTheServer toValue: true.
- h userInitials: Utilities authorName andPicture: nil.
- ]
- ].!
Item was removed:
- ----- Method: PasteUpMorph>>removeAccommodationForFlap: (in category 'flaps') -----
- removeAccommodationForFlap: aFlapTab
- "Shift submorphs over, if appropriate"
- | offset |
- aFlapTab slidesOtherObjects ifTrue:
- [offset := self offsetForAccommodating: aFlapTab referent extent onEdge: aFlapTab edgeToAdhereTo.
- self shiftSubmorphsBy: offset negated]!
Item was removed:
- ----- Method: PasteUpMorph>>removeAlarm:for: (in category 'alarms-scheduler') -----
- removeAlarm: aSelector for: aTarget
- "Remove the alarm with the given selector"
- worldState removeAlarm: aSelector for: aTarget!
Item was removed:
- ----- Method: PasteUpMorph>>removeAllViewers (in category 'world menu') -----
- removeAllViewers
- "Delete all the viewers lined up along my right margin."
-
- (self submorphs select: [:m | m isKindOf: ViewerFlapTab]) do:
- [:m |
- m referent ifNotNil: [m referent delete].
- m delete.]!
Item was removed:
- ----- Method: PasteUpMorph>>removeHand: (in category 'world state') -----
- removeHand: aHandMorph
- "Remove the given hand from the list of hands for this world."
-
- (worldState hands includes: aHandMorph) ifFalse: [^self].
- aHandMorph dropMorphs.
- self invalidRect: aHandMorph fullBounds.
- worldState removeHand: aHandMorph.
- !
Item was removed:
- ----- Method: PasteUpMorph>>removeKeyboardShortcuts (in category 'initialization') -----
- removeKeyboardShortcuts
-
- self removeKeyboardCaptureFilter: self.!
Item was removed:
- ----- Method: PasteUpMorph>>removeRemoteClient: (in category 'Nebraska') -----
- removeRemoteClient: aClient
- self removeHand: aClient hand.
- worldState removeRemoteCanvas: aClient canvas.
- self changed. "force a redraw"
- !
Item was removed:
- ----- Method: PasteUpMorph>>repairEmbeddedWorlds (in category 'world state') -----
- repairEmbeddedWorlds
-
- | toDoList |
-
- toDoList := OrderedCollection new.
- self allMorphsDo: [ :each | | transform eWorld |
- (each isKindOf: EmbeddedWorldBorderMorph) ifTrue: [
- transform := each submorphs at: 1 ifAbsent: [nil].
- transform ifNotNil: [
- eWorld := transform submorphs at: 1 ifAbsent: [nil].
- eWorld ifNotNil: [
- toDoList add: {transform. eWorld}.
- ].
- ].
- "Smalltalk at: #Q put: {self. each. transform. eWorld}."
- ].
- ].
- toDoList do: [ :each |
- each first addMorph: each second.
- ].!
Item was removed:
- ----- Method: PasteUpMorph>>repelsMorph:event: (in category 'dropping/grabbing') -----
- repelsMorph: aMorph event: ev
- (aMorph wantsToBeDroppedInto: self) ifFalse: [^ false].
- self dropEnabled ifFalse: [^ true].
- (self wantsDroppedMorph: aMorph event: ev) ifFalse: [^ true].
- ^ super repelsMorph: aMorph event: ev "consults #repelling flag"!
Item was removed:
- ----- Method: PasteUpMorph>>replaceTallSubmorphsByThumbnails (in category 'options') -----
- replaceTallSubmorphsByThumbnails
- "Any submorphs that seem to tall get replaced by thumbnails; their balloon text is copied over to the thumbnail"
-
- | heightForThumbnails maxHeightToAvoidThumbnailing maxWidthForThumbnails |
- heightForThumbnails := self heightForThumbnails.
- maxHeightToAvoidThumbnailing := self maxHeightToAvoidThumbnailing.
- maxWidthForThumbnails := self maximumThumbnailWidth.
- self submorphs do:
- [:aMorph | | existingHelp itsThumbnail |
- itsThumbnail := aMorph representativeNoTallerThan: maxHeightToAvoidThumbnailing norWiderThan: maxWidthForThumbnails thumbnailHeight: heightForThumbnails.
- (aMorph == itsThumbnail)
- ifFalse:
- [existingHelp := aMorph balloonText.
- self replaceSubmorph: aMorph by: itsThumbnail.
- existingHelp ifNotNil:
- [itsThumbnail setBalloonText: existingHelp]]]!
Item was removed:
- ----- Method: PasteUpMorph>>reportLocalAddress (in category 'world menu') -----
- reportLocalAddress
- "Report the local host address of this computer."
-
- | addrString m s |
- Socket initializeNetwork.
- addrString := NetNameResolver localAddressString.
- m := RectangleMorph new
- color: (Color r: 0.6 g: 0.8 b: 0.6);
- extent: 118 at 36;
- borderWidth: 1.
- s := StringMorph contents: 'Local Host Address:'.
- s position: m position + (5 at 4).
- m addMorph: s.
- s := StringMorph contents: addrString.
- s position: m position + (5 at 19).
- m addMorph: s.
- self primaryHand attachMorph: m.
- !
Item was removed:
- ----- Method: PasteUpMorph>>repositionFlapsAfterScreenSizeChange (in category 'world state') -----
- repositionFlapsAfterScreenSizeChange
- "Reposition flaps after screen size change"
-
- (Flaps globalFlapTabsIfAny, self localFlapTabs) do:
- [:aFlapTab |
- aFlapTab applyEdgeFractionWithin: self bounds].
- Flaps doAutomaticLayoutOfFlapsIfAppropriate!
Item was removed:
- ----- Method: PasteUpMorph>>resetTransferMorphConverter (in category 'dropping/grabbing') -----
- resetTransferMorphConverter
- ^ self transferMorphConverter: #yourself!
Item was removed:
- ----- Method: PasteUpMorph>>residesInPartsBin (in category 'parts bin') -----
- residesInPartsBin
- "Answer true if the receiver is, or has some ancestor owner who is, a parts bin"
-
- self isWorldMorph
- ifTrue: [^ self isPartsBin]
- ifFalse: [^ self isPartsBin or: [super residesInPartsBin]]!
Item was removed:
- ----- Method: PasteUpMorph>>resizeToFit (in category 'options') -----
- resizeToFit
- ^self vResizing == #shrinkWrap!
Item was removed:
- ----- Method: PasteUpMorph>>resizeToFitString (in category 'options') -----
- resizeToFitString
- "Answer a string, to be used in a self-updating menu, to
- represent whether the receiver is currently using resize-to-fit
- or not"
- ^ (self resizeToFit
- ifTrue: ['<yes>']
- ifFalse: ['<no>'])
- , 'resize to fit' translated!
Item was removed:
- ----- Method: PasteUpMorph>>respondToCommand:bySending:to: (in category 'world menu') -----
- respondToCommand: aCharacter bySending: aSelector to: aReceiver
- "Respond to the command-key use of the given character by sending the given selector to the given receiver. If the selector is nil, retract any prior such setting"
-
- aSelector
- ifNil:
- [self commandKeySelectors removeKey: aCharacter]
- ifNotNil:
- [self commandKeySelectors at: aCharacter put: (MessageSend receiver: aReceiver selector: aSelector)]!
Item was removed:
- ----- Method: PasteUpMorph>>restartWorldCycleWithEvent: (in category 'WiW support') -----
- restartWorldCycleWithEvent: evt
-
- "RAA 27 Nov 99 - redispatch that click picked up from our inner world"
- evt ifNotNil: [
- self primaryHand handleEvent: (evt setHand: self primaryHand).
- ].
- Project current spawnNewProcessAndTerminateOld: true
- !
Item was removed:
- ----- Method: PasteUpMorph>>restoreBoundsOfSubmorphs (in category 'viewing') -----
- restoreBoundsOfSubmorphs
- "restores the saved xy-positions and extents"
-
- submorphs do:
- [:aSubmorph |
- aSubmorph valueOfProperty: #savedExtent ifPresentDo:
- [:anExtent | aSubmorph extent: anExtent].
- aSubmorph valueOfProperty: #savedPosition ifPresentDo:
- [:aPosition | aSubmorph position: aPosition]]!
Item was removed:
- ----- Method: PasteUpMorph>>restoreFlapsDisplay (in category 'world state') -----
- restoreFlapsDisplay
- "Restore the display of flaps"
-
- (Flaps sharedFlapsAllowed and: [Project current flapsSuppressed not]) ifTrue:
- [Flaps globalFlapTabs do:
- [:aFlapTab | aFlapTab adaptToWorld]].
- self localFlapTabs do:
- [:aFlapTab | aFlapTab adaptToWorld].
- self assureFlapTabsFitOnScreen.
- self bringTopmostsToFront.!
Item was removed:
- ----- Method: PasteUpMorph>>restoreMainDockingBarDisplay (in category 'world state') -----
- restoreMainDockingBarDisplay
- "Restore the display of docking bars"
- self dockingBars
- do: [:each | each updateBounds]!
Item was removed:
- ----- Method: PasteUpMorph>>restoreMorphicDisplay (in category 'world state') -----
- restoreMorphicDisplay
-
- self removeProperty: #shouldDisplayWorld.
-
- ThumbnailMorph recursionReset.
-
- self
- extent: Display extent;
- viewBox: Display boundingBox;
- handsDo: [:h | h visible: true; showTemporaryCursor: nil];
- " restoreFlapsDisplay;
- restoreMainDockingBarDisplay;
- " fullRepaintNeeded.
- !
Item was removed:
- ----- Method: PasteUpMorph>>resumeScriptsPausedByPainting (in category 'painting') -----
- resumeScriptsPausedByPainting
- "If there were any scripts running when painting was initiated, resume them now"
-
- | aList |
- (aList := self valueOfProperty: #scriptsToResume) isEmptyOrNil ifFalse:
- [aList do:
- [:aScriptInstantiation |
- aScriptInstantiation player costume isInWorld ifTrue:
- [aScriptInstantiation startRunningIfPaused]]].
- self removeProperty: #scriptsToResume!
Item was removed:
- ----- Method: PasteUpMorph>>runLocalStepMethods (in category 'stepping') -----
- runLocalStepMethods
-
- worldState runLocalStepMethodsIn: self
- !
Item was removed:
- ----- Method: PasteUpMorph>>runStepMethods (in category 'stepping') -----
- runStepMethods
-
- worldState runStepMethodsIn: self
- !
Item was removed:
- ----- Method: PasteUpMorph>>saveAsWorld (in category 'world state') -----
- saveAsWorld
- | worldName s |
- worldName := UIManager default
- request: 'Please give this world a name'
- initialAnswer: 'test'.
- ((self class class includesSelector: worldName asSymbol) and:
- [(UIManager default confirm: 'OK to overwrite ' , worldName , '?') not])
- ifTrue: [^ self].
-
- s := WriteStream on: (String new: 1000).
- s nextPutAll: worldName; cr; tab;
- nextPutAll: '"' , self class name , ' ' , worldName, ' open"'; cr; cr; tab;
- nextPutAll: '^ '.
- self printConstructorOn: s indent: 0.
- s cr.
-
- self class class
- compile: s contents
- classified: 'examples'
- notifying: nil.!
Item was removed:
- ----- Method: PasteUpMorph>>saveBoundsOfSubmorphs (in category 'viewing') -----
- saveBoundsOfSubmorphs
- "store the current xy-positions and extents of submorphs for future use"
-
- submorphs do:
- [:aSubmorph |
- aSubmorph setProperty: #savedExtent toValue: aSubmorph extent.
- aSubmorph setProperty: #savedPosition toValue: aSubmorph position]!
Item was removed:
- ----- Method: PasteUpMorph>>saveOnFile (in category 'objects from disk') -----
- saveOnFile
- "Ask the user for a filename and save myself on a SmartReferenceStream file. Writes out the version and class structure. The file is fileIn-able. UniClasses will be filed out."
-
- | aFileName fileStream |
-
- self flag: #bob0302.
- self isWorldMorph ifTrue: [^self project saveAs].
-
- aFileName := ('my {1}' translated format: {self class name}) , '.project' asFileName. "do better?"
- aFileName := UIManager default saveFilenameRequest: 'File name?' translated
- initialAnswer: aFileName.
- aFileName ifNil: [^ Beeper beep].
- self allMorphsDo: [:m | m prepareToBeSaved].
-
- fileStream := FileStream newFileNamed: aFileName.
- fileStream fileOutClass: nil andObject: self. "Puts UniClass definitions out anyway"!
Item was removed:
- ----- Method: PasteUpMorph>>selectedRect (in category 'cursor') -----
- selectedRect
- "Return a rectangle enclosing the morph at the current cursor. Note that the cursor may be a float and may be out of range, so pick the nearest morph. Assume there is at least one submorph."
-
- | p |
- p := cursor asInteger.
- p := p min: submorphs size.
- p := p max: 1.
- ^(submorphs at: p) fullBounds expandBy: 2!
Item was removed:
- ----- Method: PasteUpMorph>>sendTextContentsBackToDonor (in category 'menu & halo') -----
- sendTextContentsBackToDonor
- "Send my string contents back to the Text Morph from whence I came"
-
- (self valueOfProperty: #donorTextMorph) ifNotNil:
- [:aDonor | aDonor setCharacters: self assuredPlayer getStringContents]!
Item was removed:
- ----- Method: PasteUpMorph>>setAsBackground: (in category 'visual properties') -----
- setAsBackground: aFormOrColorOrFillStyle
-
- | project |
- (self outermostWorldMorph == self and: [(project := self project) isMorphic])
- ifTrue: [project setAsBackground: aFormOrColorOrFillStyle]
- ifFalse: [self fillStyle: aFormOrColorOrFillStyle].!
Item was removed:
- ----- Method: PasteUpMorph>>setGradientColor: (in category 'display') -----
- setGradientColor: evt
- "For backwards compatibility with GradientFillMorph"
-
- self flag: #fixThis.
- self changeColorTarget: self selector: #gradientFillColor:
- originalColor: (self fillStyle isGradientFill
- ifTrue: [self fillStyle colorRamp last value]
- ifFalse: [color])
- hand: evt hand.!
Item was removed:
- ----- Method: PasteUpMorph>>setModel: (in category 'model') -----
- setModel: aModelMorph
- "Set the model for this world. Methods for sensitized morphs will be compiled into the class for this model."
-
- model := aModelMorph
- !
Item was removed:
- ----- Method: PasteUpMorph>>setPartsBinStatusTo: (in category 'options') -----
- setPartsBinStatusTo: aBoolean
- isPartsBin := aBoolean.
- aBoolean ifFalse: [self enableDragNDrop].
- "but note that we no longer reset openToDragNDrop to false upon making it a parts bin again"
- isPartsBin
- ifTrue:
- [submorphs do:
- [:m | m isPartsDonor: true.
- m stopStepping.
- m suspendEventHandler]]
- ifFalse:
- [submorphs do:
- [:m | m isPartsDonor: false.
- m restoreSuspendedEventHandler].
- self world ifNotNil: [self world startSteppingSubmorphsOf: self]]!
Item was removed:
- ----- Method: PasteUpMorph>>shouldGetStepsFrom: (in category 'WiW support') -----
- shouldGetStepsFrom: aWorld
-
- (self isWorldMorph and: [owner notNil]) ifTrue: [
- ^self outermostWorldMorph == aWorld
- ].
- ^super shouldGetStepsFrom: aWorld!
Item was removed:
- ----- Method: PasteUpMorph>>showApplicationView (in category 'menu & halo') -----
- showApplicationView
-
- self transformToShow: (self valueOfProperty: #applicationViewBounds ifAbsent: [bounds])
- !
Item was removed:
- ----- Method: PasteUpMorph>>showExpandedView (in category 'menu & halo') -----
- showExpandedView
-
- owner "the transform"
- owner "the green border"
- bounds: Display boundingBox!
Item was removed:
- ----- Method: PasteUpMorph>>showFactoryView (in category 'menu & halo') -----
- showFactoryView
-
- self transformToShow: (self valueOfProperty: #factoryViewBounds ifAbsent: [bounds])
- !
Item was removed:
- ----- Method: PasteUpMorph>>showFullView (in category 'menu & halo') -----
- showFullView
-
- self transformToShow: bounds
- !
Item was removed:
- ----- Method: PasteUpMorph>>showReducedView (in category 'menu & halo') -----
- showReducedView
-
- | r |
- r := Display extent // 4 extent: Display extent // 2.
- owner "the transform"
- owner "the green border"
- bounds: r!
Item was removed:
- ----- Method: PasteUpMorph>>showStatusOfAllScripts (in category 'world menu') -----
- showStatusOfAllScripts
- "Put up a window that shows, and allows you to change, the status of all scripts"
-
- self presenter toolToViewScriptInstantiations!
Item was removed:
- ----- Method: PasteUpMorph>>showThumbnailString (in category 'menu & halo') -----
- showThumbnailString
- "Answer the string to be shown in a menu to represent the
- show-thumbnails status"
- ^ ((self hasProperty: #alwaysShowThumbnail)
- ifTrue: ['<on>']
- ifFalse: ['<off>']), 'show thumbnails' translated!
Item was removed:
- ----- Method: PasteUpMorph>>showWorldMainDockingBarString (in category 'menu & halo') -----
- showWorldMainDockingBarString
- ^ self project showWorldMainDockingBarString!
Item was removed:
- ----- Method: PasteUpMorph>>showingListView (in category 'viewing') -----
- showingListView
- "Answer whether the receiver is currently showing a list view"
-
- ^ self hasProperty: #showingListView
- !
Item was removed:
- ----- Method: PasteUpMorph>>sketchEditorOrNil (in category 'world state') -----
- sketchEditorOrNil
- "Return a SketchEditorMorph found in the world, if any, else nil"
-
- ^ self findA: SketchEditorMorph
- !
Item was removed:
- ----- Method: PasteUpMorph>>sleep (in category 'world state') -----
- sleep
-
- self flag: #bob. "Alan wanted this"
-
- worldState canvas ifNil: [^ self "already called (clean this up)"].
- Cursor normal show. "restore the normal cursor"
-
- ">>>> Alan wanted this out
- (turtleTrailsForm ~~ nil and: [self confirm: 'May I clear the pen trails
- in this worldState to save space?']) ifTrue: [self clearTurtleTrails].
- <<<<<"
-
- worldState canvas: nil. "free my canvas to save space"
- self fullReleaseCachedState.
- !
Item was removed:
- ----- Method: PasteUpMorph>>smallThumbnailForPageSorter (in category 'misc') -----
- smallThumbnailForPageSorter
-
- ^ self cachedOrNewThumbnailFrom: BookPageThumbnailMorph new smaller!
Item was removed:
- ----- Method: PasteUpMorph>>someHalo (in category 'world state') -----
- someHalo
- "Return some halo that's currently visible in the world"
-
- | m |
- ^(m := self haloMorphs) notEmpty ifTrue: [m first] ifFalse: [nil]!
Item was removed:
- ----- Method: PasteUpMorph>>sortSubmorphsBy: (in category 'viewing') -----
- sortSubmorphsBy: sortOrderSymbol
- "Sort the receiver's submorphs by the criterion indicated in the provided symbol"
- self invalidRect: self fullBounds.
- submorphs := submorphs sorted: [:a :b | (a perform: sortOrderSymbol) <= (b perform: sortOrderSymbol)].
- self layoutChanged.!
Item was removed:
- ----- Method: PasteUpMorph>>specialNameInModelFor: (in category 'world state') -----
- specialNameInModelFor: aMorph
- ^ model ifNotNil: [model nameFor: aMorph] ifNil: [nil]!
Item was removed:
- ----- Method: PasteUpMorph>>standardPlayerHit (in category 'world state') -----
- standardPlayerHit
-
- self playSoundNamed: 'peaks'.
- !
Item was removed:
- ----- Method: PasteUpMorph>>startBackgroundProcess (in category 'update cycle') -----
- startBackgroundProcess
- "Start a process to update this world in the background. Return the process created."
-
- | p |
- p := [ [
- self doOneCycleInBackground.
- (Delay forMilliseconds: 20) wait] repeat ] newProcess.
- p resume.
- ^ p
- !
Item was removed:
- ----- Method: PasteUpMorph>>startRunningAll (in category 'misc') -----
- startRunningAll
- "Start running all scripted morphs. Triggered by user hitting GO button"
-
- self presenter flushPlayerListCache. "Inefficient, but makes sure things come right whenever GO hit"
- self presenter allExtantPlayers do: [:aPlayer | aPlayer costume residesInPartsBin ifFalse: [aPlayer startRunning]].
-
- self world updateStatusForAllScriptEditors!
Item was removed:
- ----- Method: PasteUpMorph>>startStepping: (in category 'stepping') -----
- startStepping: aMorph
- "Add the given morph to the step list. Do nothing if it is already being stepped."
- ^self startStepping: aMorph at: Time millisecondClockValue selector: #stepAt: arguments: nil stepTime: nil!
Item was removed:
- ----- Method: PasteUpMorph>>startStepping:at:selector:arguments:stepTime: (in category 'stepping') -----
- startStepping: aMorph at: scheduledTime selector: aSelector arguments: args stepTime: stepTime
- worldState startStepping: aMorph at: scheduledTime selector: aSelector arguments: args stepTime: stepTime.!
Item was removed:
- ----- Method: PasteUpMorph>>startSteppingSubmorphsOf: (in category 'world state') -----
- startSteppingSubmorphsOf: aMorph
- "Ensure that all submorphs of the given morph that want to be stepped are added to the step list. Typically used after adding a morph to the world."
-
- self flag: #obsolete. "the intoWorld mechanism in addMorph nowadays takes care of adding submorphs to steplist"
-
- " aMorph allMorphsDo: [:m |
- aMorph ~~ m & m wantsSteps ifTrue: [
- m arrangeToStartSteppingIn: m world]].
- "
-
- !
Item was removed:
- ----- Method: PasteUpMorph>>step (in category 'stepping and presenter') -----
- step
-
- (self isWorldMorph and: [owner notNil]) ifTrue: [
- ^self runLocalStepMethods
- ].
- super step!
Item was removed:
- ----- Method: PasteUpMorph>>stepAll (in category 'misc') -----
- stepAll
- "tick all the paused player scripts in the receiver"
-
- self presenter allExtantPlayers do:
- [:aPlayer |
- aPlayer startRunning; step; stopRunning]!
Item was removed:
- ----- Method: PasteUpMorph>>stepListSize (in category 'project state') -----
- stepListSize
- ^ worldState stepListSize
-
- "Transcript cr; show: self currentWorld stepListSize printString, ' items on steplist as of ', Date dateAndTimeNow printString"!
Item was removed:
- ----- Method: PasteUpMorph>>stepListSummary (in category 'project state') -----
- stepListSummary
- ^ worldState stepListSummary
-
- "Transcript cr show: self currentWorld stepListSummary"!
Item was removed:
- ----- Method: PasteUpMorph>>stepTime (in category 'stepping and presenter') -----
- stepTime
-
- (self isWorldMorph and: [owner notNil]) ifTrue: [
- ^1
- ].
- ^super stepTime!
Item was removed:
- ----- Method: PasteUpMorph>>steppingMorphsNotInWorld (in category 'project state') -----
- steppingMorphsNotInWorld
- | all |
- all := self allMorphs.
- ^ self listOfSteppingMorphs select: [:m | (all includes: m) not]
-
- "self currentWorld steppingMorphsNotInWorld do: [:m | m delete]"!
Item was removed:
- ----- Method: PasteUpMorph>>stopRunningAll (in category 'misc') -----
- stopRunningAll
- "Reset all ticking scripts to be paused. Triggered by user hitting STOP button"
-
- self presenter allExtantPlayers do:
- [:aPlayer |
- aPlayer stopRunning].
-
- self world updateStatusForAllScriptEditors!
Item was removed:
- ----- Method: PasteUpMorph>>stopStepping: (in category 'stepping') -----
- stopStepping: aMorph
- "Remove the given morph from the step list."
-
- worldState stopStepping: aMorph
- !
Item was removed:
- ----- Method: PasteUpMorph>>stopStepping:selector: (in category 'stepping') -----
- stopStepping: aMorph selector: aSelector
- "Remove the given morph from the step list."
-
- worldState stopStepping: aMorph selector: aSelector
- !
Item was removed:
- ----- Method: PasteUpMorph>>storeProjectsAsSegments (in category 'project') -----
- storeProjectsAsSegments
- "Force my sub-projects out to disk"
-
- submorphs do:
- [:sub |
- (sub isSystemWindow)
- ifTrue: [(sub model isKindOf: Project) ifTrue: [sub model storeSegment]]] "OK if was already out"!
Item was removed:
- ----- Method: PasteUpMorph>>thumbnailForPageSorter (in category 'misc') -----
- thumbnailForPageSorter
-
- ^ self cachedOrNewThumbnailFrom: BookPageThumbnailMorph new!
Item was removed:
- ----- Method: PasteUpMorph>>toggleAutoLineLayout (in category 'options') -----
- toggleAutoLineLayout
- "Toggle the auto-line-layout setting"
-
- self autoLineLayout: self autoLineLayout not.
- self autoLineLayout ifFalse: [self restoreBoundsOfSubmorphs].!
Item was removed:
- ----- Method: PasteUpMorph>>toggleClassicNavigatorIfAppropriate (in category 'world menu') -----
- toggleClassicNavigatorIfAppropriate
- "If appropriate, toggle the presence of classic navigator"
-
- Preferences classicNavigatorEnabled ifTrue: [^ Preferences toggle: #showProjectNavigator]!
Item was removed:
- ----- Method: PasteUpMorph>>toggleIsPartsBin (in category 'options') -----
- toggleIsPartsBin
- "Not entirely happy with the openToDragNDrop not being directly manipulable etc, but still living with it for now."
- self setPartsBinStatusTo: self isPartsBin not!
Item was removed:
- ----- Method: PasteUpMorph>>toggleMouseOverHalos (in category 'options') -----
- toggleMouseOverHalos
- wantsMouseOverHalos := self wantsMouseOverHalos not!
Item was removed:
- ----- Method: PasteUpMorph>>toggleResizeToFit (in category 'options') -----
- toggleResizeToFit
- "Toggle whether the receiver is set to resize-to-fit"
-
- self vResizeToFit: self resizeToFit not!
Item was removed:
- ----- Method: PasteUpMorph>>toggleShowWorldMainDockingBar (in category 'menu & halo') -----
- toggleShowWorldMainDockingBar
- self project toggleShowWorldMainDockingBar!
Item was removed:
- ----- Method: PasteUpMorph>>transferMorphConverter (in category 'dropping/grabbing') -----
- transferMorphConverter
- ^self
- valueOfProperty: #transferMorphConverter
- ifAbsent: [ #yourself ]!
Item was removed:
- ----- Method: PasteUpMorph>>transferMorphConverter: (in category 'dropping/grabbing') -----
- transferMorphConverter: aMessageSend
- self
- setProperty: #transferMorphConverter
- toValue: aMessageSend!
Item was removed:
- ----- Method: PasteUpMorph>>transferRemoteServerFrom: (in category 'Nebraska') -----
- transferRemoteServerFrom: aWorld
- "Transfer the remote server which was associated with aWorld (if any) to the receiver"
- | server |
- (aWorld notNil and:[aWorld isMorph and:[aWorld isWorldMorph]]) ifFalse:[^self].
- server := aWorld remoteServer.
- server ifNotNil:[
- self remoteServer: server.
- server clients do:[:each| self addRemoteClient: each].
- self primaryHand
- userInitials: (aWorld primaryHand userInitials)
- andPicture: (aWorld primaryHand userPicture).
- aWorld primaryHand userInitials: '' andPicture: nil].
- aWorld releaseRemoteServer.!
Item was removed:
- ----- Method: PasteUpMorph>>transformToShow: (in category 'menu & halo') -----
- transformToShow: aRectangle
-
- owner changeWorldBoundsToShow: aRectangle
- !
Item was removed:
- ----- Method: PasteUpMorph>>triggerClosingScripts (in category 'world state') -----
- triggerClosingScripts
- "If the receiver has any scripts set to run on closing, run them now"
- | aPlayer |
- self allMorphsDo:[ :m|
- (aPlayer := m player) ifNotNil:
- [aPlayer runAllClosingScripts]]!
Item was removed:
- ----- Method: PasteUpMorph>>triggerOpeningScripts (in category 'world state') -----
- triggerOpeningScripts
- "If the receiver has any scripts set to run on opening, run them now"
- | aPlayer |
- self allMorphsDo:[ :m|
- (aPlayer := m player) ifNotNil:
- [aPlayer runAllOpeningScripts]]!
Item was removed:
- ----- Method: PasteUpMorph>>tryInvokeHalo: (in category 'events-processing') -----
- tryInvokeHalo: aUserInputEvent
-
- Preferences noviceMode ifTrue: [ ^ self ].
- Morph haloForAll ifFalse: [ ^ self ].
-
- (self transferHalo: aUserInputEvent)
- ifTrue: "The event was handled, don't let it cause any further side-effects."
- [ aUserInputEvent ignore ].!
Item was removed:
- ----- Method: PasteUpMorph>>tryInvokeKeyboardShortcut: (in category 'events-processing') -----
- tryInvokeKeyboardShortcut: aKeyboardEvent
-
- aKeyboardEvent commandKeyPressed ifFalse: [^ self].
-
- aKeyboardEvent keyCharacter caseOf: {
- [$R] -> [Utilities browseRecentSubmissions].
- [$L] -> [self findAFileList: aKeyboardEvent].
- [$O] -> [self findAMonticelloBrowser].
- [$P] -> [self findAPreferencesPanel: aKeyboardEvent].
- "[$Z] -> [ChangeList browseRecentLog]."
- [$]] -> [LegacyShortcutsFilter legacyShortcutsEnabled
- ifTrue: [^ self "Keep going."]
- ifFalse: [Smalltalk snapshot: true andQuit: false]].
- } otherwise: [^ self "no hit"].
-
- aKeyboardEvent ignore "hit!!".!
Item was removed:
- ----- Method: PasteUpMorph>>tryInvokeMetaMenu: (in category 'events-processing') -----
- tryInvokeMetaMenu: anEvent
-
- | innerMost target |
- Morph metaMenuForAll ifFalse: [^ self].
- Preferences eToyFriendly ifTrue: [^ self].
-
- innerMost := (self morphsAt: anEvent position unlocked: true) first.
-
- "Traverse the owner chain if some morph does not want to show its meta menu."
- target := innerMost.
- [target isNil or: [target wantsMetaMenu]] whileFalse: [target := target owner].
- target ifNil: [^ self].
-
- target invokeMetaMenu: anEvent.
- anEvent ignore.!
Item was removed:
- ----- Method: PasteUpMorph>>undoOrRedoCommand (in category 'world menu') -----
- undoOrRedoCommand
- "Undo or redo the last command recorded in the world"
-
- ^ self commandHistory undoOrRedoCommand!
Item was removed:
- ----- Method: PasteUpMorph>>unhideHiddenObjects (in category 'misc') -----
- unhideHiddenObjects
- self allMorphsDo:
- [:m | m show]!
Item was removed:
- ----- Method: PasteUpMorph>>unusedMorphNameLike: (in category 'name') -----
- unusedMorphNameLike: stem
- "Answer a suitable name for a morph in this world, based on the stem provided"
-
- | names |
- names := self allKnownNames.
- ^ Utilities keyLike: stem asString satisfying:
- [:aName | (names includes: aName) not]!
Item was removed:
- ----- Method: PasteUpMorph>>updateStatePostRecompile (in category 'recompilation') -----
- updateStatePostRecompile
- "worldState refers to blocks in its alarms and stepList inst vars. These should be rebuilt post recompileAll"
- worldState convertAlarms; convertStepList!
Item was removed:
- ----- Method: PasteUpMorph>>updateStatusForAllScriptEditors (in category 'misc') -----
- updateStatusForAllScriptEditors
- self allScriptEditors do: [:anEditor | anEditor updateStatus]!
Item was removed:
- ----- Method: PasteUpMorph>>useRoundedCorners (in category 'accessing') -----
- useRoundedCorners
- "Somewhat special cased because we do have to fill Display for this"
- super useRoundedCorners.
- self == self world ifTrue:[Display bits primFill: 0]. "done so that we *don't* get a flash"!
Item was removed:
- ----- Method: PasteUpMorph>>validateMouseEvent: (in category 'WiW support') -----
- validateMouseEvent: evt
-
- !
Item was removed:
- ----- Method: PasteUpMorph>>valueAtCursor (in category 'cursor') -----
- valueAtCursor
- "Answer the submorph of mine indexed by the value of my 'cursor' slot"
-
- submorphs isEmpty ifTrue: [^ self presenter standardPlayer costume].
- ^ (submorphs at: ((cursor truncated max: 1) min: submorphs size)) morphRepresented!
Item was removed:
- ----- Method: PasteUpMorph>>valueAtCursor: (in category 'cursor') -----
- valueAtCursor: aMorph
- submorphs isEmpty ifTrue: [^ self].
- self rectifyCursor.
- self replaceSubmorph: self valueAtCursor by: aMorph!
Item was removed:
- ----- Method: PasteUpMorph>>veryDeepCopyWith: (in category 'copying') -----
- veryDeepCopyWith: deepCopier
- "See storeDataOn:"
-
- ^ self isWorldMorph
- ifTrue: [self] "never copy the World"
- ifFalse: [super veryDeepCopyWith: deepCopier]!
Item was removed:
- ----- Method: PasteUpMorph>>viewBox (in category 'project state') -----
- viewBox
- "This tortured workaround arises from a situation encountered
- in which a PasteUpMorph was directliy lodged as a submorph
- of another PasteUpMorph of identical size, with the former
- bearing flaps but the latter being the world"
- ^ worldState
- ifNil: [super viewBox]
- ifNotNil: [worldState viewBox]!
Item was removed:
- ----- Method: PasteUpMorph>>viewBox: (in category 'project state') -----
- viewBox: newViewBox
- "I am now displayed within newViewBox; react."
-
- self isWorldMorph ifTrue: [
- (self viewBox isNil or: [self viewBox extent ~= newViewBox extent])
- ifTrue: [worldState canvas: nil].
- worldState viewBox: newViewBox].
-
- super position: newViewBox topLeft.
-
- fullBounds := bounds := newViewBox.!
Item was removed:
- ----- Method: PasteUpMorph>>viewingNormally (in category 'viewing') -----
- viewingNormally
- "Answer whether the receiver is being viewed normally, viz not in list-view or auto-line-layout"
-
- ^ (self showingListView or: [self autoLineLayout == true]) not
- !
Item was removed:
- ----- Method: PasteUpMorph>>wantsDirectionHandles (in category 'halos and balloon help') -----
- wantsDirectionHandles
-
- ^ super wantsDirectionHandles and: [self isWorldMorph not]!
Item was removed:
- ----- Method: PasteUpMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
- wantsDroppedMorph: aMorph event: evt
- self isWorldMorph ifTrue:[^true]. "always"
- self visible ifFalse: [^ false]. "will be a call to #hidden again very soon"
- self dropEnabled ifFalse: [^ false].
- ^ true!
Item was removed:
- ----- Method: PasteUpMorph>>wantsDroppedTransferMorph: (in category 'dropping/grabbing') -----
- wantsDroppedTransferMorph: transferMorph
-
- ^ self hasTransferMorphConverter
- or: [transferMorph dragTransferType = #filesAndDirectories]
- or: [transferMorph dragTransferType = #sourceCode]!
Item was removed:
- ----- Method: PasteUpMorph>>wantsEasySelection (in category 'event handling') -----
- wantsEasySelection
- "Answer if the receiver want easy selection mode"
- ^ Preferences easySelection!
Item was removed:
- ----- Method: PasteUpMorph>>wantsHaloFor: (in category 'halos and balloon help') -----
- wantsHaloFor: aSubMorph
- "Answer whether the receiver wishes for a mouse-over halo to be produced for aSubMorph"
-
- ^ wantsMouseOverHalos == true and:
- [self visible and:
- [isPartsBin ~~ true and:
- [self dropEnabled and:
- [aSubMorph renderedMorph isLikelyRecipientForMouseOverHalos]]]]!
Item was removed:
- ----- Method: PasteUpMorph>>wantsHaloFromClick (in category 'halos and balloon help') -----
- wantsHaloFromClick
- (owner isSystemWindow) ifTrue: [^ false].
- self paintBoxOrNil ifNotNil: [^ false].
- ^ true.
- !
Item was removed:
- ----- Method: PasteUpMorph>>wantsKeyboardFocusFor: (in category 'event handling') -----
- wantsKeyboardFocusFor: aSubmorph
- aSubmorph inPartsBin ifTrue: [^ false].
- aSubmorph wouldAcceptKeyboardFocus ifTrue: [ ^ true].
- ^ super wantsKeyboardFocusFor: aSubmorph!
Item was removed:
- ----- Method: PasteUpMorph>>wantsMouseOverHalos (in category 'options') -----
- wantsMouseOverHalos
- ^ wantsMouseOverHalos == true!
Item was removed:
- ----- Method: PasteUpMorph>>wantsMouseOverHalos: (in category 'options') -----
- wantsMouseOverHalos: aBoolean
- wantsMouseOverHalos := aBoolean!
Item was removed:
- ----- Method: PasteUpMorph>>wantsWindowEvent: (in category 'event handling') -----
- wantsWindowEvent: anEvent
- ^self isWorldMorph or: [self windowEventHandler notNil]!
Item was removed:
- ----- Method: PasteUpMorph>>windowEvent: (in category 'event handling') -----
- windowEvent: anEvent
-
- self windowEventHandler
- ifNotNil: [^self windowEventHandler windowEvent: anEvent].
-
- anEvent type
- caseOf: {
- [#windowClose] -> [
- Preferences eToyFriendly
- ifTrue: [ProjectNavigationMorph basicNew quitSqueak]
- ifFalse: [TheWorldMenu basicNew quitSession]].
-
- [#windowDeactivated] -> [
- "The host window has been deactivated. Until it regains the focus, honor the fact that we will not receive keyboard events again by changing the current keyboard focus morph. windowHostFocusMorph represents the host system which now holds the keyboard focus instead of the previousFocus."
- (self valueOfProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus |
- "There is currently no exact-once guarantee for this event type from the VM. Mark any older host focus morph as inactive, it will be held as the previousFocus of the next host focus morph."
- hostFocus active: false].
- self setProperty: #windowHostFocusMorph toValue: (WindowHostFocusMorph new
- in: [:hostFocus |
- hostFocus previousFocus: anEvent hand keyboardFocus.
- anEvent hand newKeyboardFocus: hostFocus.];
- yourself)].
- [#windowActivated] -> [
- "Alright, the spook is over!! We have back control over the keyboard focus, delete the windowHostFocusMorph and restore the previous focus holder."
- (self removeProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus |
- hostFocus active: false.
- (anEvent hand keyboardFocus == hostFocus and: [hostFocus previousFocus notNil]) ifTrue:
- [anEvent hand newKeyboardFocus: hostFocus previousFocus]]]. }
- otherwise: []!
Item was removed:
- ----- Method: PasteUpMorph>>windowEventHandler (in category 'event handling') -----
- windowEventHandler
- "This is a class variable so it is global to all projects and does not get saved"
- ^WindowEventHandler!
Item was removed:
- ----- Method: PasteUpMorph>>windowEventHandler: (in category 'event handling') -----
- windowEventHandler: anObject
- "This is a class variable so it is global to all projects and does not get saved"
- WindowEventHandler := anObject
- !
Item was removed:
- ----- Method: PasteUpMorph>>world (in category 'structure') -----
- world
- worldState ifNil: [^super world].
- ^self!
Item was removed:
- ----- Method: PasteUpMorph>>yellowButtonClickOnDesktopWithEvent: (in category 'world menu') -----
- yellowButtonClickOnDesktopWithEvent: evt
- "Put up either the personalized menu or the world menu when
- the user clicks on the morphic desktop with the yellow button.
- The preference 'personalizedWorldMenu' governs which one
- is used"
- | aMenu |
- Preferences personalizedWorldMenu
- ifTrue: [aMenu := MenuMorph new defaultTarget: self.
- Preferences personalizeUserMenu: aMenu.
- aMenu addLine.
- aMenu
- add: 'personalize...' translated
- target: Preferences
- action: #letUserPersonalizeMenu]
- ifFalse: [aMenu := self buildWorldMenu: evt.
- aMenu addTitle: 'World' translated].
- aMenu popUpEvent: evt in: self!
Item was removed:
- Morph subclass: #PluggableButtonMorph
- instanceVariableNames: 'model label font getStateSelector actionSelector getLabelSelector getMenuSelector shortcutCharacter askBeforeChanging triggerOnMouseDown offColor onColor feedbackColor showSelectionFeedback arguments argumentsProvider argumentsSelector style hoverColor borderColor textColor labelOffset wantsGradient'
- classVariableNames: 'GradientButton RoundedButtonCorners'
- poolDictionaries: ''
- category: 'Morphic-Pluggable Widgets'!
-
- !PluggableButtonMorph commentStamp: '<historical>' prior: 0!
- A PluggableButtonMorph is a combination of an indicator for a boolean value stored in its model and an action button. The action of a button is often, but not always, to toggle the boolean value that it shows. Its pluggable selectors are:
-
- getStateSelector fetch a boolean value from the model
- actionSelector invoke this button's action on the model
- getLabelSelector fetch this button's lable from the model
- getMenuSelector fetch a pop-up menu for this button from the model
-
- Any of the above selectors can be nil, meaning that the model does not supply behavior for the given action, and the default behavior should be used. For example, if getStateSelector is nil, then this button shows the state of a read-only boolean that is always false.
-
- The model informs its view(s) of changes by sending #changed: to itself with getStateSelector as a parameter. The view tells the model when the button is pressed by sending actionSelector.
-
- If the actionSelector takes one or more arguments, then the following are relevant:
- arguments A list of arguments to provide when the actionSelector is called.
- argumentsProvider The object that is sent the argumentSelector to obtain arguments, if dynamic
- argumentsSelector The message sent to the argumentProvider to obtain the arguments.
-
- Options:
- askBeforeChanging have model ask user before allowing a change that could lose edits
- triggerOnMouseDown do this button's action on mouse down (vs. up) transition
- shortcutCharacter a place to record an optional shortcut key
- !
Item was removed:
- ----- Method: PluggableButtonMorph class>>example (in category 'example') -----
- example
- "PluggableButtonMorph example openInWorld"
-
- | s1 s2 s3 b1 b2 b3 row switchClass |
- switchClass := Smalltalk at: #Switch ifAbsent: [^self inform: 'MVC class Switch not present'].
- s1 := switchClass new.
- s2 := switchClass new turnOn.
- s3 := switchClass new.
- s2 onAction: [s3 turnOff].
- s3 onAction: [s2 turnOff].
- b1 := (PluggableButtonMorph on: s1 getState: #isOn action: #switch) label: 'S1'.
- b2 := (PluggableButtonMorph on: s2 getState: #isOn action: #turnOn) label: 'S2'.
- b3 := (PluggableButtonMorph on: s3 getState: #isOn action: #turnOn) label: 'S3'.
- b1
- hResizing: #spaceFill;
- vResizing: #spaceFill.
- b2
- hResizing: #spaceFill;
- vResizing: #spaceFill.
- b3
- hResizing: #spaceFill;
- vResizing: #spaceFill.
-
- row := AlignmentMorph newRow
- hResizing: #spaceFill;
- vResizing: #spaceFill;
- addAllMorphs: (Array with: b1 with: b2 with: b3);
- extent: 120 at 35.
- ^ row
- !
Item was removed:
- ----- Method: PluggableButtonMorph class>>gradientButton (in category 'preferences') -----
- gradientButton
- <preference: 'gradientButton'
- category: 'windows'
- description: 'If true, buttons will have a gradient look.'
- type: #Boolean>
- ^ GradientButton ifNil: [ true ]!
Item was removed:
- ----- Method: PluggableButtonMorph class>>gradientButton: (in category 'preferences') -----
- gradientButton: aBoolean
-
- GradientButton = aBoolean ifTrue: [^ self].
- GradientButton := aBoolean.
-
- PluggableButtonMorph allSubInstancesDo: [:ea | ea updateFillStyle].!
Item was removed:
- ----- Method: PluggableButtonMorph class>>labelMargins (in category 'defaults') -----
- labelMargins
-
- | inset |
- inset := (4 * RealEstateAgent scaleFactor) truncated.
- ^ inset @ 0 corner: inset @ 0!
Item was removed:
- ----- Method: PluggableButtonMorph class>>on: (in category 'instance creation') -----
- on: anObject
-
- ^ self on: anObject getState: #isOn action: #switch
- !
Item was removed:
- ----- Method: PluggableButtonMorph class>>on:getState:action: (in category 'instance creation') -----
- on: anObject getState: getStateSel action: actionSel
-
- ^ self new
- on: anObject
- getState: getStateSel
- action: actionSel
- label: nil
- menu: nil
- !
Item was removed:
- ----- Method: PluggableButtonMorph class>>on:getState:action:label: (in category 'instance creation') -----
- on: anObject getState: getStateSel action: actionSel label: labelSel
-
- ^ self new
- on: anObject
- getState: getStateSel
- action: actionSel
- label: labelSel
- menu: nil
- !
Item was removed:
- ----- Method: PluggableButtonMorph class>>on:getState:action:label:menu: (in category 'instance creation') -----
- on: anObject getState: getStateSel action: actionSel label: labelSel menu: menuSel
-
- ^ self new
- on: anObject
- getState: getStateSel
- action: actionSel
- label: labelSel
- menu: menuSel
- !
Item was removed:
- ----- Method: PluggableButtonMorph class>>roundedButtonCorners (in category 'preferences') -----
- roundedButtonCorners
- <preference: 'Rounded Button Corners'
- category: 'windows'
- description: 'If true, pluggable buttons in system windows will be rounded'
- type: #Boolean>
- ^ RoundedButtonCorners ifNil: [ true ]!
Item was removed:
- ----- Method: PluggableButtonMorph class>>roundedButtonCorners: (in category 'preferences') -----
- roundedButtonCorners: aBoolean
-
- | world |
- RoundedButtonCorners := aBoolean.
- world := Project current world.
- world invalidRect: world bounds from: world.!
Item was removed:
- ----- Method: PluggableButtonMorph class>>themePriority (in category 'preferences') -----
- themePriority
-
- ^ 50!
Item was removed:
- ----- Method: PluggableButtonMorph class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ super themeProperties, {
- { #borderColor. 'Colors'. 'Color of the button''s border.' }.
- { #borderWidth. 'Borders'. 'Width of the button''s border.' }.
- { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }.
- { #color. 'Colors'. 'Background color of the button.' }.
-
- { #font. 'Fonts'. 'Font for button title.' }.
- { #textColor. 'Colors'. 'Color for the button title label.' }.
- }!
Item was removed:
- ----- Method: PluggableButtonMorph>>action: (in category 'accessing') -----
- action: aSymbol
- "Set actionSelector to be the action defined by aSymbol."
-
- actionSelector := aSymbol.
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>actionSelector (in category 'accessing') -----
- actionSelector
- "Answer the receiver's actionSelector"
-
- ^ actionSelector!
Item was removed:
- ----- Method: PluggableButtonMorph>>actionSelector: (in category 'accessing') -----
- actionSelector: aSymbol
- "Set actionSelector to be the action defined by aSymbol."
-
- actionSelector := aSymbol.
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>applyUserInterfaceTheme (in category 'updating') -----
- applyUserInterfaceTheme
-
- super applyUserInterfaceTheme.
- self setDefaultParameters.!
Item was removed:
- ----- Method: PluggableButtonMorph>>arguments: (in category 'arguments') -----
- arguments: args
- "If the receiver takes argument(s) that are static, they can be filled by calling this. If its argument(s) are to be dynamically determined, then use an argumentProvider and argumentSelector instead"
-
- arguments := args!
Item was removed:
- ----- Method: PluggableButtonMorph>>argumentsProvider:argumentsSelector: (in category 'arguments') -----
- argumentsProvider: anObject argumentsSelector: aSelector
- "Set the argument provider and selector"
-
- argumentsProvider := anObject.
- argumentsSelector := aSelector!
Item was removed:
- ----- Method: PluggableButtonMorph>>askBeforeChanging (in category 'accessing') -----
- askBeforeChanging
-
- ^ askBeforeChanging
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>askBeforeChanging: (in category 'accessing') -----
- askBeforeChanging: aBoolean
- "If this preference is turned on, then give the model an opportunity to ask the user before accepting a change that might cause unaccepted edits to be lost."
-
- askBeforeChanging := aBoolean.
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>browseAllImplementorsOfActionSelector (in category 'browse') -----
- browseAllImplementorsOfActionSelector
- SystemNavigation default browseAllImplementorsOf: actionSelector localTo: model class!
Item was removed:
- ----- Method: PluggableButtonMorph>>browseImplementationOfActionSelector (in category 'debug menu') -----
- browseImplementationOfActionSelector
-
- | method |
- self updateArguments.
- method := self effectiveActionTarget class lookupSelector: self effectiveActionSelector.
- ToolSet browse: method methodClass selector: method selector.!
Item was removed:
- ----- Method: PluggableButtonMorph>>buildDebugMenu: (in category 'debug menu') -----
- buildDebugMenu: aHandMorph
- | aMenu |
- aMenu := super buildDebugMenu: aHandMorph.
- aMenu addLine.
- aMenu add: 'browse action code' translated target: self action: #browseImplementationOfActionSelector.
- aMenu add: 'debug action invocation' translated target: self action: #debugAction.
- ^ aMenu!
Item was removed:
- ----- Method: PluggableButtonMorph>>debugAction (in category 'debug menu') -----
- debugAction
-
- self updateArguments.
-
- (Process
- forBlock: [self doButtonAction]
- runUntil: [:context | context selector = self effectiveActionSelector])
- debugWithTitle: ('Debug button action "{1}" in model "{2}"' translated format: {self label. self target printString}).!
Item was removed:
- ----- Method: PluggableButtonMorph>>defaultLayoutInset (in category 'layout') -----
- defaultLayoutInset
-
- ^ self class labelMargins!
Item was removed:
- ----- Method: PluggableButtonMorph>>doButtonAction (in category 'button') -----
- doButtonAction
-
- ^ self performAction!
Item was removed:
- ----- Method: PluggableButtonMorph>>drawLabelOn: (in category 'drawing') -----
- drawLabelOn: aCanvas
-
- | fontToUse labelToUse colorToUse labelWidth layoutBounds drawBlock |
- self label ifNil: [^ self].
-
- layoutBounds := self layoutBounds.
- labelToUse := self label asString.
- fontToUse := self font.
- colorToUse := self textColorToUse.
-
- "Support very narrow buttons. Shrink text to monogram then."
- ((layoutBounds width < self labelShrinkThreshold
- and: [self hResizing ~~ #shrinkWrap])
- and: [labelToUse size > 3]) ifTrue: [
- labelToUse := labelToUse first asString. "Show first character only."
- fontToUse := fontToUse emphasized: (TextEmphasis bold) emphasisCode].
-
- labelWidth := fontToUse widthOfString: labelToUse.
-
- drawBlock := [:c | c
- drawString: labelToUse
- at: (layoutBounds center x - (labelWidth // 2) max: (layoutBounds left))
- @ (layoutBounds center y - (fontToUse height // 2))
- font: fontToUse
- color: colorToUse].
-
- self clipSubmorphs
- ifTrue: [aCanvas clipBy: layoutBounds during: drawBlock]
- ifFalse: [drawBlock value: aCanvas]!
Item was removed:
- ----- Method: PluggableButtonMorph>>drawMorphLabelOn: (in category 'drawing') -----
- drawMorphLabelOn: aCanvas
-
- | layoutBounds |
- layoutBounds := self layoutBounds.
-
- self label privateFullMoveBy: (layoutBounds center - self label center).
-
- self clipSubmorphs
- ifTrue: [aCanvas
- clipBy: layoutBounds
- during: [:c | c fullDrawMorph: self label]]
- ifFalse: [aCanvas fullDrawMorph: self label].!
Item was removed:
- ----- Method: PluggableButtonMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- (self fillStyle isColor not and: [self fillStyle isGradientFill])
- ifTrue: [self fillStyle origin: self topLeft; direction: 0@ self height].
-
- super drawOn: aCanvas.
-
- aCanvas
- translateBy: self labelOffset
- during: [:c |
- self label isMorph
- ifTrue: [self drawMorphLabelOn: c]
- ifFalse: [self drawLabelOn: c]].!
Item was removed:
- ----- Method: PluggableButtonMorph>>effectiveActionSelector (in category 'debug menu') -----
- effectiveActionSelector
-
- ^ self actionSelector = #perform:orSendTo:
- ifTrue: [arguments first]
- ifFalse: [self actionSelector]!
Item was removed:
- ----- Method: PluggableButtonMorph>>effectiveActionTarget (in category 'debug menu') -----
- effectiveActionTarget
-
- ^ (self actionSelector = #perform:orSendTo:
- and: [(self target respondsTo: self effectiveActionSelector) not])
- ifTrue: [arguments second]
- ifFalse: [self target]!
Item was removed:
- ----- Method: PluggableButtonMorph>>enabled (in category 'accessing') -----
- enabled
- ^true!
Item was removed:
- ----- Method: PluggableButtonMorph>>feedbackColor (in category 'accessing') -----
- feedbackColor
- ^ feedbackColor!
Item was removed:
- ----- Method: PluggableButtonMorph>>feedbackColor: (in category 'accessing') -----
- feedbackColor: aColor
- "Set the color of this button's selection feedback border."
-
- feedbackColor := aColor.
- self changed.
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>font (in category 'accessing') -----
- font
-
- ^ font ifNil: [Preferences standardButtonFont]!
Item was removed:
- ----- Method: PluggableButtonMorph>>font: (in category 'accessing') -----
- font: aFont
-
- font = aFont ifTrue: [^ self].
- font := aFont.
-
- self updateMinimumExtent.
- self changed.!
Item was removed:
- ----- Method: PluggableButtonMorph>>getLabelSelector (in category 'accessing') -----
- getLabelSelector
- ^ getLabelSelector!
Item was removed:
- ----- Method: PluggableButtonMorph>>getLabelSelector: (in category 'accessing') -----
- getLabelSelector: aSymbol
- getLabelSelector := aSymbol.
- self update: getLabelSelector.!
Item was removed:
- ----- Method: PluggableButtonMorph>>getMenu: (in category 'private') -----
- getMenu: shiftPressed
- "Answer the menu for this button, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key."
-
- | menu |
- getMenuSelector isNil ifTrue: [^nil].
- menu := MenuMorph new defaultTarget: model.
- getMenuSelector numArgs = 1
- ifTrue: [^model perform: getMenuSelector with: menu].
- getMenuSelector numArgs = 2
- ifTrue:
- [^model
- perform: getMenuSelector
- with: menu
- with: shiftPressed].
- ^self error: 'The getMenuSelector must be a 1- or 2-keyword symbol'!
Item was removed:
- ----- Method: PluggableButtonMorph>>getModelState (in category 'private') -----
- getModelState
- "Answer the result of sending the receiver's model the getStateSelector message."
-
- ^ getStateSelector
- ifNil: [false]
- ifNotNil: [model perform: getStateSelector]!
Item was removed:
- ----- Method: PluggableButtonMorph>>getStateSelector (in category 'accessing') -----
- getStateSelector
- ^ getStateSelector!
Item was removed:
- ----- Method: PluggableButtonMorph>>getStateSelector: (in category 'accessing') -----
- getStateSelector: aSymbol
- getStateSelector := aSymbol.
- self update: getStateSelector.!
Item was removed:
- ----- Method: PluggableButtonMorph>>hResizing: (in category 'layout properties') -----
- hResizing: aSymbol
- "We adapt our minimum extent according to our resize behavior."
-
- self hResizing == aSymbol ifTrue: [^ self].
- super hResizing: aSymbol.
- self updateMinimumExtent.!
Item was removed:
- ----- Method: PluggableButtonMorph>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: evt
-
- ^ true
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>handlesMouseOver: (in category 'event handling') -----
- handlesMouseOver: evt
-
- ^ true!
Item was removed:
- ----- Method: PluggableButtonMorph>>handlesMouseOverDragging: (in category 'event handling') -----
- handlesMouseOverDragging: evt
-
- ^ true!
Item was removed:
- ----- Method: PluggableButtonMorph>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
-
- "Layout properties."
- self
- extent: 20 @ 15;
- clipSubmorphs: true.
-
- "Set layout properties directly to avoid unnecessary calls to #updateMinimumExtent. Should be replaced with #assureLayoutProperties in the future."
- self assureTableLayoutProperties
- hResizing: #shrinkWrap;
- vResizing: #shrinkWrap;
- layoutInset: self defaultLayoutInset;
- wrapCentering: #center;
- cellPositioning: #topCenter.
-
- "Initialize instance variables."
- model := nil.
- label := nil.
- getStateSelector := nil.
- actionSelector := nil.
- getLabelSelector := nil.
- getMenuSelector := nil.
- shortcutCharacter := nil.
- askBeforeChanging := false.
- triggerOnMouseDown := false.
- argumentsProvider := nil.
- argumentsSelector := nil.
-
- self setDefaultParameters.
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>invokeMenu: (in category 'private') -----
- invokeMenu: evt
- "Invoke my menu in response to the given event."
- | menu |
- menu := self getMenu: evt shiftPressed.
- menu ifNotNil: [menu popUpEvent: evt in: self world]!
Item was removed:
- ----- Method: PluggableButtonMorph>>isButton (in category 'classification') -----
- isButton
-
- ^ true!
Item was removed:
- ----- Method: PluggableButtonMorph>>label (in category 'accessing') -----
- label
- "Answer the DisplayObject used as this button's label."
-
- ^ label ifNil: ['']
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>label: (in category 'accessing') -----
- label: aStringOrTextOrMorph
-
- label = aStringOrTextOrMorph ifTrue: [^ self].
- label := aStringOrTextOrMorph isString
- ifFalse: [aStringOrTextOrMorph asMorph]
- ifTrue: [aStringOrTextOrMorph].
-
- aStringOrTextOrMorph isText
- ifTrue: [ "Allow custom formatting through clients. Fall back to button font."
- label "aTextMorph" textStyle: self font asNewTextStyle].
- aStringOrTextOrMorph isString
- ifFalse: [ "Configure StringMorph with the correct font. See Object >> #asMorph."
- (label respondsTo: #font:) ifTrue: [label font: self font]].
-
- self updateMinimumExtent.
- self changed.!
Item was removed:
- ----- Method: PluggableButtonMorph>>label:font: (in category 'accessing') -----
- label: aStringOrTextOrMorph font: aFont
-
- font := aFont. "Must set font first. See #label: and text support."
- self label: aStringOrTextOrMorph.
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>labelOffset (in category 'accessing') -----
- labelOffset
- ^ labelOffset ifNil: [0 at 0]!
Item was removed:
- ----- Method: PluggableButtonMorph>>labelOffset: (in category 'accessing') -----
- labelOffset: aPoint
- labelOffset := aPoint.!
Item was removed:
- ----- Method: PluggableButtonMorph>>labelShrinkThreshold (in category 'drawing') -----
- labelShrinkThreshold
- "Determines the minimum width for labels not to be shrunk down to their first character."
-
- ^ (self font widthOf: $m)*3!
Item was removed:
- ----- Method: PluggableButtonMorph>>model (in category 'accessing') -----
- model
-
- ^ model!
Item was removed:
- ----- Method: PluggableButtonMorph>>model: (in category 'accessing') -----
- model: anObject
- "Set my model and make me me a dependent of the given object."
-
- model ifNotNil: [model removeDependent: self].
- anObject ifNotNil: [anObject addDependent: self].
- model := anObject.
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>mouseDown: (in category 'event handling') -----
- mouseDown: evt
-
- evt yellowButtonPressed ifTrue: [^ self invokeMenu: evt].
- triggerOnMouseDown
- ifTrue: [self performAction]
- ifFalse: [self updateFillStyle: evt].
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>mouseEnter: (in category 'event handling') -----
- mouseEnter: evt
-
- self updateFillStyle: evt.!
Item was removed:
- ----- Method: PluggableButtonMorph>>mouseLeave: (in category 'event handling') -----
- mouseLeave: evt
-
- self updateFillStyle: evt.!
Item was removed:
- ----- Method: PluggableButtonMorph>>mouseLeaveDragging: (in category 'event handling') -----
- mouseLeaveDragging: evt
-
- self mouseLeave: evt!
Item was removed:
- ----- Method: PluggableButtonMorph>>mouseMove: (in category 'event handling') -----
- mouseMove: evt
-
- self updateFillStyle: evt.!
Item was removed:
- ----- Method: PluggableButtonMorph>>mouseUp: (in category 'event handling') -----
- mouseUp: evt
-
- self updateFillStyle: evt.
- (self containsPoint: evt cursorPoint)
- ifTrue: [self performAction].!
Item was removed:
- ----- Method: PluggableButtonMorph>>offColor (in category 'accessing') -----
- offColor
- ^ offColor
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>offColor: (in category 'accessing') -----
- offColor: colorWhenOff
- "Set the fill colors to be used when this button is off."
-
- | cc |
- cc := colorWhenOff isTransparent ifTrue: [(Color gray: 0.9) alpha: 0.5] ifFalse: [colorWhenOff].
- self
- onColor: ((self userInterfaceTheme selectionModifier ifNil: [ [:c | c adjustBrightness: -0.2] ]) value: cc)
- offColor: cc
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>on:getState:action:label:menu: (in category 'initialization') -----
- on: anObject getState: getStateSel action: actionSel label: labelSel menu: menuSel
-
- self model: anObject.
- getStateSelector := getStateSel.
- actionSelector := actionSel.
- getLabelSelector := labelSel.
- getMenuSelector := menuSel.
-
- self update: labelSel.
- self update: getStateSel.
- self updateFillStyle.!
Item was removed:
- ----- Method: PluggableButtonMorph>>onColor:offColor: (in category 'accessing') -----
- onColor: colorWhenOn offColor: colorWhenOff
- "Set the fill colors to be used when this button is on/off."
-
- onColor := colorWhenOn.
- offColor := colorWhenOff.
-
- hoverColor := (self userInterfaceTheme hoverModifier ifNil: [ [:c | c adjustBrightness: -0.1] ]) value: offColor.
- feedbackColor := (self userInterfaceTheme feedbackModifier ifNil: [ [:c | c adjustBrightness: -0.3] ]) value: offColor.
-
- self updateFillStyle.!
Item was removed:
- ----- Method: PluggableButtonMorph>>performAction (in category 'event handling') -----
- performAction
- "Inform the model that this button has been pressed. Sent by the controller when this button is pressed. If the button's actionSelector takes any arguments, they are obtained dynamically by sending the argumentSelector to the argumentsProvider"
-
- askBeforeChanging ifTrue: [model okToChange ifFalse: [^ self]].
- actionSelector ifNotNil:
- [actionSelector numArgs = 0
- ifTrue:
- [model perform: actionSelector]
- ifFalse:
- [self updateArguments.
- model perform: actionSelector withArguments: arguments]]!
Item was removed:
- ----- Method: PluggableButtonMorph>>setDefaultParameters (in category 'initialization') -----
- setDefaultParameters
- "change the receiver's appareance parameters"
-
- self
- color: (self userInterfaceTheme color ifNil: [Color gray: 0.91]);
- borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle default]) copy;
- borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]);
- borderWidth: ((self userInterfaceTheme borderWidth ifNil: [1]) * RealEstateAgent scaleFactor) truncated;
- font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]);
- textColor: (self userInterfaceTheme textColor ifNil: [Color black]).
-
- borderColor := self borderColor.
- self offColor: self color.!
Item was removed:
- ----- Method: PluggableButtonMorph>>shortcutCharacter (in category 'accessing') -----
- shortcutCharacter
- "Return the Character to be used as a shortcut to turn on this switch, or nil if this switch doesn't have a keyboard shortcut."
-
- ^ shortcutCharacter
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>shortcutCharacter: (in category 'accessing') -----
- shortcutCharacter: aCharacter
- "Set the character to be used as a keyboard shortcut for turning on this switch."
-
- shortcutCharacter := aCharacter.
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>style (in category 'accessing') -----
- style
- "Treat aSymbol as a hint to modify the button appearance."
- ^style
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>style: (in category 'accessing') -----
- style: aSymbol
- "Use aSymbol as a hint to modify the button appearance."
- style := aSymbol
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>target (in category 'accessing') -----
- target
-
- ^ model!
Item was removed:
- ----- Method: PluggableButtonMorph>>target: (in category 'accessing') -----
- target: anObject
-
- self model: anObject.!
Item was removed:
- ----- Method: PluggableButtonMorph>>textColor (in category 'accessing') -----
- textColor
- ^ textColor ifNil: [Color black "old instances"]!
Item was removed:
- ----- Method: PluggableButtonMorph>>textColor: (in category 'accessing') -----
- textColor: aColor
- textColor := aColor.
- self changed.!
Item was removed:
- ----- Method: PluggableButtonMorph>>textColorToUse (in category 'drawing') -----
- textColorToUse
-
- ^ self textColor!
Item was removed:
- ----- Method: PluggableButtonMorph>>triggerOnMouseDown (in category 'accessing') -----
- triggerOnMouseDown
-
- ^ triggerOnMouseDown
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>triggerOnMouseDown: (in category 'accessing') -----
- triggerOnMouseDown: aBoolean
- "If this preference is turned on, then trigger my action immediately when the mouse goes down."
-
- triggerOnMouseDown := aBoolean.
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>update: (in category 'updating') -----
- update: aParameter
-
- getLabelSelector ifNotNil: [:sel |
- aParameter == sel ifTrue: [self label: (model perform: sel)]].
- getStateSelector ifNotNil: [:sel |
- aParameter == sel ifTrue: [self updateFillStyle]].!
Item was removed:
- ----- Method: PluggableButtonMorph>>updateArguments (in category 'updating') -----
- updateArguments
-
- argumentsProvider ifNil: [^ self].
- argumentsSelector ifNil: [^ self].
- arguments := argumentsProvider perform: argumentsSelector.!
Item was removed:
- ----- Method: PluggableButtonMorph>>updateFillStyle (in category 'updating') -----
- updateFillStyle
-
- ^ self updateFillStyle: self currentEvent!
Item was removed:
- ----- Method: PluggableButtonMorph>>updateFillStyle: (in category 'updating') -----
- updateFillStyle: evt
-
- self
- updateFillStylePressing: (evt isMouse and: [evt redButtonPressed] and: [self containsPoint: evt position])
- hovering: (evt isMouse and: [evt redButtonPressed not] and: [self containsPoint: evt position]).!
Item was removed:
- ----- Method: PluggableButtonMorph>>updateFillStylePressing:hovering: (in category 'updating') -----
- updateFillStylePressing: isPressing hovering: isHovering
-
- | gradient cc |
- "Migrate old instances."
- hoverColor ifNil: [hoverColor := onColor darker].
-
- self labelOffset: (isPressing ifTrue: [1 at 1] ifFalse: [0 at 0]).
-
- self getModelState
- ifTrue: [self color: onColor]
- ifFalse: [self color: offColor].
- self borderStyle color: borderColor.
-
- self wantsGradient ifFalse: [
- isPressing ifTrue: [
- self color: feedbackColor.
- self borderStyle color: feedbackColor muchDarker].
- isHovering ifTrue: [
- self color: hoverColor.
- self borderStyle color: borderColor].
- ^ self].
-
- isPressing ifTrue: [
- cc := feedbackColor.
- self borderColor: feedbackColor muchDarker.
- gradient := GradientFillStyle ramp: {
- 0.0 -> cc muchDarker.
- 0.1-> (cc adjustBrightness: -0.2).
- 0.5 -> cc.
- 0.9-> (cc adjustBrightness: -0.1).
- 1 -> cc muchDarker}].
- isHovering ifTrue: [
- cc := hoverColor.
- gradient := GradientFillStyle ramp: {
- 0.0 -> Color white.
- 0.1-> (cc adjustBrightness: 0.05).
- 0.6 -> (cc darker)}].
- gradient ifNil: [
- cc := self color.
- gradient := GradientFillStyle ramp: {
- 0.0 -> Color white.
- 0.1-> (cc adjustBrightness: 0.05).
- 0.6 -> (cc darker)}].
-
- gradient origin: bounds topLeft.
- gradient direction: 0 at self height.
-
- self fillStyle: gradient.!
Item was removed:
- ----- Method: PluggableButtonMorph>>updateMinimumExtent (in category 'layout') -----
- updateMinimumExtent
-
- | hMin vMin |
- self label isMorph
- ifTrue: [^ self minimumExtent: self label minExtent].
-
- hMin := vMin := 0.
- self hResizing ~~ #spaceFill
- ifTrue: [hMin := (self font widthOfString: self label) max: (self font widthOf: $x) * 3].
- self vResizing ~~ #spaceFill
- ifTrue: [vMin := self font lineGrid].
-
- hMin := hMin + (2* self borderStyle width).
- vMin := vMin + (2* self borderStyle width).
-
- self layoutInset isRectangle
- ifTrue: [
- hMin := hMin + self layoutInset left + self layoutInset right.
- vMin := vMin + self layoutInset top + self layoutInset bottom]
- ifFalse: [self layoutInset isPoint
- ifTrue: [
- hMin := hMin + (2* self layoutInset x).
- vMin := vMin + (2* self layoutInset y)]
- ifFalse: [
- hMin := hMin + (2* self layoutInset).
- vMin := vMin + (2* self layoutInset)]].
-
- self minimumExtent: hMin @ vMin.
-
- "Since we have no submorphs, we have to resize here if we want to shrink wrap."
- self hResizing == #shrinkWrap ifTrue: [self width: hMin].
- self vResizing == #shrinkWrap ifTrue: [self height: vMin].!
Item was removed:
- ----- Method: PluggableButtonMorph>>vResizing: (in category 'layout properties') -----
- vResizing: aSymbol
- "We adapt our minimum extent according to our resize behavior."
-
- self vResizing == aSymbol ifTrue: [^ self].
- super vResizing: aSymbol.
- self updateMinimumExtent.!
Item was removed:
- ----- Method: PluggableButtonMorph>>veryDeepFixupWith: (in category 'copying') -----
- veryDeepFixupWith: deepCopier
- "If fields were weakly copied, fix them here. If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"
-
- super veryDeepFixupWith: deepCopier.
- model := deepCopier references at: model ifAbsent: [model].
- !
Item was removed:
- ----- Method: PluggableButtonMorph>>veryDeepInner: (in category 'copying') -----
- veryDeepInner: deepCopier
- "Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment."
-
- super veryDeepInner: deepCopier.
- "model := model. Weakly copied"
- label := label veryDeepCopyWith: deepCopier.
- "getStateSelector := getStateSelector. a Symbol"
- "actionSelector := actionSelector. a Symbol"
- "getLabelSelector := getLabelSelector. a Symbol"
- "getMenuSelector := getMenuSelector. a Symbol"
- shortcutCharacter := shortcutCharacter veryDeepCopyWith: deepCopier.
- askBeforeChanging := askBeforeChanging veryDeepCopyWith: deepCopier.
- triggerOnMouseDown := triggerOnMouseDown veryDeepCopyWith: deepCopier.
- offColor := offColor veryDeepCopyWith: deepCopier.
- onColor := onColor veryDeepCopyWith: deepCopier.
- feedbackColor := feedbackColor veryDeepCopyWith: deepCopier.
- hoverColor := hoverColor veryDeepCopyWith: deepCopier.
- borderColor := borderColor veryDeepCopyWith: deepCopier.
- textColor := textColor veryDeepCopyWith: deepCopier.
- labelOffset := labelOffset veryDeepCopyWith: deepCopier.
- arguments := arguments veryDeepCopyWith: deepCopier.
- argumentsProvider := argumentsProvider veryDeepCopyWith: deepCopier.
- "argumentsSelector := argumentsSelector. a Symbol"
- style := style. "a Symbol"!
Item was removed:
- ----- Method: PluggableButtonMorph>>wantsGradient (in category 'accessing') -----
- wantsGradient
- ^ wantsGradient ifNil: [self class gradientButton]!
Item was removed:
- ----- Method: PluggableButtonMorph>>wantsGradient: (in category 'accessing') -----
- wantsGradient: aBoolean
- wantsGradient := aBoolean.
- self changed.!
Item was removed:
- ----- Method: PluggableButtonMorph>>wantsRoundedCorners (in category 'rounding') -----
- wantsRoundedCorners
- "If the button is intended to invoke a menu for selection, provide a visual
- distinction by inverting the rounded corners attribute."
-
- ^ (self class roundedButtonCorners or: [super wantsRoundedCorners])
- xor: style == #menuButton!
Item was removed:
- Canvas subclass: #PluggableCanvas
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Support'!
-
- !PluggableCanvas commentStamp: '<historical>' prior: 0!
- An abstract canvas which modifies the behavior of an underlying canvas in some way. Subclasses should implement apply:, which takes a one argument block and an actual canvas to draw on. See apply: for the specific definition.!
Item was removed:
- ----- Method: PluggableCanvas>>apply: (in category 'private') -----
- apply: aBlock
- "evaluate aBlock with a canvas to do a drawing command on. See implementors for examples"!
Item was removed:
- ----- Method: PluggableCanvas>>balloonFillOval:fillStyle:borderWidth:borderColor: (in category 'canvas methods') -----
- balloonFillOval: aRectangle fillStyle: aFillStyle borderWidth: bw borderColor: bc
-
- self apply: [ :c |
- c balloonFillOval: aRectangle fillStyle: aFillStyle borderWidth: bw borderColor: bc
- ]!
Item was removed:
- ----- Method: PluggableCanvas>>balloonFillRectangle:fillStyle: (in category 'canvas methods') -----
- balloonFillRectangle: aRectangle fillStyle: aFillStyle
-
- self apply: [ :c | c balloonFillRectangle: aRectangle fillStyle: aFillStyle ]!
Item was removed:
- ----- Method: PluggableCanvas>>clipBy:during: (in category 'drawing-support') -----
- clipBy: newClipRect during: aBlock
- self apply: [ :c |
- c clipBy: newClipRect during: aBlock ]!
Item was removed:
- ----- Method: PluggableCanvas>>clipRect (in category 'accessing') -----
- clipRect
- | innerClipRect |
- self apply: [ :c |
- innerClipRect := c clipRect ].
- ^innerClipRect!
Item was removed:
- ----- Method: PluggableCanvas>>contentsOfArea:into: (in category 'accessing') -----
- contentsOfArea: aRectangle into: aForm
- self apply: [ :c |
- c contentsOfArea: aRectangle into: aForm ].
- ^aForm!
Item was removed:
- ----- Method: PluggableCanvas>>drawPolygon:color:borderWidth:borderColor: (in category 'drawing-polygons') -----
- drawPolygon: vertices color: aColor borderWidth: bw borderColor: bc
- self apply: [ :c |
- c drawPolygon: vertices color: aColor borderWidth: bw borderColor: bc ]!
Item was removed:
- ----- Method: PluggableCanvas>>drawString:from:to:in:font:color: (in category 'drawing-text') -----
- drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c
- self apply: [ :clippedCanvas |
- clippedCanvas drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c]!
Item was removed:
- ----- Method: PluggableCanvas>>extent (in category 'accessing') -----
- extent
-
- self apply: [ :c | ^c extent ].
- !
Item was removed:
- ----- Method: PluggableCanvas>>fillOval:color:borderWidth:borderColor: (in category 'drawing-ovals') -----
- fillOval: r color: c borderWidth: borderWidth borderColor: borderColor
- self apply: [ :clippedCanvas |
- clippedCanvas fillOval: r color: c borderWidth: borderWidth borderColor: borderColor ]!
Item was removed:
- ----- Method: PluggableCanvas>>fillOval:fillStyle:borderWidth:borderColor: (in category 'drawing-ovals') -----
- fillOval: aRectangle fillStyle: aFillStyle borderWidth: bw borderColor: bc
- "Fill the given oval."
- self shadowColor ifNotNil:
- [^self fillOval: aRectangle color: aFillStyle asColor borderWidth: bw borderColor: bc].
- (aFillStyle isBitmapFill and:[aFillStyle isKindOf: InfiniteForm]) ifTrue:[
- self flag: #fixThis.
- ^self fillOval: aRectangle color: aFillStyle borderWidth: bw borderColor: bc].
- (aFillStyle isSolidFill) ifTrue:[
- ^self fillOval: aRectangle color: aFillStyle asColor borderWidth: bw borderColor: bc].
- "Use a BalloonCanvas instead"
- self balloonFillOval: aRectangle fillStyle: aFillStyle borderWidth: bw borderColor: bc!
Item was removed:
- ----- Method: PluggableCanvas>>fillRectangle:fillStyle: (in category 'drawing-rectangles') -----
- fillRectangle: aRectangle fillStyle: aFillStyle
-
- | pattern |
-
- self shadowColor ifNotNil: [^self fillRectangle: aRectangle color: self shadowColor].
-
- (aFillStyle isKindOf: InfiniteForm) ifTrue: [
- ^self infiniteFillRectangle: aRectangle fillStyle: aFillStyle
- ].
-
- aFillStyle isSolidFill ifTrue:[ ^self fillRectangle: aRectangle color: aFillStyle asColor].
-
- "We have a very special case for filling with infinite forms"
- (aFillStyle isBitmapFill and:[aFillStyle origin = (0 at 0)]) ifTrue:[
- pattern := aFillStyle form.
- (aFillStyle direction = (pattern width @ 0)
- and:[aFillStyle normal = (0 at pattern height)]) ifTrue:[
- "Can use an InfiniteForm"
- ^self fillRectangle: aRectangle color: (InfiniteForm with: pattern)].
- ].
- "Use a BalloonCanvas instead"
- self balloonFillRectangle: aRectangle fillStyle: aFillStyle.
- !
Item was removed:
- ----- Method: PluggableCanvas>>flush (in category 'initialization') -----
- flush
- self apply: [ :c |
- c flush ]!
Item was removed:
- ----- Method: PluggableCanvas>>flushDisplay (in category 'other') -----
- flushDisplay
- self apply: [ :c |
- c flushDisplay ]!
Item was removed:
- ----- Method: PluggableCanvas>>forceToScreen: (in category 'other') -----
- forceToScreen: rect
-
- self apply: [ :c |
- c forceToScreen: rect ]!
Item was removed:
- ----- Method: PluggableCanvas>>frameAndFillRectangle:fillColor:borderWidth:borderColor: (in category 'drawing-rectangles') -----
- frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth borderColor: borderColor
- self apply: [ :c |
- c frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth borderColor: borderColor ]!
Item was removed:
- ----- Method: PluggableCanvas>>frameAndFillRoundRect:radius:fillStyle:borderWidth:borderColor: (in category 'drawing-rectangles') -----
- frameAndFillRoundRect: aRectangle radius: cornerRadius fillStyle: fillStyle borderWidth: bw borderColor: bc
- self apply: [ :c |
- c frameAndFillRoundRect: aRectangle radius: cornerRadius fillStyle: fillStyle borderWidth: bw borderColor: bc ]!
Item was removed:
- ----- Method: PluggableCanvas>>image:at:sourceRect:rule: (in category 'private') -----
- image: aForm at: aPoint sourceRect: sourceRect rule: rule
- self apply: [ :c |
- c image: aForm at: aPoint sourceRect: sourceRect rule: rule ]!
Item was removed:
- ----- Method: PluggableCanvas>>infiniteFillRectangle:fillStyle: (in category 'canvas methods') -----
- infiniteFillRectangle: aRectangle fillStyle: aFillStyle
-
- self apply: [ :c | c infiniteFillRectangle: aRectangle fillStyle: aFillStyle ]!
Item was removed:
- ----- Method: PluggableCanvas>>line:to:brushForm: (in category 'drawing') -----
- line: pt1 to: pt2 brushForm: brush
- self apply: [ :c |
- c line: pt1 to: pt2 brushForm: brush ]!
Item was removed:
- ----- Method: PluggableCanvas>>line:to:width:color: (in category 'drawing') -----
- line: pt1 to: pt2 width: w color: c
- self apply: [ :clippedCanvas |
- clippedCanvas line: pt1 to: pt2 width: w color: c ]!
Item was removed:
- ----- Method: PluggableCanvas>>origin (in category 'accessing') -----
- origin
-
- self apply: [ :c | ^c origin ].
- !
Item was removed:
- ----- Method: PluggableCanvas>>paintImage:at: (in category 'drawing-images') -----
- paintImage: aForm at: aPoint
- self apply: [ :c |
- c paintImage: aForm at: aPoint ]!
Item was removed:
- ----- Method: PluggableCanvas>>paintImage:at:sourceRect: (in category 'drawing-images') -----
- paintImage: aForm at: aPoint sourceRect: sourceRect
- self apply: [ :c |
- c paintImage: aForm at: aPoint sourceRect: sourceRect ]!
Item was removed:
- ----- Method: PluggableCanvas>>paragraph:bounds:color: (in category 'drawing') -----
- paragraph: paragraph bounds: bounds color: color
- self apply: [ :c |
- c paragraph: paragraph bounds: bounds color: color ]!
Item was removed:
- ----- Method: PluggableCanvas>>render: (in category 'drawing') -----
- render: anObject
- self apply: [ :c |
- c render: anObject ]!
Item was removed:
- ----- Method: PluggableCanvas>>shadowColor: (in category 'accessing') -----
- shadowColor: color
- self apply: [ :c |
- c shadowColor: color ]!
Item was removed:
- ----- Method: PluggableCanvas>>showAt:invalidRects: (in category 'canvas methods') -----
- showAt: pt invalidRects: updateRects
- self apply: [ :c |
- c showAt: pt invalidRects: updateRects ]!
Item was removed:
- ----- Method: PluggableCanvas>>stencil:at:sourceRect:color: (in category 'drawing-images') -----
- stencil: stencilForm at: aPoint sourceRect: sourceRect color: aColor
- self apply: [ :c |
- c stencil: stencilForm at: aPoint sourceRect: sourceRect color: aColor ]!
Item was removed:
- ----- Method: PluggableCanvas>>transformBy:clippingTo:during:smoothing: (in category 'drawing-support') -----
- transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize
-
- self apply: [ :clippedCanvas |
- clippedCanvas transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize ]!
Item was removed:
- ----- Method: PluggableCanvas>>translateBy:clippingTo:during: (in category 'other') -----
- translateBy: aPoint clippingTo: aRect during: aBlock
- self apply: [ :clippedCanvas |
- clippedCanvas translateBy: aPoint clippingTo: aRect during: aBlock ]!
Item was removed:
- ----- Method: PluggableCanvas>>translateBy:during: (in category 'drawing-support') -----
- translateBy: delta during: aBlock
- self apply: [ :clippedCanvas |
- clippedCanvas translateBy: delta during: aBlock ]!
Item was removed:
- Object subclass: #PluggableEventFilter
- instanceVariableNames: 'filterBlock'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!
Item was removed:
- ----- Method: PluggableEventFilter class>>on: (in category 'instance creation') -----
- on: filterBlock
-
- ^ self new filterBlock: filterBlock!
Item was removed:
- ----- Method: PluggableEventFilter>>filterBlock (in category 'accessing') -----
- filterBlock
-
- ^ filterBlock!
Item was removed:
- ----- Method: PluggableEventFilter>>filterBlock: (in category 'accessing') -----
- filterBlock: anObject
-
- filterBlock := anObject!
Item was removed:
- ----- Method: PluggableEventFilter>>filterEvent:for: (in category 'events-filtering') -----
- filterEvent: event for: target
-
- ^ self filterBlock
- ifNil: [event]
- ifNotNil: [:b | b cull: event cull: target]!
Item was removed:
- ----- Method: PluggableFileList>>morphicOpenLabel:in: (in category '*Morphic-FileList') -----
- morphicOpenLabel: aString in: aWorld
- "Open a view of an instance of me."
- "PluggableFileList new morphicOpenLabel: 'foo' in: World"
- | windowMorph volListMorph templateMorph fileListMorph leftButtonMorph middleButtonMorph rightButtonMorph |
-
- self directory: directory.
- windowMorph := (SystemWindow labelled: aString) model: self.
-
- volListMorph := PluggableListMorph on: self
- list: #volumeList
- selected: #volumeListIndex
- changeSelected: #volumeListIndex:
- menu: #volumeMenu:.
- volListMorph autoDeselect: false.
- windowMorph addMorph: volListMorph frame: (0 at 0 corner: 0.4 at 0.5625).
-
- templateMorph := PluggableTextMorph on: self
- text: #pattern
- accept: #pattern:.
- templateMorph askBeforeDiscardingEdits: false.
- windowMorph addMorph: templateMorph frame: (0 at 0.5625 corner: 0.4 at 0.75).
-
- fileListMorph := PluggableListMorph on: self
- list: #fileList
- selected: #fileListIndex
- changeSelected: #fileListIndex:
- menu: #fileListMenu:.
-
- windowMorph addMorph: fileListMorph frame: (0.4 at 0 corner: 1.0 at 0.75).
-
- leftButtonMorph := PluggableButtonMorph
- on: self
- getState: #leftButtonState
- action: #leftButtonPressed.
- leftButtonMorph
- hResizing: #spaceFill;
- vResizing: #spaceFill;
- label: 'Cancel';
- onColor: Color red offColor: Color red;
- feedbackColor: Color orange;
- borderWidth: 3.
-
- middleButtonMorph := PluggableButtonMorph
- on: self
- getState: nil
- action: nil.
- middleButtonMorph
- hResizing: #spaceFill;
- vResizing: #spaceFill;
- label: prompt;
- onColor: Color lightYellow offColor: Color lightYellow;
- feedbackColor: Color lightYellow;
- borderWidth: 1.
-
- rightButtonMorph := PluggableButtonMorph
- on: self
- getState: #rightButtonState
- action: #rightButtonPressed.
- rightButtonMorph
- hResizing: #spaceFill;
- vResizing: #spaceFill;
- label: 'Accept';
- onColor: Color green offColor: Color lightYellow;
- feedbackColor: Color black;
- borderWidth: (self canAccept ifTrue: [3] ifFalse: [1]).
- "self canAccept ifFalse: [rightButtonMorph controller: NoController new]."
-
- windowMorph
- addMorph: leftButtonMorph frame: (0 at 0.75 corner: 0.25 at 1.0);
- addMorph: middleButtonMorph frame: (0.25 at 0.75 corner: 0.75 at 1.0);
- addMorph: rightButtonMorph frame: (0.75 at 0.75 corner: 1.0 at 1.0).
-
- self changed: #getSelectionSel.
-
- windowMorph openInWorld: aWorld.
- [windowMorph model notNil]
- whileTrue: [aWorld doOneCycle].
- ^self result
- !
Item was removed:
- ListItemWrapper subclass: #PluggableListItemWrapper
- instanceVariableNames: 'string getContentsSelector getStringSelector hasContentsSelector'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Explorer'!
-
- !PluggableListItemWrapper commentStamp: 'pre 5/15/2017 21:08' prior: 0!
- PluggableListItemWrapper makes it more easy for clients to use hierarchical lists. Rather than having to write a subclass of ListItemWrapper, a PluggableListItemWrapper can be used to provide the appropriate information straight from the model:
- string - an explicit string representation (contrary to the 'item' which contains any kind of object)
- getStringSelector - a message invoked to retrieve the sting representation of its item dynamically from its model (when a constant representation is undesirable)
- hasContentsSelector - a message invoked in the model to answer whether the item has any children or not.
- getContentsSelector - a message invoked in the model to retrieve the contents for its item.
-
- All callback selectors can have zero, one or two arguments with the item and the wrapper as first and second argument.!
Item was removed:
- ----- Method: PluggableListItemWrapper>>asString (in category 'accessing') -----
- asString
- string ifNotNil:[^string].
- getStringSelector ifNil:[^super asString].
- ^self sendToModel: getStringSelector
- !
Item was removed:
- ----- Method: PluggableListItemWrapper>>contents (in category 'accessing') -----
- contents
- getContentsSelector ifNil:[^#()].
- ^self sendToModel: getContentsSelector.!
Item was removed:
- ----- Method: PluggableListItemWrapper>>getContentsSelector (in category 'accessing') -----
- getContentsSelector
- ^getContentsSelector!
Item was removed:
- ----- Method: PluggableListItemWrapper>>getContentsSelector: (in category 'accessing') -----
- getContentsSelector: aSymbol
- self validateSelector: aSymbol.
- getContentsSelector := aSymbol.!
Item was removed:
- ----- Method: PluggableListItemWrapper>>getStringSelector (in category 'accessing') -----
- getStringSelector
- ^getStringSelector!
Item was removed:
- ----- Method: PluggableListItemWrapper>>getStringSelector: (in category 'accessing') -----
- getStringSelector: aSymbol
- self validateSelector: aSymbol.
- getStringSelector := aSymbol.!
Item was removed:
- ----- Method: PluggableListItemWrapper>>hasContents (in category 'accessing') -----
- hasContents
- hasContentsSelector ifNil:[^super hasContents].
- ^self sendToModel: hasContentsSelector
- !
Item was removed:
- ----- Method: PluggableListItemWrapper>>hasContentsSelector (in category 'accessing') -----
- hasContentsSelector
- ^hasContentsSelector!
Item was removed:
- ----- Method: PluggableListItemWrapper>>hasContentsSelector: (in category 'accessing') -----
- hasContentsSelector: aSymbol
- self validateSelector: aSymbol.
- hasContentsSelector := aSymbol.!
Item was removed:
- ----- Method: PluggableListItemWrapper>>printOn: (in category 'printing') -----
- printOn: aStream
- super printOn: aStream.
- aStream nextPut:$(; nextPutAll: self asString; nextPut:$).!
Item was removed:
- ----- Method: PluggableListItemWrapper>>sendToModel: (in category 'private') -----
- sendToModel: aSelector
- aSelector numArgs = 0
- ifTrue:[^model perform: aSelector].
- aSelector numArgs = 1
- ifTrue:[^model perform: aSelector with: item].
- aSelector numArgs = 2
- ifTrue:[^model perform: aSelector with: item with: self].!
Item was removed:
- ----- Method: PluggableListItemWrapper>>string (in category 'accessing') -----
- string
- ^string!
Item was removed:
- ----- Method: PluggableListItemWrapper>>string: (in category 'accessing') -----
- string: aString
- string := aString!
Item was removed:
- ----- Method: PluggableListItemWrapper>>validateSelector: (in category 'private') -----
- validateSelector: aSymbol
- (aSymbol numArgs between: 0 and: 2) ifFalse:[^self error: 'Invalid pluggable selector'].!
Item was removed:
- ScrollPane subclass: #PluggableListMorph
- instanceVariableNames: 'list fullList modelToView viewToModel getListSelector getListSizeSelector getListElementSelector getIndexSelector setIndexSelector keystrokeActionSelector autoDeselect lastKeystrokeTime lastKeystrokes lastClickTime doubleClickSelector handlesBasicKeys potentialDropRow hoverRow listMorph keystrokePreviewSelector priorSelection getIconSelector getHelpSelector'
- classVariableNames: 'ClearFilterAutomatically ClearFilterDelay FilterableLists FlashOnErrors HighlightHoveredRow HighlightPreSelection MenuRequestUpdatesSelection'
- poolDictionaries: ''
- category: 'Morphic-Pluggable Widgets'!
-
- !PluggableListMorph commentStamp: 'mt 10/12/2019 11:04' prior: 0!
- I am a list widget that uses the change/update mechanism to display model data as a vertical arrangement of (maybe formatted) strings and icons in a scroll pane.
-
- When I am in keyboard focus, type in a letter (or several letters quickly) to go to the next item that begins with that letter. If you enabled the "filterable lists" preference, I will hide all items that do not match the filter.
-
- Special keys (arrow up/down, page up/down, home, end) are also supported.!
Item was removed:
- ----- Method: PluggableListMorph class>>clearFilterAutomatically (in category 'preferences') -----
- clearFilterAutomatically
- <preference: 'Filterable Lists Clear Automatically'
- category: 'scrolling'
- description: 'When using the Filterable Lists option, if this option is also selected, then the filter will be cleared as soon as the list loses keyboard focus.'
- type: #Boolean>
- ^ ClearFilterAutomatically ifNil: [ true ]!
Item was removed:
- ----- Method: PluggableListMorph class>>clearFilterAutomatically: (in category 'preferences') -----
- clearFilterAutomatically: aBoolean
- ClearFilterAutomatically := aBoolean!
Item was removed:
- ----- Method: PluggableListMorph class>>clearFilterDelay (in category 'preferences') -----
- clearFilterDelay
- <preference: 'Filterable Lists Clear Delay'
- category: 'scrolling'
- description: 'Defines the maximum delay (in milliseconds) between keystrokes before the filter expression is cleared again.'
- type: #Number>
-
- ^ ClearFilterDelay ifNil: [500]!
Item was removed:
- ----- Method: PluggableListMorph class>>clearFilterDelay: (in category 'preferences') -----
- clearFilterDelay: aNumber
-
- ClearFilterDelay := aNumber.!
Item was removed:
- ----- Method: PluggableListMorph class>>filterableLists (in category 'preferences') -----
- filterableLists
- <preference: 'Filterable Lists'
- category: 'scrolling'
- description: 'When true, using the keyboard on a list will filter it rather than scroll. Pressing enter clears the filter and keeps the filtered selection. Backspace clears the filter and returns to the prior selection.'
- type: #Boolean>
- ^ FilterableLists ifNil: [ true ]!
Item was removed:
- ----- Method: PluggableListMorph class>>filterableLists: (in category 'preferences') -----
- filterableLists: aBoolean
- "When true, using the keyboard on a list will filter it rather than scroll. Pressing enter clears the filter and keeps the filtered selection. Backspace clears the filter and returns to the prior selection."
- FilterableLists := aBoolean!
Item was removed:
- ----- Method: PluggableListMorph class>>flashOnErrors (in category 'preferences') -----
- flashOnErrors
-
- <preference: 'Flash on Errors in Lists'
- category: #Morphic
- description: 'If a user request cannot be fulfilled as expected, flash briefly to inform the user about it. While this can improve user feedback, it adds a small delay because of an explicit world refresh.'
- type: #Boolean>
-
- ^ FlashOnErrors ifNil: [false]!
Item was removed:
- ----- Method: PluggableListMorph class>>flashOnErrors: (in category 'preferences') -----
- flashOnErrors: aBoolean
-
- FlashOnErrors := aBoolean.!
Item was removed:
- ----- Method: PluggableListMorph class>>highlightHoveredRow (in category 'preferences') -----
- highlightHoveredRow
-
- <preference: 'Highlight Hovered Row in Lists'
- category: #Morphic
- description: 'Indicate which row will be affected before any further interaction takes place.'
- type: #Boolean>
- ^ HighlightHoveredRow ifNil: [true]!
Item was removed:
- ----- Method: PluggableListMorph class>>highlightHoveredRow: (in category 'preferences') -----
- highlightHoveredRow: aBoolean
-
- HighlightHoveredRow := aBoolean.!
Item was removed:
- ----- Method: PluggableListMorph class>>highlightPreSelection (in category 'preferences') -----
- highlightPreSelection
-
- <preference: 'Highlight Pre-Selection in Lists'
- category: #Morphic
- description: 'Indicate the attempt to change the selection in models like after a click or key press. If model updates can take long, such indication can improve user feedback. However, this adds a small delay because of an explicit world refresh.'
- type: #Boolean>
-
- ^ HighlightPreSelection ifNil: [false]!
Item was removed:
- ----- Method: PluggableListMorph class>>highlightPreSelection: (in category 'preferences') -----
- highlightPreSelection: aBoolean
-
- HighlightPreSelection := aBoolean.!
Item was removed:
- ----- Method: PluggableListMorph class>>listMargins (in category 'defaults') -----
- listMargins
-
- ^(3 * RealEstateAgent scaleFactor) truncated @0 corner: 0 at 0!
Item was removed:
- ----- Method: PluggableListMorph class>>menuRequestUpdatesSelection (in category 'preferences') -----
- menuRequestUpdatesSelection
-
- <preference: 'Menu request updates list/tree selection'
- category: #Morphic
- description: 'When invoking a menu, the action is applied to the current selection in the list. If the mouse cursor it at a different location, however, this preference will update the selection before showing the menu if enabled.'
- type: #Boolean>
- ^ MenuRequestUpdatesSelection ifNil: [ false ]!
Item was removed:
- ----- Method: PluggableListMorph class>>menuRequestUpdatesSelection: (in category 'preferences') -----
- menuRequestUpdatesSelection: aBoolean
-
- MenuRequestUpdatesSelection := aBoolean.!
Item was removed:
- ----- Method: PluggableListMorph class>>on:list:selected:changeSelected: (in category 'instance creation') -----
- on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel
- "Create a 'pluggable' list view on the given model parameterized by the given message selectors."
-
- ^ self new
- on: anObject
- list: getListSel
- selected: getSelectionSel
- changeSelected: setSelectionSel
- menu: nil
- keystroke: #arrowKey:from: "default"!
Item was removed:
- ----- Method: PluggableListMorph class>>on:list:selected:changeSelected:menu: (in category 'instance creation') -----
- on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel
- "Create a 'pluggable' list view on the given model parameterized by the given message selectors."
-
- ^ self new
- on: anObject
- list: getListSel
- selected: getSelectionSel
- changeSelected: setSelectionSel
- menu: getMenuSel
- keystroke: #arrowKey:from: "default"
- !
Item was removed:
- ----- Method: PluggableListMorph class>>on:list:selected:changeSelected:menu:keystroke: (in category 'instance creation') -----
- on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel
- "Create a 'pluggable' list view on the given model parameterized by the given message selectors."
-
- ^ self new
- on: anObject
- list: getListSel
- selected: getSelectionSel
- changeSelected: setSelectionSel
- menu: getMenuSel
- keystroke: keyActionSel
- !
Item was removed:
- ----- Method: PluggableListMorph class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ super themeProperties, {
- { #font. 'Fonts'. 'Font of the list items.' }.
- { #textColor. 'Colors'. 'Color of the list items.' }.
- { #selectionColor. 'Colors'. 'Color used for items when hovering or selecting them.' }.
- { #multiSelectionColor. 'Colors'. 'Colors used for items that are selected among others.'}.
- { #selectionTextColor. 'Colors'. 'Color used for label when hovering or selecting them.' }.
- { #filterColor. 'Colors'. 'Color used for items to indicate the matching filter.' }.
- { #filterTextColor. 'Colors'. 'Color used for items to indicate the matching filter.' }.
-
- { #preSelectionModifier. 'Colors'. 'How to derive the pre-selection color from the selection color.'}.
- { #hoverSelectionModifier. 'Colors'. 'How to derive the hover color from the selection color.'}.
- }!
Item was removed:
- ----- Method: PluggableListMorph>>acceptDroppingMorph:event: (in category 'drag and drop') -----
- acceptDroppingMorph: aMorph event: evt
- "This message is sent when a morph is dropped onto a morph that has
- agreed to accept the dropped morph by responding 'true' to the
- wantsDroppedMorph:Event: message. The default implementation just
- adds the given morph to the receiver."
- "Here we let the model do its work."
-
- self model
- acceptDroppingMorph: aMorph
- event: evt
- inMorph: self.
- self resetPotentialDropRow.
- evt hand releaseMouseFocus: self.
- Cursor normal show.
- !
Item was removed:
- ----- Method: PluggableListMorph>>addCustomMenuItems:hand: (in category 'menus') -----
- addCustomMenuItems: aMenu hand: aHandMorph
- "Add halo menu items to be handled by the invoking hand. The halo menu is invoked by clicking on the menu-handle of the receiver's halo."
-
- super addCustomMenuItems: aMenu hand: aHandMorph.
- aMenu addLine.
- aMenu add: 'list font...' translated target: self action: #setListFont.
- aMenu add: 'copy list to clipboard' translated target: self action: #copyListToClipboard.
- aMenu add: 'copy selection to clipboard' translated target: self action: #copySelectionToClipboard!
Item was removed:
- ----- Method: PluggableListMorph>>allSubmorphNamesDo: (in category 'submorphs - accessing') -----
- allSubmorphNamesDo: nameBlock
- "Assume list morphs do not have named parts -- saves MUCH time"
-
- ^ self!
Item was removed:
- ----- Method: PluggableListMorph>>allowEmptyFilterResult (in category 'filtering') -----
- allowEmptyFilterResult
- ^ self valueOfProperty: #allowEmptyFilterResult ifAbsent: [false]!
Item was removed:
- ----- Method: PluggableListMorph>>allowEmptyFilterResult: (in category 'filtering') -----
- allowEmptyFilterResult: aBoolean
-
- self
- setProperty: #allowEmptyFilterResult
- toValue: aBoolean.!
Item was removed:
- ----- Method: PluggableListMorph>>applyUserInterfaceTheme (in category 'updating') -----
- applyUserInterfaceTheme
-
- super applyUserInterfaceTheme.
- self listMorph listChanged.!
Item was removed:
- ----- Method: PluggableListMorph>>autoDeselect: (in category 'initialization') -----
- autoDeselect: trueOrFalse
- "Enable/disable autoDeselect (see class comment)"
- autoDeselect := trueOrFalse.!
Item was removed:
- ----- Method: PluggableListMorph>>balloonText (in category 'accessing') -----
- balloonText
- "Overridden to send selector to model and not self. Do not use #perform:orSendTo: because super does more than just the send.."
-
- self getHelpSelector ifNotNil: [:selector |
- (self model respondsTo: selector) ifTrue: [
- | modelIndex |
- (modelIndex := self modelIndexFor: self hoverRow) > 0 ifTrue: [
- ^ self model perform: selector with: modelIndex]]].
-
- ^ super balloonText!
Item was removed:
- ----- Method: PluggableListMorph>>basicKeyPressed: (in category 'model access - keystroke') -----
- basicKeyPressed: aChar
-
- self listFilterAppend: aChar.!
Item was removed:
- ----- Method: PluggableListMorph>>bottomVisibleRowIndex (in category 'accessing - items') -----
- bottomVisibleRowIndex
- ^ self rowAtLocation: self scroller bottomLeft - (0 at 1)!
Item was removed:
- ----- Method: PluggableListMorph>>browseImplementationOfGetListSelector (in category 'debug and other') -----
- browseImplementationOfGetListSelector
-
- | method |
- method := model class lookupSelector: getListSelector.
- ToolSet browse: method methodClass selector: method selector.!
Item was removed:
- ----- Method: PluggableListMorph>>buildDebugMenu: (in category 'debug and other') -----
- buildDebugMenu: aHandMorph
-
- | aMenu |
- aMenu := super buildDebugMenu: aHandMorph.
- aMenu addLine.
- aMenu add: 'browse get-list code' translated target: self action: #browseImplementationOfGetListSelector.
- aMenu add: 'debug get-list invocation' translated target: self action: #debugGetList.
- ^ aMenu!
Item was removed:
- ----- Method: PluggableListMorph>>canBeEncroached (in category 'testing') -----
- canBeEncroached
- "Answer whether my bottom edge can be encroached by horizontal smart-splitter. If my list is larger than my outermost containing window, go ahead and report true since moving a splitter will never allow my entire list to be displayed. In that case go ahead and be encroachable to allow lower truncated text-panes to be exposed, but leave a reasonable height (70) to ensure at least few items are displayed."
- ^ self height > 24 and:
- [ | outermostContainer |
- outermostContainer := self outermostMorphThat:
- [ : e | e owner = self world ].
- listMorph height + 8 < self height or:
- [ outermostContainer notNil and: [ listMorph height > (outermostContainer height / 1.2) and: [ self height > 70 ] ] ] ]!
Item was removed:
- ----- Method: PluggableListMorph>>canHaveIcons (in category 'list morph callbacks') -----
- canHaveIcons
-
- ^ getIconSelector notNil!
Item was removed:
- ----- Method: PluggableListMorph>>changeModelSelection: (in category 'model access') -----
- changeModelSelection: aModelIndex
- " Change the model's selected item index to be aModelIndex. Optionally, do a pre-selection highlight, which requires an immediate re-draw of this widget."
-
- self class highlightPreSelection ifTrue: [
- self rowAboutToBecomeSelected: (self viewIndexFor: aModelIndex).
- self refreshWorld].
- setIndexSelector ifNotNil: [
- model perform: setIndexSelector with: aModelIndex ].!
Item was removed:
- ----- Method: PluggableListMorph>>charactersOccluded (in category 'geometry') -----
- charactersOccluded
- "Answer the number of characters occluded in my #visibleList by my right edge."
- | listIndex | listIndex:=0.
- ^ self visibleList
- inject: 0
- into:
- [ : sum : each | | eachString totalWidth indexOfLastVisible iconWidth |
- totalWidth:=0.
- eachString := each asString "withBlanksTrimmed".
- iconWidth := (self iconAt: (listIndex := listIndex+1)) ifNil:[0] ifNotNil: [ : icon | icon width+2 ].
- indexOfLastVisible := ((1 to: eachString size)
- detect:
- [ : stringIndex | (totalWidth:=totalWidth+(self font widthOf: (eachString at: stringIndex))) >
- (self width -
- (scrollBar
- ifNil: [ 0 ]
- ifNotNil: [ scrollBar width ]) - iconWidth) ]
- ifNone: [ eachString size + 1 ]) - 1.
- sum + ((eachString size - indexOfLastVisible) min: 10) ]!
Item was removed:
- ----- Method: PluggableListMorph>>clearFilterAutomatically (in category 'accessing') -----
- clearFilterAutomatically
-
- ^ (self valueOfProperty: #clearFilterAutomatically ifAbsent: [true]) and: [self class clearFilterAutomatically]!
Item was removed:
- ----- Method: PluggableListMorph>>clearFilterAutomatically: (in category 'accessing') -----
- clearFilterAutomatically: aBoolean
- self setProperty: #clearFilterAutomatically toValue: aBoolean.!
Item was removed:
- ----- Method: PluggableListMorph>>commandKeyTypedIntoMenu: (in category 'model access') -----
- commandKeyTypedIntoMenu: evt
- "The user typed a command-key into a menu which has me as its command-key handler"
-
- ^ self modifierKeyPressed: evt keyCharacter!
Item was removed:
- ----- Method: PluggableListMorph>>copyListToClipboard (in category 'menus') -----
- copyListToClipboard
- "Copy my items to the clipboard as a multi-line string"
-
- Clipboard clipboardText: (
- String streamContents: [:stream |
- 1 to: self listSize do: [:viewIndex |
- stream nextPutAll: (self itemAt: viewIndex) asString; cr]]).!
Item was removed:
- ----- Method: PluggableListMorph>>copySelectionToClipboard (in category 'menus') -----
- copySelectionToClipboard
- "Copy my selected item to the clipboard as a string"
-
- self selection
- ifNotNil:
- [Clipboard clipboardText: self selection asString]
- ifNil:
- [self flash]!
Item was removed:
- ----- Method: PluggableListMorph>>createListMorph (in category 'initialization') -----
- createListMorph
-
- ^ self listMorphClass new
- listSource: self;
- cellInset: self class listMargins;
- hResizing: #spaceFill;
- vResizing: #shrinkWrap;
- cellPositioning: #leftCenter;
- setProperty: #indicateKeyboardFocus toValue: #never;
- yourself.!
Item was removed:
- ----- Method: PluggableListMorph>>debugGetList (in category 'debug and other') -----
- debugGetList
-
- (Process
- forBlock: [model perform: getListSelector]
- runUntil: [:context | context selector = getListSelector])
- debugWithTitle: ('Debug get-list invocation in model "{1}"' translated format: {model printString}).!
Item was removed:
- ----- Method: PluggableListMorph>>displayScaleChangedBy: (in category 'display scale') -----
- displayScaleChangedBy: factor
-
- | currentMargins |
- super displayScaleChangedBy: factor.
- (currentMargins := self listMorph cellInset) isRectangle
- ifTrue: [self listMorph cellInset: ((currentMargins origin * factor) rounded corner: (currentMargins corner * factor) rounded)]
- ifFalse: [self listMorph cellInset: (currentMargins * factor) rounded].!
Item was removed:
- ----- Method: PluggableListMorph>>doubleClick: (in category 'event handling') -----
- doubleClick: event
- | index |
- doubleClickSelector ifNil: [^super doubleClick: event].
- index := self rowAtLocation: event position.
- index = 0 ifTrue: [^super doubleClick: event].
- "selectedMorph ifNil: [self setSelectedMorph: aMorph]."
- ^ self model perform: doubleClickSelector!
Item was removed:
- ----- Method: PluggableListMorph>>doubleClickSelector (in category 'accessing - selectors') -----
- doubleClickSelector
- ^ doubleClickSelector!
Item was removed:
- ----- Method: PluggableListMorph>>doubleClickSelector: (in category 'accessing - selectors') -----
- doubleClickSelector: aSymbol
- doubleClickSelector := aSymbol!
Item was removed:
- ----- Method: PluggableListMorph>>filterList:matching: (in category 'filtering') -----
- filterList: someItems matching: aPattern
- "Filter someStrings according to aPattern. Prepend best matches in the result. Update the model-to-view map."
-
- | frontMatching substringMatching tmp |
- aPattern ifEmpty: [ ^ someItems ].
- someItems ifEmpty: [ ^ someItems ].
-
- frontMatching := OrderedCollection new.
- substringMatching := OrderedCollection new.
-
- self assert: modelToView isEmpty.
- self assert: viewToModel isEmpty.
- tmp := OrderedCollection new.
-
- someItems withIndexDo:
- [ :each :n | | foundPos |
- foundPos := self filterListItem: each matching: aPattern.
- foundPos = 1
- ifTrue:
- [ frontMatching add: each.
- modelToView at: n put: frontMatching size.
- viewToModel at: frontMatching size put: n ]
- ifFalse:
- [ foundPos > 1 ifTrue:
- [ substringMatching add: each.
- tmp add: n; add: substringMatching size ] ] ].
-
- tmp pairsDo: [:modelIndex :viewIndex |
- modelToView at: modelIndex put: viewIndex + frontMatching size.
- viewToModel at: viewIndex + frontMatching size put: modelIndex].
-
- ^ frontMatching, substringMatching!
Item was removed:
- ----- Method: PluggableListMorph>>filterListItem:matching: (in category 'filtering') -----
- filterListItem: anObject matching: aPattern
-
- ^ anObject asString
- findString: aPattern
- startingAt: 1
- caseSensitive: false!
Item was removed:
- ----- Method: PluggableListMorph>>filterTerm (in category 'filtering') -----
- filterTerm
- ^ lastKeystrokes ifNil: ['']!
Item was removed:
- ----- Method: PluggableListMorph>>filterTerm: (in category 'filtering') -----
- filterTerm: aString
-
- lastKeystrokes = aString ifTrue: [^ self].
- lastKeystrokes := aString.
- self updateListFilter.!
Item was removed:
- ----- Method: PluggableListMorph>>filterableList (in category 'accessing') -----
- filterableList
- ^ (self valueOfProperty: #filterableList ifAbsent: [false]) or: [self class filterableLists]!
Item was removed:
- ----- Method: PluggableListMorph>>filterableList: (in category 'accessing') -----
- filterableList: aBoolean
- self setProperty: #filterableList toValue: aBoolean.!
Item was removed:
- ----- Method: PluggableListMorph>>flash (in category 'drawing') -----
- flash
-
- self class flashOnErrors ifTrue: [super flash].!
Item was removed:
- ----- Method: PluggableListMorph>>font (in category 'initialization') -----
- font
-
- ^ self listMorph font
- !
Item was removed:
- ----- Method: PluggableListMorph>>font: (in category 'initialization') -----
- font: aFontOrNil
-
- self listMorph font: aFontOrNil.
-
- self minimumWidth: (self font widthOf: $m) * 5.
- !
Item was removed:
- ----- Method: PluggableListMorph>>fullListSize (in category 'list morph callbacks') -----
- fullListSize
- "Number of items in the unfiltered list."
-
- ^ self getFullList size!
Item was removed:
- ----- Method: PluggableListMorph>>getCurrentSelectionIndex (in category 'model access') -----
- getCurrentSelectionIndex
- "Answer the index of the current selection."
-
- getIndexSelector ifNil: [^0].
- ^model perform: getIndexSelector!
Item was removed:
- ----- Method: PluggableListMorph>>getFilteredList (in category 'model access - cached') -----
- getFilteredList
- "Apply the current filter to the list. Maybe shorten the filter term if there are no matches."
-
- | fullList filteredList |
- fullList := self getFullList.
-
- self hasFilter ifFalse: [^ fullList].
- fullList ifEmpty: [^ fullList].
-
- filteredList := self filterList: fullList matching: lastKeystrokes.
-
- (filteredList isEmpty not or: [ self allowEmptyFilterResult ])
- ifFalse:
- [ "Remove the last character and try filtering again."
- lastKeystrokes := lastKeystrokes allButLast: 1.
- ^ self
- flash;
- getFilteredList ].
-
- ^ filteredList!
Item was removed:
- ----- Method: PluggableListMorph>>getFullList (in category 'model access - cached') -----
- getFullList
- "The full, unfiltered list. Cached result, see #updateList. Prefer getListSelector over getListElementSelector if both a set."
-
- ^ fullList ifNil: [
- fullList := getListSelector
- ifNotNil: [:sel | model perform: sel]
- ifNil: [(getListSizeSelector notNil and: [getListElementSelector notNil])
- ifTrue: [ (1 to: self getListSize) collect: [:index | self getListItem: index]]
- ifFalse: [#() "We cannot get the full list."]].
- fullList ifNil: [Error signal: 'The model must never provide ''nil'' as a list but only a collection.'].
- fullList]!
Item was removed:
- ----- Method: PluggableListMorph>>getHelpSelector (in category 'accessing - selectors') -----
- getHelpSelector
-
- ^ getHelpSelector!
Item was removed:
- ----- Method: PluggableListMorph>>getHelpSelector: (in category 'accessing - selectors') -----
- getHelpSelector: aSelector
- "Get help for list entries."
-
- getHelpSelector := aSelector.!
Item was removed:
- ----- Method: PluggableListMorph>>getIconSelector (in category 'accessing - selectors') -----
- getIconSelector
- ^ getIconSelector!
Item was removed:
- ----- Method: PluggableListMorph>>getIconSelector: (in category 'accessing - selectors') -----
- getIconSelector: aSymbol
- getIconSelector := aSymbol!
Item was removed:
- ----- Method: PluggableListMorph>>getList (in category 'model access - cached') -----
- getList
- "Answer the (maybe filtered) list to be displayed. Cached result, see #updateList."
-
- ^ list ifNil: [
- list := #(). "To make this call safe when re-entering it while fetching the list. This can happen, for example, when the model fetches data that opens the system progress bar which then will redraw periodically."
- list := self filterableList
- ifTrue: [self getFilteredList]
- ifFalse: [self getFullList].
- self updateListMorph.
- list]!
Item was removed:
- ----- Method: PluggableListMorph>>getListElementSelector (in category 'accessing - selectors') -----
- getListElementSelector
- "specify a selector that can be used to obtain a single element in the underlying list"
- ^ getListElementSelector!
Item was removed:
- ----- Method: PluggableListMorph>>getListElementSelector: (in category 'accessing - selectors') -----
- getListElementSelector: aSymbol
- "specify a selector that can be used to obtain a single element in the underlying list"
-
- getListElementSelector = aSymbol ifTrue: [^self].
- getListElementSelector := aSymbol.
- self updateList.!
Item was removed:
- ----- Method: PluggableListMorph>>getListItem: (in category 'model access') -----
- getListItem: modelIndex
-
- ^ getListElementSelector
- ifNotNil: [:sel | model perform: sel with: modelIndex ]
- ifNil: [self getFullList at: modelIndex]!
Item was removed:
- ----- Method: PluggableListMorph>>getListSelector (in category 'accessing - selectors') -----
- getListSelector
- ^ getListSelector!
Item was removed:
- ----- Method: PluggableListMorph>>getListSelector: (in category 'accessing - selectors') -----
- getListSelector: aSymbol
- "Set the receiver's getListSelector as indicated, and trigger a recomputation of the list"
-
- getListSelector = aSymbol ifTrue: [^ self].
- getListSelector := aSymbol.
- self updateList.!
Item was removed:
- ----- Method: PluggableListMorph>>getListSize (in category 'model access') -----
- getListSize
- "return the current number of items in the displayed list"
-
- ^ getListSizeSelector
- ifNotNil: [:sel | model perform: sel]
- ifNil: [self fullListSize]!
Item was removed:
- ----- Method: PluggableListMorph>>getListSizeSelector (in category 'accessing - selectors') -----
- getListSizeSelector
- ^ getListSizeSelector!
Item was removed:
- ----- Method: PluggableListMorph>>getListSizeSelector: (in category 'accessing - selectors') -----
- getListSizeSelector: aSymbol
- "specify a selector that can be used to specify the list's size"
-
- getListSizeSelector = aSymbol ifTrue: [^ self].
- getListSizeSelector := aSymbol.
- self updateList.!
Item was removed:
- ----- Method: PluggableListMorph>>getMenu: (in category 'menu') -----
- getMenu: shiftKeyState
- "Answer the menu for this text view, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key."
-
- | aMenu |
- aMenu := super getMenu: shiftKeyState.
- aMenu ifNotNil: [aMenu commandKeyHandler: self].
- ^ aMenu!
Item was removed:
- ----- Method: PluggableListMorph>>hScrollBarPolicy: (in category 'accessing') -----
- hScrollBarPolicy: aSymbol
- "The lazy list morph will never wrap its rows if they do not fit. Instead, they are just clipped. So, #spaceFill is fine if the horizontal scroll bar should never be visible."
-
- self checkScrollBarPolicy: aSymbol.
-
- aSymbol ~= #never
- ifTrue: [self listMorph hResizing: #shrinkWrap]
- ifFalse: [self listMorph hResizing: #spaceFill].
-
- ^ super hScrollBarPolicy: aSymbol!
Item was removed:
- ----- Method: PluggableListMorph>>handleMouseMove: (in category 'events-processing') -----
- handleMouseMove: anEvent
- "Overwritten to update the #hoverRow. Note that we could also overwrite #wantsEveryMouseMove and update #hoverRow in #mouseMove:. The #potentialDropRow is currently only updated via #mouseEnterDragging:, which is reused via #mouseMove:. In #mouseLeave: and #mouseLeaveDragging:, the #hoverRow is reset, and so is #potentialDropRow. In sum, #hoverRow affects both dragging and pointing operations while #potentialDropRow only affects dragging. And dragging means that a mouse button should be pressed, or there won't be any calls to #mouseMove:. See #handlesMouseMove: in super. Design to be improved."
-
- anEvent wasHandled ifFalse: [self hoverRow: (self rowAtLocation: anEvent position)].
- super handleMouseMove: anEvent.!
Item was removed:
- ----- Method: PluggableListMorph>>handlesBasicKeys (in category 'accessing') -----
- handlesBasicKeys
- " if ya don't want the list to automatically handle non-modifier key
- (excluding shift key) input, return false"
- ^ handlesBasicKeys ifNil: [ true ]!
Item was removed:
- ----- Method: PluggableListMorph>>handlesBasicKeys: (in category 'accessing') -----
- handlesBasicKeys: aBoolean
- "set whether the list morph should handle basic keys like arrow keys, or whether everything should be passed to the model"
- handlesBasicKeys := aBoolean!
Item was removed:
- ----- Method: PluggableListMorph>>handlesMouseMove: (in category 'event handling') -----
- handlesMouseMove: anEvent
- ^ anEvent anyButtonPressed and: [anEvent hand mouseFocus == self]!
Item was removed:
- ----- Method: PluggableListMorph>>handlesMouseOverDragging: (in category 'event handling') -----
- handlesMouseOverDragging: evt
- ^self dropEnabled!
Item was removed:
- ----- Method: PluggableListMorph>>hasFilter (in category 'filtering') -----
- hasFilter
- ^ self filterTerm notEmpty!
Item was removed:
- ----- Method: PluggableListMorph>>hasMultiSelection (in category 'list morph callbacks') -----
- hasMultiSelection
-
- ^ false!
Item was removed:
- ----- Method: PluggableListMorph>>highlightSelection (in category 'drawing') -----
- highlightSelection!
Item was removed:
- ----- Method: PluggableListMorph>>highlightSelector (in category 'accessing - selectors') -----
- highlightSelector
- ^self valueOfProperty: #highlightSelector!
Item was removed:
- ----- Method: PluggableListMorph>>highlightSelector: (in category 'accessing - selectors') -----
- highlightSelector: aSelector
-
- self highlightSelector = aSelector ifTrue: [^ self].
- self setProperty: #highlightSelector toValue: aSelector.!
Item was removed:
- ----- Method: PluggableListMorph>>hoverItem (in category 'accessing - items') -----
- hoverItem
-
- ^ self hoverRow = 0
- ifTrue: [nil]
- ifFalse: [self itemAt: self hoverRow]!
Item was removed:
- ----- Method: PluggableListMorph>>hoverRow (in category 'accessing') -----
- hoverRow
-
- ^ hoverRow ifNil: [0]!
Item was removed:
- ----- Method: PluggableListMorph>>hoverRow: (in category 'accessing') -----
- hoverRow: viewIndex
-
- hoverRow = viewIndex ifTrue: [^ self].
-
- self listMorph rowChanged: hoverRow with: viewIndex.
- hoverRow := viewIndex.
-
- self wantsBalloon ifTrue: [
- self activeHand
- removePendingBalloonFor: self;
- triggerBalloonFor: self after: self balloonHelpDelayTime].!
Item was removed:
- ----- Method: PluggableListMorph>>iconAt: (in category 'list morph callbacks') -----
- iconAt: viewIndex
-
- ^ getIconSelector ifNotNil: [model perform: getIconSelector with: (self modelIndexFor: viewIndex)]!
Item was removed:
- ----- Method: PluggableListMorph>>iconAt:column: (in category 'list morph callbacks') -----
- iconAt: viewIndex column: columnIndex
-
- ^ self iconAt: viewIndex!
Item was removed:
- ----- Method: PluggableListMorph>>indicateFiltered (in category 'filtering') -----
- indicateFiltered
- "Don't need this pink background anymore, since now the current filter is highlighted in every matching substring entry in the list."
- "self color: Color red muchLighter muchLighter"!
Item was removed:
- ----- Method: PluggableListMorph>>indicateUnfiltered (in category 'filtering') -----
- indicateUnfiltered
- !
Item was removed:
- ----- Method: PluggableListMorph>>initForKeystrokes (in category 'initialization') -----
- initForKeystrokes
- lastKeystrokeTime := 0.
- lastKeystrokes := ''!
Item was removed:
- ----- Method: PluggableListMorph>>initialize (in category 'initialization') -----
- initialize
- listMorph := self createListMorph.
- super initialize.
- self scroller
- layoutPolicy: TableLayout new;
- addMorph: listMorph.
- self
- minimumWidth: (self font widthOf: $m) * 5 ;
- minimumHeight: self font height
-
- !
Item was removed:
- ----- Method: PluggableListMorph>>installModelIn: (in category 'debug and other') -----
- installModelIn: aWorld
- "No special inits for new components"
- ^ self!
Item was removed:
- ----- Method: PluggableListMorph>>isPluggableListMorph (in category 'drawing') -----
- isPluggableListMorph
- ^ true!
Item was removed:
- ----- Method: PluggableListMorph>>itemAt: (in category 'list morph callbacks') -----
- itemAt: viewIndex
- "Callback from list morph."
-
- ^ self getList at: viewIndex!
Item was removed:
- ----- Method: PluggableListMorph>>itemAt:column: (in category 'list morph callbacks') -----
- itemAt: viewIndex column: columnIndex
-
- ^ self itemAt: viewIndex!
Item was removed:
- ----- Method: PluggableListMorph>>itemFromPoint: (in category 'accessing - items') -----
- itemFromPoint: aPoint
- "Return the list element (morph) at the given point or nil if outside"
- | ptY |
- scroller hasSubmorphs ifFalse:[^nil].
- (scroller fullBounds containsPoint: aPoint) ifFalse:[^nil].
- ptY := (scroller firstSubmorph point: aPoint from: self) y.
- "note: following assumes that submorphs are vertical, non-overlapping, and ordered"
- scroller firstSubmorph top > ptY ifTrue:[^nil].
- scroller lastSubmorph bottom < ptY ifTrue:[^nil].
- "now use binary search"
- ^scroller
- findSubmorphBinary:[:item|
- (item top <= ptY and:[item bottom >= ptY])
- ifTrue:[0] "found"
- ifFalse:[ (item top + item bottom // 2) > ptY ifTrue:[-1] ifFalse:[1]]]!
Item was removed:
- ----- Method: PluggableListMorph>>itemSelectedAmongMultiple: (in category 'list morph callbacks') -----
- itemSelectedAmongMultiple: viewIndex
- "return whether the index-th row is selected. Always false in PluggableListMorph, but sometimes true in PluggableListMorphOfMany"
- ^false!
Item was removed:
- ----- Method: PluggableListMorph>>keyStroke: (in category 'event handling') -----
- keyStroke: event
- "Process keys
- The model is allowed to preview all keystrokes. If it's not interested:
- specialKeys are things like up, down, etc. ALWAYS HANDLED
- modifierKeys are regular characters either 1) accompanied with ctrl,
- cmd or 2) any character if the list doesn't want to handle basic
- keys (handlesBasicKeys returns false)
- basicKeys are any characters"
-
- | aChar aSpecialKey |
- (self previewKeystroke: event)
- ifTrue: [^ self].
-
- aChar := event keyCharacter.
-
- (aSpecialKey := aChar asciiValue) < 32
- ifTrue: [^ self specialKeyPressed: aSpecialKey].
-
- (event anyModifierKeyPressed or: [self handlesBasicKeys not])
- ifTrue: [^ self modifierKeyPressed: aChar].
-
- ^ self basicKeyPressed: aChar!
Item was removed:
- ----- Method: PluggableListMorph>>keyboardFocusChange: (in category 'event handling') -----
- keyboardFocusChange: aBoolean
- "Clear the hover effect and maybe the current list filter if we lose keyboard focus."
-
- aBoolean ifFalse:
- [self hoverRow: nil.
- self clearFilterAutomatically ifTrue:
- [self removeFilter]].
-
- super keyboardFocusChange: aBoolean.!
Item was removed:
- ----- Method: PluggableListMorph>>keystrokeActionSelector (in category 'accessing - selectors') -----
- keystrokeActionSelector
- ^ keystrokeActionSelector!
Item was removed:
- ----- Method: PluggableListMorph>>keystrokeActionSelector: (in category 'accessing - selectors') -----
- keystrokeActionSelector: keyActionSel
- "Set the keystroke action selector as specified"
-
- keystrokeActionSelector := keyActionSel!
Item was removed:
- ----- Method: PluggableListMorph>>keystrokePreviewSelector (in category 'accessing - selectors') -----
- keystrokePreviewSelector
- ^ keystrokePreviewSelector!
Item was removed:
- ----- Method: PluggableListMorph>>keystrokePreviewSelector: (in category 'accessing - selectors') -----
- keystrokePreviewSelector: sel
- "The method on the model that will be given first view of any keystroke events. For access via scripting"
-
- keystrokePreviewSelector := sel!
Item was removed:
- ----- Method: PluggableListMorph>>listFilterAppend: (in category 'filtering') -----
- listFilterAppend: aChar
- "Update the list filter or change selection to match the current filter expression. The given character will be appended to the current filter term."
-
- | milliseconds slowKeyStroke newModelIndex oldModelIndex |
- model okToChange ifFalse: [ ^ self ].
-
- newModelIndex := oldModelIndex := self getCurrentSelectionIndex.
- milliseconds := Time millisecondClockValue.
- slowKeyStroke := (Time
- milliseconds: milliseconds
- since: lastKeystrokeTime) > self class clearFilterDelay.
- slowKeyStroke := slowKeyStroke or:
- "For unfiltered lists, ff the users hits the same key repeatedly, support navigation regardless of the configured delay, as quickly as they want."
- [ self filterableList not and: [ lastKeystrokes size = 1 and: [ lastKeystrokes first = aChar ] ] ] .
- lastKeystrokeTime := milliseconds.
-
- "1) Record the key press."
- slowKeyStroke
- ifTrue:
- [ "Fresh filter expression *and* filterable lists? Keep track of that for escaping the filter."
- (self filterableList and: [self hasFilter not]) ifTrue:
- [ priorSelection := self modelIndexFor: self selectionIndex ].
- "Forget previous keystrokes and search in following elements."
- lastKeystrokes := aChar asLowercase asString.
- self filterableList ifFalse:
- [ newModelIndex := self modelIndexFor: ((self nextSelectionIndexFrom: self selectionIndex) max: 1) ] ]
- ifFalse:
- [ "Append quick keystrokes but don't move selection if it still matches."
- lastKeystrokes := lastKeystrokes , aChar asLowercase asString.
- self filterableList ifFalse:
- [ newModelIndex := self modelIndexFor: ((self nextSelectionIndexFrom: self selectionIndex-1) max: 1) ] ].
-
- self filterableList ifTrue:
- [ self updateListFilter.
- newModelIndex := self modelIndexFor: 1 ].
-
- (self hasFilter and: [(self getCurrentSelectionIndex = newModelIndex) not]) ifTrue:
- [ self changeModelSelection: newModelIndex ].!
Item was removed:
- ----- Method: PluggableListMorph>>listFilterSet: (in category 'filtering') -----
- listFilterSet: aString
- "Set the filter term and select the first match."
-
- self filterTerm: aString.
- self changeModelSelection: (self listSize = 0 ifTrue: [0] ifFalse: [self modelIndexFor: 1]).!
Item was removed:
- ----- Method: PluggableListMorph>>listMorph (in category 'accessing') -----
- listMorph
-
- ^ listMorph!
Item was removed:
- ----- Method: PluggableListMorph>>listMorphClass (in category 'private') -----
- listMorphClass
- ^LazyListMorph!
Item was removed:
- ----- Method: PluggableListMorph>>listSize (in category 'list morph callbacks') -----
- listSize
- "Number of items in the (filtered) list."
-
- ^ self getList size!
Item was removed:
- ----- Method: PluggableListMorph>>maximumSelection (in category 'selection') -----
- maximumSelection
- "Return the highest ui index that can be selected."
-
- ^ self listSize!
Item was removed:
- ----- Method: PluggableListMorph>>minimumSelection (in category 'selection') -----
- minimumSelection
- ^ 1!
Item was removed:
- ----- Method: PluggableListMorph>>modelIndexFor: (in category 'filtering') -----
- modelIndexFor: selectionIndex
- "The model does not know anything about the receiver's filtering. So if I am filtered, we must determine the correct index by scanning the full list in the model -- or use the lookup cache."
-
- self hasFilter ifFalse: [^ selectionIndex]. "No lookup needed."
- self filterableList ifFalse: [^ selectionIndex]. "No lookup needed."
- selectionIndex = 0 ifTrue: [^ 0]. "Nothing selected."
-
- ^ viewToModel at: selectionIndex ifAbsent: [0]!
Item was removed:
- ----- Method: PluggableListMorph>>modifierKeyPressed: (in category 'model access - keystroke') -----
- modifierKeyPressed: aChar
-
- keystrokeActionSelector ifNil: [^ self].
-
- model
- perform: keystrokeActionSelector
- withEnoughArguments: {
- aChar.
- self}.!
Item was removed:
- ----- Method: PluggableListMorph>>mouseDown: (in category 'event handling') -----
- mouseDown: evt
- | selectors row |
- row := self rowAtLocation: evt position.
-
- evt yellowButtonPressed "First check for option (menu) click"
- ifTrue: [
- ((self selectionIndex ~= row
- and: [self class menuRequestUpdatesSelection])
- and: [model okToChange]) ifTrue: [
- "Models depend on the correct selection:"
- self changeModelSelection: (self modelIndexFor: row)].
-
- ^ self yellowButtonActivity: evt shiftPressed].
- row = 0 ifTrue: [^super mouseDown: evt].
- "self dragEnabled ifTrue: [aMorph highlightForMouseDown]."
- selectors := Array
- with: #click:
- with: (doubleClickSelector ifNotNil:[#doubleClick:])
- with: nil
- with: (self dragEnabled ifTrue:[#startDrag:] ifFalse:[nil]).
- evt hand waitForClicksOrDrag: self event: evt selectors: selectors threshold: HandMorph dragThreshold "pixels".!
Item was removed:
- ----- Method: PluggableListMorph>>mouseEnter: (in category 'event handling') -----
- mouseEnter: event
-
- super mouseEnter: event.
- Preferences mouseOverForKeyboardFocus
- ifTrue: [event hand newKeyboardFocus: self].!
Item was removed:
- ----- Method: PluggableListMorph>>mouseEnterDragging: (in category 'event handling') -----
- mouseEnterDragging: evt
-
- (evt hand hasSubmorphs and:[self dropEnabled]) ifFalse: ["no d&d"
- ^super mouseEnterDragging: evt].
-
- (self wantsDroppedMorph: evt hand firstSubmorph event: evt )
- ifTrue:[
- potentialDropRow := self rowAtLocation: evt position.
- evt hand newMouseFocus: self.
- self changed.
- "above is ugly but necessary for now"
- ].
- !
Item was removed:
- ----- Method: PluggableListMorph>>mouseLeave: (in category 'event handling') -----
- mouseLeave: event
-
- super mouseLeave: event.
- self hoverRow: nil.
- self resetPotentialDropRow.
-
- Preferences mouseOverForKeyboardFocus
- ifTrue: [event hand releaseKeyboardFocus: self].!
Item was removed:
- ----- Method: PluggableListMorph>>mouseLeaveDragging: (in category 'events') -----
- mouseLeaveDragging: anEvent
-
- self hoverRow: nil.
- anEvent hand releaseMouseFocus: self.
- (self dropEnabled and:[anEvent hand hasSubmorphs]) ifFalse: ["no d&d"
- ^ super mouseLeaveDragging: anEvent].
- self resetPotentialDropRow.
- "above is ugly but necessary for now"
- !
Item was removed:
- ----- Method: PluggableListMorph>>mouseMove: (in category 'event handling') -----
- mouseMove: evt
-
- (self dropEnabled and:[evt hand hasSubmorphs])
- ifFalse:[^super mouseMove: evt].
- potentialDropRow ifNotNil:[
- potentialDropRow = (self rowAtLocation: evt position)
- ifTrue:[^self].
- ].
- self mouseLeaveDragging: evt.
- (self containsPoint: evt position)
- ifTrue:[self mouseEnterDragging: evt].!
Item was removed:
- ----- Method: PluggableListMorph>>mouseUp: (in category 'event handling') -----
- mouseUp: event
-
- | row |
- model okToChange ifFalse: [^ self].
- (self containsPoint: event position) ifFalse: [^ self].
-
- row := self rowAtLocation: event position.
- row = self selectionIndex
- ifTrue: [(autoDeselect ifNil: [true]) ifTrue: [row = 0 ifFalse: [self changeModelSelection: 0] ]]
- ifFalse: [self changeModelSelection: (self modelIndexFor: row)].
-
- event hand newKeyboardFocus: self.
- hasFocus := true.
- Cursor normal show.!
Item was removed:
- ----- Method: PluggableListMorph>>nextSelectionIndexFrom: (in category 'filtering') -----
- nextSelectionIndexFrom: start
- "Return the next selection index that matches the current filter term."
-
- | newViewIndex oldViewIndex startIndex |
- oldViewIndex := newViewIndex := start \\ (self listSize max: 1) + 1.
- startIndex := newViewIndex.
-
- [ (self itemAt: newViewIndex) asString withBlanksTrimmed asLowercase
- beginsWith: lastKeystrokes ] whileFalse:
- [ (newViewIndex := newViewIndex \\ (self listSize max: 1) + 1) = startIndex ifTrue:
- [ self flash. ^ 0 "Not in list." ] ].
-
- oldViewIndex = newViewIndex ifTrue: [ self flash ].
-
- ^ newViewIndex!
Item was removed:
- ----- Method: PluggableListMorph>>numSelectionsInView (in category 'scrolling') -----
- numSelectionsInView
- "Overwritten to map submorphCount to the (filtered) list size. There is only one submorph: the lazy list morph."
-
- ^ scroller numberOfItemsPotentiallyInViewWith: self listSize!
Item was removed:
- ----- Method: PluggableListMorph>>offsetToShow: (in category 'scrolling') -----
- offsetToShow: aRectangle
- "Due to the approximation of the horizontal scroll range and the primary interaction along the vertical axis, we snap back to 0 on the horizontal axis."
-
- ^ 0 @ (super offsetToShow: aRectangle) y!
Item was removed:
- ----- Method: PluggableListMorph>>on:list:selected:changeSelected:menu:keystroke: (in category 'initialization') -----
- on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel
-
- self model: anObject.
-
- getListSelector := getListSel.
- getIndexSelector := getSelectionSel.
- setIndexSelector := setSelectionSel.
- getMenuSelector := getMenuSel.
- keystrokeActionSelector := keyActionSel.
-
- autoDeselect := true.
-
- self updateList.
- self updateListSelection.
-
- self initForKeystrokes.!
Item was removed:
- ----- Method: PluggableListMorph>>potentialDropItem (in category 'drag and drop') -----
- potentialDropItem
- "return the item that the most recent drop hovered over, or nil if there is no potential drop target"
- self potentialDropRow = 0 ifTrue: [ ^self ].
- ^self itemAt: self potentialDropRow!
Item was removed:
- ----- Method: PluggableListMorph>>potentialDropRow (in category 'drag and drop') -----
- potentialDropRow
- "return the row of the item that the most recent drop hovered over, or 0 if there is no potential drop target"
- ^potentialDropRow ifNil: [ 0 ].
- !
Item was removed:
- ----- Method: PluggableListMorph>>previewKeystroke: (in category 'model access - keystroke') -----
- previewKeystroke: keystrokeEvent
- "Let the model decide if it's going to handle the event for us"
-
- keystrokePreviewSelector ifNil: [^ false].
-
- ^ model
- perform: keystrokePreviewSelector
- withEnoughArguments: {
- keystrokeEvent.
- self}!
Item was removed:
- ----- Method: PluggableListMorph>>removeFilter (in category 'filtering') -----
- removeFilter
-
- self filterTerm: String empty.!
Item was removed:
- ----- Method: PluggableListMorph>>resetPotentialDropRow (in category 'drag and drop') -----
- resetPotentialDropRow
- potentialDropRow ifNotNil: [
- potentialDropRow ~= 0 ifTrue: [
- potentialDropRow := 0.
- self changed. ] ]!
Item was removed:
- ----- Method: PluggableListMorph>>rowAboutToBecomeSelected: (in category 'selection') -----
- rowAboutToBecomeSelected: anInteger
-
- self listMorph preSelectedRow: anInteger!
Item was removed:
- ----- Method: PluggableListMorph>>rowAtLocation: (in category 'accessing - items') -----
- rowAtLocation: aPoint
- "Return the row at the given point or 0 if outside"
- | pointInListMorphCoords |
- pointInListMorphCoords := (self scroller transformFrom: self) transform: aPoint.
- ^self listMorph rowAtLocation: pointInListMorphCoords.!
Item was removed:
- ----- Method: PluggableListMorph>>scrollDeltaHeight (in category 'geometry') -----
- scrollDeltaHeight
- "Return the increment in pixels which this pane should be scrolled."
- ^ self font height!
Item was removed:
- ----- Method: PluggableListMorph>>scrollDeltaWidth (in category 'geometry') -----
- scrollDeltaWidth
- "A guess -- assume that the width of a char is approx 1/2 the height of the font"
- ^ self scrollDeltaHeight // 2
-
- !
Item was removed:
- ----- Method: PluggableListMorph>>scrollSelectionIntoView (in category 'selection') -----
- scrollSelectionIntoView
- "make sure that the current selection is visible"
-
- | row |
- (row := self selectionIndex) = 0
- ifFalse: [self scrollToShow: (self listMorph drawBoundsForRow: row)]!
Item was removed:
- ----- Method: PluggableListMorph>>selectedMorph (in category 'selection') -----
- selectedMorph
- "this doesn't work with the LargeLists patch!! Use #selectionIndex and #selection instead."
- ^self scroller submorphs at: self selectionIndex!
Item was removed:
- ----- Method: PluggableListMorph>>selectedMorph: (in category 'selection') -----
- selectedMorph: aMorph
- "this shouldn't be used any longer. Only sent by implemetations of #list: such as PluggableListMorph, SimpleHierarchicalListMorph etc"
-
- self isThisEverCalled .
- true ifTrue: [^self]!
Item was removed:
- ----- Method: PluggableListMorph>>selection (in category 'selection') -----
- selection
-
- ^ self getList
- at: self selectionIndex
- ifAbsent: [nil]!
Item was removed:
- ----- Method: PluggableListMorph>>selection: (in category 'selection') -----
- selection: item
- "Called from outside to request setting a new selection."
-
- self selectionIndex: (self getList indexOf: item)!
Item was removed:
- ----- Method: PluggableListMorph>>selectionIndex (in category 'selection') -----
- selectionIndex
- "return the index we have currently selected, or 0 if none"
- ^self listMorph selectedRow ifNil: [ 0 ]!
Item was removed:
- ----- Method: PluggableListMorph>>selectionIndex: (in category 'selection') -----
- selectionIndex: viewIndex
- "Called internally to select the index-th item."
-
- self selectionIndex = viewIndex ifTrue: [^ self].
-
- self unhighlightSelection.
- self listMorph selectedRow: (viewIndex min: self listSize).
- self highlightSelection.
-
- self scrollSelectionIntoView.!
Item was removed:
- ----- Method: PluggableListMorph>>setDefaultParameters (in category 'initialization') -----
- setDefaultParameters
-
- super setDefaultParameters.
-
- self
- font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]);
- textColor: (self userInterfaceTheme textColor ifNil: [Color black]).
-
- self setListParameters.!
Item was removed:
- ----- Method: PluggableListMorph>>setListFont (in category 'menus') -----
- setListFont
- "set the font for the list"
-
- Preferences
- chooseFontWithPrompt: 'Choose the font for this list' translated
- andSendTo: self
- withSelector: #font:
- highlightSelector: #font!
Item was removed:
- ----- Method: PluggableListMorph>>setListParameters (in category 'initialization') -----
- setListParameters
-
- self listMorph
- selectionColor: (self userInterfaceTheme selectionColor ifNil: [Color r: 0.72 g: 0.72 b: 0.9]);
- multiSelectionColor: (self userInterfaceTheme multiSelectionColor ifNil: [(Color r: 0.72 g: 0.72 b: 0.9) lighter]);
- setProperty: #selectionTextColor
- toValue: (self userInterfaceTheme selectionTextColor ifNil: [Color black]);
- filterColor: (self userInterfaceTheme filterColor ifNil: [Color yellow paler]);
- setProperty: #filterTextColor
- toValue: (self userInterfaceTheme filterTextColor ifNil: [Color black]);
-
- setProperty: #preSelectionColor
- toValue: ((self userInterfaceTheme preSelectionModifier ifNil: [ [:c | Color gray: 0.9] ]) value: self listMorph selectionColor asColor);
- setProperty: #hoverColor
- toValue: ((self userInterfaceTheme hoverSelectionModifier ifNil: [ [:c | c darker alpha: 0.3] ]) value: self listMorph selectionColor asColor)!
Item was removed:
- ----- Method: PluggableListMorph>>setSelectedMorph: (in category 'selection') -----
- setSelectedMorph: aMorph
- self changeModelSelection: (self modelIndexFor: (scroller submorphs indexOf: aMorph))!
Item was removed:
- ----- Method: PluggableListMorph>>specialKeyPressed: (in category 'model access - keystroke') -----
- specialKeyPressed: asciiValue
- "A special key with the given ascii-value was pressed; dispatch it"
- | oldSelection nextSelection max howManyItemsShowing |
- (#(8 13) includes: asciiValue) ifTrue:
- [ "backspace key - clear the filter, restore the list with the selection"
- model okToChange ifFalse: [^ self].
- self removeFilter.
- priorSelection ifNotNil:
- [ | prior |
- prior := priorSelection.
- priorSelection := self getCurrentSelectionIndex.
- asciiValue = 8 ifTrue: [ self changeModelSelection: prior ] ].
- ^ self ].
- asciiValue = 27 ifTrue:
- [" escape key"
- ^ self currentEvent shiftPressed
- ifTrue:
- [self currentWorld putUpWorldMenuFromEscapeKey]
- ifFalse:
- [self yellowButtonActivity: false]].
-
- max := self maximumSelection.
- max > 0 ifFalse: [^ self].
- nextSelection := oldSelection := self selectionIndex.
- asciiValue = 31 ifTrue:
- [" down arrow"
- nextSelection := oldSelection + 1.
- nextSelection > max ifTrue: [nextSelection := 1]].
- asciiValue = 30 ifTrue:
- [" up arrow"
- nextSelection := oldSelection - 1.
- nextSelection < 1 ifTrue: [nextSelection := max]].
- asciiValue = 1 ifTrue:
- [" home"
- nextSelection := 1].
- asciiValue = 4 ifTrue:
- [" end"
- nextSelection := max].
- howManyItemsShowing := self numSelectionsInView.
- asciiValue = 11 ifTrue:
- [" page up"
- nextSelection := 1 max: oldSelection - howManyItemsShowing].
- asciiValue = 12 ifTrue:
- [" page down"
- nextSelection := oldSelection + howManyItemsShowing min: max].
- model okToChange ifFalse: [^ self].
- "No change if model is locked"
- oldSelection = nextSelection ifTrue: [^ self flash].
- ^ self changeModelSelection: (self modelIndexFor: nextSelection)!
Item was removed:
- ----- Method: PluggableListMorph>>startDrag: (in category 'drag and drop') -----
- startDrag: evt
-
- | item itemMorph |
- evt hand hasSubmorphs ifTrue: [^ self].
- self model okToChange ifFalse: [^ self].
-
- "Ensure selection to save additional click."
- (self rowAtLocation: evt position) in: [:clickedRow |
- self selectionIndex = clickedRow
- ifFalse: [self changeModelSelection: (self modelIndexFor: clickedRow)]].
-
- item := self selection ifNil: [^ self].
- itemMorph := StringMorph contents: item asStringOrText.
-
- [ "Initiate drag."
- (self model dragPassengerFor: itemMorph inMorph: self) ifNotNil: [:passenger | | ddm |
- ddm := (self valueOfProperty: #dragTransferClass ifAbsent: [TransferMorph]) withPassenger: passenger from: self.
- ddm dragTransferType: (self model dragTransferTypeForMorph: self).
- ddm updateFromUserInputEvent: evt.
- self model dragStartedFor: itemMorph transferMorph: ddm.
- evt hand grabMorph: ddm.
- self mouseEnterDragging: evt "Enable internal move"]
- ] ensure: [Cursor normal show].!
Item was removed:
- ----- Method: PluggableListMorph>>textColor (in category 'initialization') -----
- textColor
- "Answer my default text color."
- ^self valueOfProperty: #textColor ifAbsent: [ Color black ]
- !
Item was removed:
- ----- Method: PluggableListMorph>>textColor: (in category 'initialization') -----
- textColor: aColor
- "Set my default text color."
- self setProperty: #textColor toValue: aColor.
- self listMorph color: aColor.!
Item was removed:
- ----- Method: PluggableListMorph>>topVisibleRowIndex (in category 'accessing - items') -----
- topVisibleRowIndex
- ^ self rowAtLocation: self scroller topLeft!
Item was removed:
- ----- Method: PluggableListMorph>>unhighlightSelection (in category 'drawing') -----
- unhighlightSelection
- !
Item was removed:
- ----- Method: PluggableListMorph>>update: (in category 'updating') -----
- update: aSymbol
-
- aSymbol == getListSelector ifTrue: [^ self updateList].
- aSymbol == getIndexSelector ifTrue: [^ self updateListSelection].
-
- "The following selectors are rarely used."
- aSymbol == getListSizeSelector ifTrue: [^ self updateList].
- aSymbol == getListElementSelector ifTrue: [^ self updateList].!
Item was removed:
- ----- Method: PluggableListMorph>>update:with: (in category 'updating') -----
- update: aSymbol with: arg1
-
- (aSymbol == #inputRequested and: [getIndexSelector == arg1 or: [setIndexSelector == arg1]])
- ifTrue: [self activeHand newKeyboardFocus: self].
-
- super update: aSymbol with: arg1.!
Item was removed:
- ----- Method: PluggableListMorph>>updateList (in category 'updating') -----
- updateList
-
- self updateList: nil.!
Item was removed:
- ----- Method: PluggableListMorph>>updateList: (in category 'updating') -----
- updateList: modelList
- "Keeps the current filter as it is."
-
- fullList := modelList.
- self updateListFilter.!
Item was removed:
- ----- Method: PluggableListMorph>>updateListFilter (in category 'updating') -----
- updateListFilter
-
- | selection |
- selection := self selectionIndex = 0 "Avoid fetching #getList here."
- ifTrue: [nil]
- ifFalse: [self selection].
-
- list := nil.
- modelToView := Dictionary new.
- viewToModel := Dictionary new.
-
- self getList.
-
- "Try to restore the last selection."
- selection ifNotNil: [self selection: selection].!
Item was removed:
- ----- Method: PluggableListMorph>>updateListMorph (in category 'updating') -----
- updateListMorph
- "Tell my list morph that the data has changed. This is an extra hook for subclasses."
-
- self listMorph listChanged.!
Item was removed:
- ----- Method: PluggableListMorph>>updateListSelection (in category 'updating') -----
- updateListSelection
-
- self updateListSelection: self getCurrentSelectionIndex.!
Item was removed:
- ----- Method: PluggableListMorph>>updateListSelection: (in category 'updating') -----
- updateListSelection: modelIndex
- "Model changed the selection. Invalidate the filtered list if the selection index cannot be found."
-
- | viewIndex |
- modelIndex = 0 ifTrue: [
- ^ self selectionIndex: 0].
-
- "The the model is inconsistent. Cannot fix here."
- modelIndex > self fullListSize ifTrue: [
- ^ self selectionIndex: 0].
-
- "Lookup the view index."
- viewIndex := self viewIndexFor: modelIndex.
-
- "The filter is preventing us from selecting the item we want - remove it."
- viewIndex = 0 ifTrue: [
- self removeFilter.
- viewIndex := modelIndex].
-
- self selectionIndex: viewIndex.!
Item was removed:
- ----- Method: PluggableListMorph>>userString (in category 'debug and other') -----
- userString
- "Do I have a text string to be searched on?"
-
- ^ String streamContents: [:strm |
- self getFullList do: [:item |
- "must use asStringOrText because that's what the drawing uses, too"
- strm nextPutAll: item asStringOrText; cr]]!
Item was removed:
- ----- Method: PluggableListMorph>>verifyContents (in category 'updating') -----
- verifyContents
- "Verify the contents of the receiver, reconstituting if necessary. Called whenever window is reactivated, to react to possible structural changes. Also called periodically in morphic if the smartUpdating preference is true"
-
- | currentList modelList modelIndex |
- self flag: #performance. "mt: We do have changed/update. Why can't the tools communicate through an appropriate notifier such as the SystemChangeNotifier?"
-
- "1) Is the list still up to date?"
- currentList := fullList. fullList := nil.
- modelList := self getFullList.
- modelList = currentList
- ifFalse: [self updateList: modelList].
-
- "2) Is the selection still up to date?"
- modelIndex := self getCurrentSelectionIndex.
- (self modelIndexFor: self selectionIndex) = modelIndex
- ifFalse: [self updateListSelection: modelIndex].!
Item was removed:
- ----- Method: PluggableListMorph>>viewIndexFor: (in category 'filtering') -----
- viewIndexFor: modelIndex
- "The model does not know anything about the receiver's filtering. So if I am filtered, we must determine the correct index by scanning the filtered list in the view -- or use the lookup cache."
-
- self hasFilter ifFalse: [^ modelIndex]. "No lookup needed."
- self filterableList ifFalse: [^ modelIndex]. "No lookup needed."
- modelIndex = 0 ifTrue: [^ 0]. "Nothing selected."
-
- ^ modelToView at: modelIndex ifAbsent: [0]!
Item was removed:
- ----- Method: PluggableListMorph>>visibleList (in category 'accessing') -----
- visibleList
- "For convenience. Avoid accessing #getList directly. Just use the same protocol that my #listMorph uses."
-
- ^ self listSize = 0
- ifTrue: [ Array empty ]
- ifFalse:
- [ (self topVisibleRowIndex to: self bottomVisibleRowIndex) collect:
- [ :viewIndex |
- self itemAt: viewIndex ] ].!
Item was removed:
- ----- Method: PluggableListMorph>>wantsDroppedMorph:event: (in category 'drag and drop') -----
- wantsDroppedMorph: aMorph event: anEvent
- ^ self model wantsDroppedMorph: aMorph event: anEvent inMorph: self!
Item was removed:
- PluggableListMorph subclass: #PluggableListMorphByItem
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Pluggable Widgets'!
-
- !PluggableListMorphByItem commentStamp: 'mt 10/12/2019 12:25' prior: 0!
- Like PluggableListMorph but maps #setIndexSelector and #getIndexSelector to actual items instead of indexes.!
Item was removed:
- ----- Method: PluggableListMorphByItem>>changeModelSelection: (in category 'model access') -----
- changeModelSelection: anInteger
- "Change the model's selected item to be the one at the given index."
-
- setIndexSelector ifNotNil: [
- model
- perform: setIndexSelector
- with: (self getFullList at: anInteger ifAbsent: [nil])].!
Item was removed:
- ----- Method: PluggableListMorphByItem>>getCurrentSelectionIndex (in category 'model access') -----
- getCurrentSelectionIndex
- "Answer the index of the current selection."
-
- ^ getIndexSelector
- ifNil: [0]
- ifNotNil: [self getFullList indexOf: (model perform: getIndexSelector)]!
Item was removed:
- PluggableListMorph subclass: #PluggableListMorphOfMany
- instanceVariableNames: 'dragOnOrOff getSelectionListSelector setSelectionListSelector'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Pluggable Widgets'!
-
- !PluggableListMorphOfMany commentStamp: 'hpt 4/5/2004 11:21' prior: 0!
- A variant of its superclass that allows multiple items to be selected simultaneously. There is still a distinguished element which is selected, but each other element in the list may be flagged on or off.
- !
Item was removed:
- ----- Method: PluggableListMorphOfMany class>>on:list:primarySelection:changePrimarySelection:listSelection:changeListSelection:menu: (in category 'instance creation') -----
- on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel
- ^ self new
- on: anObject
- list: listSel
- primarySelection: getSelectionSel
- changePrimarySelection: setSelectionSel
- listSelection: getListSel
- changeListSelection: setListSel
- menu: getMenuSel
- keystroke: #arrowKey:from: "default"!
Item was removed:
- ----- Method: PluggableListMorphOfMany class>>on:list:primarySelection:changePrimarySelection:listSelection:changeListSelection:menu:keystroke: (in category 'instance creation') -----
- on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel keystroke: keyActionSel
- ^ self new
- on: anObject
- list: listSel
- primarySelection: getSelectionSel
- changePrimarySelection: setSelectionSel
- listSelection: getListSel
- changeListSelection: setListSel
- menu: getMenuSel
- keystroke: keyActionSel!
Item was removed:
- ----- Method: PluggableListMorphOfMany>>basicKeyPressed: (in category 'model access') -----
- basicKeyPressed: aCharacter
- "Maps [space] key to be a special key."
-
- aCharacter = Character space
- ifTrue: [self specialKeyPressed: aCharacter asciiValue]
- ifFalse: [super basicKeyPressed: aCharacter].!
Item was removed:
- ----- Method: PluggableListMorphOfMany>>hasMultiSelection (in category 'testing') -----
- hasMultiSelection
-
- ^ true!
Item was removed:
- ----- Method: PluggableListMorphOfMany>>itemSelectedAmongMultiple: (in category 'model access') -----
- itemSelectedAmongMultiple: viewIndex
- ^self listSelectionAt: (self modelIndexFor: viewIndex)!
Item was removed:
- ----- Method: PluggableListMorphOfMany>>listSelectionAt: (in category 'model access') -----
- listSelectionAt: index
- getSelectionListSelector ifNil:[^false].
- ^model perform: getSelectionListSelector with: index!
Item was removed:
- ----- Method: PluggableListMorphOfMany>>listSelectionAt:put: (in category 'model access') -----
- listSelectionAt: index put: value
- setSelectionListSelector ifNil:[^false].
- ^model perform: setSelectionListSelector with: index with: value!
Item was removed:
- ----- Method: PluggableListMorphOfMany>>mouseDown: (in category 'event handling') -----
- mouseDown: event
- | row index |
- event yellowButtonPressed ifTrue: [^ self yellowButtonActivity: event shiftPressed].
- row := self rowAtLocation: event position.
-
- row = 0 ifTrue: [^super mouseDown: event].
- index := self modelIndexFor: row.
-
- model okToChange ifFalse: [^ self]. "No change if model is locked"
-
- self changeModelSelection: index.
-
- "Set meaning for subsequent dragging of selection"
- self
- listSelectionAt: index
- put: (dragOnOrOff := (self listSelectionAt: index) not)
- !
Item was removed:
- ----- Method: PluggableListMorphOfMany>>mouseMove: (in category 'event handling') -----
- mouseMove: event
- "The mouse has moved, as characterized by the event provided. Adjust the scrollbar, and alter the selection as appropriate"
-
- | row index |
- event position y < self top
- ifTrue:
- [scrollBar scrollUp: 1.
- row := self rowAtLocation: scroller topLeft + (1 @ 1)]
- ifFalse:
- [row := event position y > self bottom
- ifTrue:
- [scrollBar scrollDown: 1.
- self rowAtLocation: scroller bottomLeft + (1 @ -1)]
- ifFalse: [ self rowAtLocation: event position]].
- row = 0 ifTrue: [^super mouseDown: event].
- index := self modelIndexFor: row.
-
- model okToChange ifFalse: [^self]. "No change if model is locked"
-
- dragOnOrOff ifNil: [
- "Was not set at mouse down, which means the mouse must have gone down in an area where there was no list item"
- dragOnOrOff := (self listSelectionAt: index) not].
-
- self changeModelSelection: index.
- self listSelectionAt: index put: dragOnOrOff.!
Item was removed:
- ----- Method: PluggableListMorphOfMany>>mouseUp: (in category 'event handling') -----
- mouseUp: event
-
- dragOnOrOff := nil. "So improperly started drags will have not effect"
-
- event hand newKeyboardFocus: self.
- hasFocus := true.
- Cursor normal show.!
Item was removed:
- ----- Method: PluggableListMorphOfMany>>on:list:primarySelection:changePrimarySelection:listSelection:changeListSelection:menu:keystroke: (in category 'initialization') -----
- on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel keystroke: keyActionSel
- "setup a whole load of pluggability options"
-
- getSelectionListSelector := getListSel.
- setSelectionListSelector := setListSel.
- super
- on: anObject
- list: listSel
- selected: getSelectionSel
- changeSelected: setSelectionSel
- menu: getMenuSel
- keystroke: keyActionSel.!
Item was removed:
- ----- Method: PluggableListMorphOfMany>>specialKeyPressed: (in category 'model access') -----
- specialKeyPressed: asciiValue
- "Toggle the selection on [space]."
-
- asciiValue = Character space asciiValue
- ifTrue: [ | index |
- index := self getCurrentSelectionIndex.
- index = 0 ifTrue: [^ self].
- self
- listSelectionAt: index
- put: ((self listSelectionAt: index) not).
- ^ self].
-
- super specialKeyPressed: asciiValue.!
Item was removed:
- ----- Method: PluggableListMorphOfMany>>update: (in category 'updating') -----
- update: aSymbol
-
- aSymbol == #allSelections ifTrue: [
- "Convenient - yet hard-coded - way to refresh all selections."
- super update: getIndexSelector.
- ^ self changed].
- aSymbol == getSelectionListSelector ifTrue: [
- ^ self changed].
-
- super update: aSymbol.!
Item was removed:
- PluggableListMorph subclass: #PluggableMultiColumnListMorph
- instanceVariableNames: 'listMorphs'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Pluggable Widgets'!
-
- !PluggableMultiColumnListMorph commentStamp: '<historical>' prior: 0!
- This morph can be used to show a list having multiple columns, The columns are self width sized to make the largest entry in each list fit. In some cases the pane may then be too narrow.
-
- Use it like a regular PluggableListMorph except pass in an array of lists instead of a single list.
-
- There are base assumptions made here that each list in the array of lists is the same size.
-
- Also, the highlight color for the selection is easy to modify in the #highlightSelection method. I used blue
- when testing just to see it work.!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>cellInsetAtColumn: (in category 'layout') -----
- cellInsetAtColumn: columnIndex
-
- ^ self cellInsetForColumns
- at: columnIndex
- ifAbsent: [
- "Repeat the inset of the last column or choose the default."
- self cellInsetForColumns
- ifEmpty: [3 at 0]
- ifNotEmpty: [:paddings | paddings last]]!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>cellInsetForColumns (in category 'layout') -----
- cellInsetForColumns
-
- ^ self valueOfProperty: #cellInsetForColumns ifAbsent: [#()]!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>cellInsetForColumns: (in category 'layout') -----
- cellInsetForColumns: someSymbols
- "Cache the preferred inset of items per column because column count can vary."
-
- self setProperty: #cellInsetForColumns toValue: someSymbols.!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>cellPositioningAtColumn: (in category 'layout') -----
- cellPositioningAtColumn: columnIndex
-
- ^ self cellPositioningForColumns
- at: columnIndex
- ifAbsent: [
- "Repeat the alignment of the last column or choose the default."
- self cellPositioningForColumns
- ifEmpty: [#leftCenter]
- ifNotEmpty: [:alignments | alignments last]]!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>cellPositioningForColumns (in category 'layout') -----
- cellPositioningForColumns
-
- ^ self valueOfProperty: #cellPositioningForColumns ifAbsent: [#()]!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>cellPositioningForColumns: (in category 'layout') -----
- cellPositioningForColumns: someSymbols
- "Cache the preferred positioning of items per column because column count can vary."
-
- self setProperty: #cellPositioningForColumns toValue: someSymbols.!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>charactersOccluded (in category 'geometry') -----
- charactersOccluded
- "Not meaningful in multi-column lists, since they should truncate their column widths according to how much space is needed vs. available to show a bit of each."
- ^ 0!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>columnCount (in category 'accessing') -----
- columnCount
- "Even an empty column is a column."
-
- ^ self getFullList size max: 1!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>filterColumnColor (in category 'filtering') -----
- filterColumnColor
-
- ^ (Color gray: 0.85) alpha: 0.4!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>filterColumnIndex (in category 'filtering') -----
- filterColumnIndex
- "Which column to apply the filter to?"
-
- | i |
- i := 0.
- self listMorphs
- detect: [:m | i := i + 1. m backgroundColor notNil]
- ifNone: [i := 0].
- ^ i!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>filterList:columnIndex:matching: (in category 'filtering') -----
- filterList: columns columnIndex: index matching: aPattern
- "A matching row has a match in at least one column."
-
- | frontMatching substringMatching rowCount columnCount tmp |
- aPattern ifEmpty: [^ columns].
- columns ifEmpty: [^ columns].
-
- rowCount := columns first size.
- rowCount = 0 ifTrue: [^ columns].
- columnCount := columns size.
-
- frontMatching := Array new: columnCount.
- 1 to: columnCount do: [:c | frontMatching at: c put: OrderedCollection new].
- substringMatching := Array new: columnCount.
- 1 to: columnCount do: [:c | substringMatching at: c put: OrderedCollection new].
-
- modelToView := Dictionary new.
- viewToModel := Dictionary new.
- tmp := OrderedCollection new.
-
- 1 to: rowCount do: [:rowIndex |
- | match foundPos |
- match := false.
- foundPos := self
- filterListItem: ((columns at: index) at: rowIndex)
- matching: aPattern.
- foundPos = 1
- ifTrue: [
- 1 to: columnCount do: [:colIndex |
- (frontMatching at: colIndex) add: ((columns at: colIndex) at: rowIndex)].
- modelToView at: rowIndex put: frontMatching first size.
- viewToModel at: frontMatching first size put: rowIndex]
- ifFalse: [foundPos > 1 ifTrue: [
- 1 to: columnCount do: [:colIndex |
- (substringMatching at: colIndex) add: ((columns at: colIndex) at: rowIndex)].
- tmp add: rowIndex; add: substringMatching first size]]
- ].
-
- tmp pairsDo: [:modelIndex :viewIndex |
- modelToView at: modelIndex put: viewIndex + frontMatching first size.
- viewToModel at: viewIndex + frontMatching first size put: modelIndex].
-
- ^ (1 to: columnCount) collect: [:colIndex |
- (frontMatching at: colIndex), (substringMatching at: colIndex)]
-
-
-
-
-
-
-
-
-
-
-
-
-
- !
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>filterList:matching: (in category 'filtering') -----
- filterList: columns matching: aPattern
- "A matching row has a match in at least one column."
-
- | frontMatching substringMatching rowCount columnCount tmp |
- aPattern ifEmpty: [^ columns].
- columns ifEmpty: [^ columns].
-
- "Enable column-specific filtering."
- self filterColumnIndex in: [:index |
- index > 0 ifTrue: [^ self filterList: columns columnIndex: index matching: aPattern]].
-
- rowCount := columns first size.
- rowCount = 0 ifTrue: [^ columns].
- columnCount := columns size.
-
- frontMatching := Array new: columnCount.
- 1 to: columnCount do: [:c | frontMatching at: c put: OrderedCollection new].
- substringMatching := Array new: columnCount.
- 1 to: columnCount do: [:c | substringMatching at: c put: OrderedCollection new].
-
- modelToView := Dictionary new.
- viewToModel := Dictionary new.
- tmp := OrderedCollection new.
-
- 1 to: rowCount do: [:rowIndex |
- | match foundPos |
- match := false.
- foundPos := 0.
- 1 to: columnCount do: [:colIndex |
- match := match or: [(foundPos := (self
- filterListItem: ((columns at: colIndex) at: rowIndex)
- matching: aPattern)+colIndex) > colIndex]].
- match & (foundPos = 2) "means front match in first column"
- ifTrue: [
- 1 to: columnCount do: [:colIndex |
- (frontMatching at: colIndex) add: ((columns at: colIndex) at: rowIndex)].
- modelToView at: rowIndex put: frontMatching first size.
- viewToModel at: frontMatching first size put: rowIndex]
- ifFalse: [match ifTrue: [
- 1 to: columnCount do: [:colIndex |
- (substringMatching at: colIndex) add: ((columns at: colIndex) at: rowIndex)].
- tmp add: rowIndex; add: substringMatching first size]]
- ].
-
- tmp pairsDo: [:modelIndex :viewIndex |
- modelToView at: modelIndex put: viewIndex + frontMatching first size.
- viewToModel at: viewIndex + frontMatching first size put: modelIndex].
-
- ^ (1 to: columnCount) collect: [:colIndex |
- (frontMatching at: colIndex), (substringMatching at: colIndex)]
-
-
-
-
-
-
-
-
-
-
-
-
-
- !
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>font: (in category 'initialization') -----
- font: aFontOrNil
-
- listMorphs do: [:lm | lm font: aFontOrNil].
- super font: aFontOrNil.!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>fullListSize (in category 'list morph callbacks') -----
- fullListSize
- "return the current number of items in the displayed list"
-
- ^ self getFullList
- ifEmpty: [0]
- ifNotEmpty: [:columns | columns first size]!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>getFilteredList (in category 'filtering') -----
- getFilteredList
- "Apply the current filter to the list. Maybe shorten the filter term if there are no matches."
-
- | fullList filteredList |
- fullList := self getFullList.
-
- self hasFilter ifFalse: [^ fullList].
- fullList ifEmpty: [^ fullList].
- fullList first ifEmpty: [^ fullList].
-
- filteredList := self filterList: fullList matching: lastKeystrokes.
-
- (filteredList first isEmpty not or: [ self allowEmptyFilterResult ])
- ifFalse:
- [ "Remove the last character and try filtering again."
- lastKeystrokes := lastKeystrokes allButLast: 1.
- ^ self
- flash;
- getFilteredList ].
-
- ^ filteredList!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>getFullList (in category 'model access - cached') -----
- getFullList
- "The full list arranges all items column-first."
-
- fullList ifNotNil: [^ fullList].
-
- fullList := getListSelector
- ifNotNil: [:selector | "A) Fetch the list column-first from the model."
- model perform: selector]
- ifNil: [
- (getListSizeSelector notNil and: [getListElementSelector notNil])
- ifFalse: ["X) We cannot fetch the list from the model. Make it empty."
- #()]
- ifTrue: [ "B) Fetch the list row-first from the model:"
- | listSize |
- listSize := self getListSize.
- listSize = 0 ifTrue: [#() "Empty list"] ifFalse: [
- | firstRow columns |
- firstRow := self getListItem: 1.
- columns := Array new: firstRow size.
- 1 to: columns size do: [:columnIndex |
- "Initialize all columns."
- columns at: columnIndex put: (Array new: listSize).
- "Put the first row in."
- (columns at: columnIndex) at: 1 put: (firstRow at: columnIndex)].
- "Put all other rows in."
- 2 to: listSize do: [:rowIndex | (self getListItem: rowIndex)
- withIndexDo: [:item :columnIndex |
- (columns at: columnIndex) at: rowIndex put: item]].
- columns]]].
-
- self updateColumns.
-
- ^ fullList!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>getListItem: (in category 'model access') -----
- getListItem: modelIndex
- "Return a row full of items."
-
- ^ getListElementSelector
- ifNotNil: [:sel | model perform: sel with: modelIndex ]
- ifNil: [self getFullList collect: [:column | column at: modelIndex]]!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>hResizingAtColumn: (in category 'layout') -----
- hResizingAtColumn: columnIndex
-
- ^ self hResizingForColumns
- at: columnIndex
- ifAbsent: [
- "Repeat the resizing strategy of the last column or choose the default."
- self hResizingForColumns
- ifEmpty: [#spaceFill]
- ifNotEmpty: [:strategies | strategies last]]!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>hResizingForColumns (in category 'layout') -----
- hResizingForColumns
-
- ^ self valueOfProperty: #hResizingForColumns ifAbsent: [#()]!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>hResizingForColumns: (in category 'layout') -----
- hResizingForColumns: someSymbols
- "Cache the preferred horizontal resizing for each column because column count can vary."
-
- self setProperty: #hResizingForColumns toValue: someSymbols.!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>hScrollBarPolicy: (in category 'accessing') -----
- hScrollBarPolicy: aSymbol
- "The lazy list morph will never wrap its rows if they do not fit. Instead, they are just clipped. So, #spaceFill is fine if the horizontal scroll bar should never be visible."
-
- self checkScrollBarPolicy: aSymbol.
-
- aSymbol ~= #never
- ifTrue: [listMorphs do: [:lm | lm hResizing: #shrinkWrap]]
- ifFalse: [listMorphs do: [:lm | lm hResizing: #spaceFill]].
-
- ^ super hScrollBarPolicy: aSymbol!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>highlightNextColumn (in category 'filtering') -----
- highlightNextColumn
-
- | i currentColumn nextColumn |
- i := self filterColumnIndex.
- i = 0 ifTrue: [self listMorphs do: [:m | m showFilter: false]].
-
- currentColumn := self listMorphs at: (i max: 1).
- nextColumn := self listMorphs at: i \\ self listMorphs size + 1.
-
- currentColumn
- showFilter: false;
- backgroundColor: nil.
-
- nextColumn
- showFilter: true;
- backgroundColor: self filterColumnColor.!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>highlightNoColumn (in category 'filtering') -----
- highlightNoColumn
-
- self listMorphs do: [:m |
- m showFilter: true; backgroundColor: nil].!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>hoverRow: (in category 'accessing') -----
- hoverRow: viewIndex
-
- hoverRow = viewIndex ifTrue: [^ self].
- listMorphs do: [:listMorph |
- listMorph rowChanged: hoverRow with: viewIndex].
- super hoverRow: viewIndex.!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>iconAt: (in category 'list morph callbacks') -----
- iconAt: rowIndex
-
- ^ self iconAt: rowIndex column: 1!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>iconAt:column: (in category 'list morph callbacks') -----
- iconAt: rowIndex column: columnIndex
-
- getIconSelector ifNil: [^ nil].
-
- getIconSelector numArgs = 1 ifTrue: [
- "For unspecific icon selectors only icons for the first column."
- ^ columnIndex = 1
- ifTrue: [model perform: getIconSelector with: rowIndex]
- ifFalse: [nil]].
-
- ^ model
- perform: getIconSelector
- with: (self modelIndexFor: rowIndex)
- with: columnIndex!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>initialize (in category 'initialization') -----
- initialize
-
- listMorphs := #().
- super initialize.
-
- self scroller
- listDirection: #leftToRight;
- cellPositioning: #topLeft.
-
- listMorphs := OrderedCollection with: listMorph.!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>itemAt: (in category 'list morph callbacks') -----
- itemAt: rowIndex
-
- ^ self itemAt: rowIndex column: 1!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>itemAt:column: (in category 'list morph callbacks') -----
- itemAt: rowIndex column: columnIndex
-
- ^ (self getList at: columnIndex) at: rowIndex!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>listMorphs (in category 'accessing') -----
- listMorphs
-
- ^ listMorphs!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>listSize (in category 'list morph callbacks') -----
- listSize
-
- ^ self visibleRowCount!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>removeFilter (in category 'filtering') -----
- removeFilter
-
- self highlightNoColumn.
- super removeFilter.
- !
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>rowAboutToBecomeSelected: (in category 'selection') -----
- rowAboutToBecomeSelected: anInteger
-
- listMorphs do: [:listMorph | listMorph preSelectedRow: anInteger].
- super rowAboutToBecomeSelected: anInteger.!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>rowAtLocation: (in category 'accessing - items') -----
- rowAtLocation: aPoint
- "Return the row at the given point or 0 if outside"
-
- | pointInListMorphCoords rowIndex |
- pointInListMorphCoords := (self scroller transformFrom: self) transform: aPoint.
-
- listMorphs do: [:listMorph |
- rowIndex := listMorph rowAtLocation: pointInListMorphCoords.
- rowIndex > 0 ifTrue: [^ rowIndex]].
-
- ^ 0
- !
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>rowCount (in category 'accessing') -----
- rowCount
-
- ^ self getFullList
- ifEmpty: [0]
- ifNotEmpty: [:columns | columns first size]!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>selection (in category 'selection') -----
- selection
- "Collect the selected row from all columns as array."
-
- ^ self getList collect: [:column |
- column
- at: self selectionIndex
- ifAbsent: [nil]]!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>selection: (in category 'selection') -----
- selection: someObjects
-
- | found |
- someObjects size ~= self columnCount ifTrue: [^ self].
-
- 1 to: self listSize do: [:row |
- found := true.
- self getList withIndexDo: [:items :column |
- found := found and: [(items at: row) = (someObjects at: column)]].
- found ifTrue: [^ self selectionIndex: row]].!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>selectionIndex: (in category 'selection') -----
- selectionIndex: viewIndex
-
- listMorphs do: [:listMorph | listMorph selectedRow: (viewIndex min: self listSize)].
-
- "ct: As per the invariant defined in #setListParameters, listMorphs always includes listMorph. Subsequently, every super send in #selectionIndex: would be without effect because #selectionIndex already has been updated in the child class. Since selection highlighting is also not relevant for multi-column list morphs (this hook is only used by SimpleHierarchicalListMorph), we can refuse this bequest but send #scrollSelectionIntoView manually."
- self scrollSelectionIntoView.!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>setListParameters (in category 'initialization') -----
- setListParameters
-
- listMorphs ifEmpty: [^ super setListParameters].
-
- listMorphs do: [:lm | listMorph := lm. super setListParameters].
- listMorph := listMorphs first.!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>spaceFillWeightAtColumn: (in category 'layout') -----
- spaceFillWeightAtColumn: columnIndex
-
- ^ self spaceFillWeightForColumns
- at: columnIndex
- ifAbsent: [
- "Repeat the weight of the last column or choose the default."
- self spaceFillWeightForColumns
- ifEmpty: [1]
- ifNotEmpty: [:weights | weights last]]!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>spaceFillWeightForColumns (in category 'layout') -----
- spaceFillWeightForColumns
-
- ^ self valueOfProperty: #spaceFillWeightForColumns ifAbsent: [#()]!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>spaceFillWeightForColumns: (in category 'layout') -----
- spaceFillWeightForColumns: someSymbols
- "Cache the preferred space-fill weight for each column because column count can vary."
-
- self setProperty: #spaceFillWeightForColumns toValue: someSymbols.!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>specialKeyPressed: (in category 'filtering') -----
- specialKeyPressed: asciiValue
- "Use the [Tab] key to filter specific columns."
-
- ^ asciiValue = Character tab asciiValue
- ifTrue: [self highlightNextColumn]
- ifFalse: [super specialKeyPressed: asciiValue].!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>textColor: (in category 'initialization') -----
- textColor: aColor
-
- listMorphs do: [:listMorph | listMorph color: aColor].
- super textColor: aColor.!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>updateColumns (in category 'updating') -----
- updateColumns
- "The number of columns must match the number of list morphs."
-
- | columnsChanged |
- columnsChanged := self columnCount ~= listMorphs size.
-
- [self columnCount < listMorphs size]
- whileTrue: [
- listMorphs removeLast delete].
-
- [self columnCount > listMorphs size]
- whileTrue: [
- listMorphs addLast: self createListMorph.
- self scroller addMorphBack: listMorphs last].
-
- listMorphs withIndexDo: [:listMorph :columnIndex |
- listMorph
- columnIndex: columnIndex;
- color: self textColor;
- cellPositioning: (self cellPositioningAtColumn: columnIndex);
- cellInset: (self cellInsetAtColumn: columnIndex);
- hResizing: (self hResizingAtColumn: columnIndex);
- spaceFillWeight: (self spaceFillWeightAtColumn: columnIndex)].
-
- columnsChanged ifTrue: [self setListParameters].!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>updateListMorph (in category 'updating') -----
- updateListMorph
- "We have to notify all columns."
-
- listMorphs do: #listChanged.!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>userString (in category 'debug and other') -----
- userString
- "Do I have a text string to be searched on?"
-
- ^ String streamContents: [:strm |
- 1 to: self rowCount do: [:row |
- 1 to: self columnCount do: [:col |
- strm nextPutAll: ((self getFullList at: col) at: row) asStringOrText; tab].
- strm cr]]!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>verifyContents (in category 'updating') -----
- verifyContents
- "Verify the contents of the receiver, reconstituting if necessary. Called whenever window is reactivated, to react to possible structural changes. Also called periodically in morphic if the smartUpdating preference is true"
-
- | changed currentList modelList modelIndex |
- self flag: #performance. "mt: We do have changed/update. Why can't the tools communicate through an appropriate notifier such as the SystemChangeNotifier?"
-
- "1) Is the list still up to date?"
- currentList := fullList. fullList := nil.
- modelList := self getFullList.
- changed := false.
- modelList withIndexDo: [:column :index |
- changed := changed or: [(currentList at: index) ~= column]].
- changed ifFalse: [^ self].
- self updateList: modelList.
-
- "2) Is the selection still up to date?"
- modelIndex := self getCurrentSelectionIndex.
- (self modelIndexFor: self selectionIndex) = modelIndex ifTrue: [^ self].
- self updateListSelection: modelIndex.!
Item was removed:
- ----- Method: PluggableMultiColumnListMorph>>visibleRowCount (in category 'accessing') -----
- visibleRowCount
- "Take the size of the first column. We treat all columns equally."
-
- ^ self getList
- ifEmpty: [0]
- ifNotEmpty: [:columns | columns first size]!
Item was removed:
- PluggableMultiColumnListMorph subclass: #PluggableMultiColumnListMorphByItem
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Pluggable Widgets'!
-
- !PluggableMultiColumnListMorphByItem commentStamp: 'mt 10/12/2019 12:25' prior: 0!
- Like PluggableMultiColumnListMorph but maps #setIndexSelector and #getIndexSelector to actual items instead of indexes.!
Item was removed:
- ----- Method: PluggableMultiColumnListMorphByItem>>changeModelSelection: (in category 'model access') -----
- changeModelSelection: modelIndex
- "Change the model's selected item to be the one at the given index."
-
- setIndexSelector ifNotNil: [
- model
- perform: setIndexSelector
- with: (modelIndex = 0 ifTrue: [#()] ifFalse: [self getFullList collect: [:column | column at: modelIndex]])].!
Item was removed:
- ----- Method: PluggableMultiColumnListMorphByItem>>getCurrentSelectionIndex (in category 'model access') -----
- getCurrentSelectionIndex
- "Answer the index of the current selection. Similar to #selection: but with the full list instead of the (maybe) filtered list."
-
- getIndexSelector ifNil: [^ 0].
-
- (model perform: getIndexSelector) in: [:row |
- row ifNil: [^ 0].
- row ifEmpty: [^ 0].
-
- 1 to: self fullListSize do: [:rowIndex |
- | match |
- match := true.
- self getFullList withIndexDo: [:column :columnIndex |
- match := match and: [(column at: rowIndex) = (row at: columnIndex)]].
- match ifTrue: [^ rowIndex]]].
-
- ^ 0!
Item was removed:
- ScrollPane subclass: #PluggableScrollPane
- instanceVariableNames: 'morph morphClass'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Pluggable Widgets'!
Item was removed:
- ----- Method: PluggableScrollPane class>>on: (in category 'instance creation') -----
- on: morph
-
- ^ self new
- morph: morph;
- yourself!
Item was removed:
- ----- Method: PluggableScrollPane class>>onClass: (in category 'instance creation') -----
- onClass: morphClass
-
- ^ self new
- morphClass: morphClass;
- updateMorph;
- yourself!
Item was removed:
- ----- Method: PluggableScrollPane>>morph (in category 'accessing') -----
- morph
-
- ^ morph ifNil: [
- self morph: self morphClass new.
- morph]!
Item was removed:
- ----- Method: PluggableScrollPane>>morph: (in category 'accessing') -----
- morph: morphToScroll
-
- morph ifNotNil: [:m | m removeDependent: self].
-
- morphToScroll topLeft: 0 at 0.
- morph := morphToScroll.
- morphClass := morphToScroll class.
-
- morph addDependent: self.
-
- self scroller
- removeAllMorphs;
- addMorph: morph.
-
- self updateMorph.!
Item was removed:
- ----- Method: PluggableScrollPane>>morphClass (in category 'accessing') -----
- morphClass
-
- ^ morphClass ifNil: [Morph]!
Item was removed:
- ----- Method: PluggableScrollPane>>morphClass: (in category 'accessing') -----
- morphClass: aMorphClass
-
- morphClass := aMorphClass.!
Item was removed:
- ----- Method: PluggableScrollPane>>update: (in category 'updating') -----
- update: aspect
-
- aspect == #submorphs
- ifTrue: [self updateMorph].
-
- super update: aspect.!
Item was removed:
- ----- Method: PluggableScrollPane>>updateMorph (in category 'updating') -----
- updateMorph
-
- self morph fullBounds.
- self setScrollDeltas.!
Item was removed:
- PluggableSystemWindow subclass: #PluggableSystemWindowWithLabelButton
- instanceVariableNames: 'labelButton'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
-
- !PluggableSystemWindowWithLabelButton commentStamp: 'eem 6/29/2010 19:02' prior: 0!
- A PluggableSystemWindowWithLabelButton provides the pull-down menu of browser panes in the multi-pane browser.
-
- Instance Variables
- labelButton: <BrowserPaneButtonMorph>
-
- labelButton
- - the labelButton is a hack to hold onto the panes of a multi-paned browser so that an inst var doesn't have to be added to the Browser hierarchy.
- !
Item was removed:
- ----- Method: PluggableSystemWindowWithLabelButton>>replaceBoxes (in category 'initialization') -----
- replaceBoxes
-
- super replaceBoxes.
- labelButton comeToFront.!
Item was removed:
- ----- Method: PluggableSystemWindowWithLabelButton>>savedMultiWindowState: (in category 'accessing') -----
- savedMultiWindowState: aSavedMultiWindowState
- | offset |
- labelButton := MultiWindowLabelButtonMorph
- on: aSavedMultiWindowState
- getState: nil
- action: #selectWindowsMenu.
- labelButton
- triggerOnMouseDown: true;
- savedMultiWindowState: aSavedMultiWindowState.
-
- offset := (0 @ ToolBuilder default windowSpacing negated)
- + (RealEstateAgent defaultIconExtent
- * (SystemWindow moveMenuButtonRight ifTrue: [1 @ -1] ifFalse: [2 @ -1])).
- offset := (offset * RealEstateAgent scaleFactor) truncated.
-
- labelButton
- layoutFrame: (LayoutFrame "i.e. in the left 40% of the title bar"
- fractions: (0 at 0 corner: 0.4 at 0)
- offsets: (offset corner: 0 at 0));
- hResizing: #spaceFill;
- vResizing: #spaceFill.
- self addMorphFront: labelButton.!
Item was removed:
- Morph subclass: #PluggableTabButtonMorph
- instanceVariableNames: 'active model textSelector arcLengths subMorph'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Pluggable Widgets'!
-
- !PluggableTabButtonMorph commentStamp: 'KLC 9/17/2004 11:27' prior: 0!
- This is a specialized pluggable button morph that is meant to represent a tab in a set of tabs arranged horizontally. Each tab will overlap slightly when drawn. All but one tab will be drawn in left to right order in the specified color, but lighter. The active tab will be drawn last in the full color and slightly taller to indicate that it is selected. Clicking the active tab has no effect but clicking any other tab will change the active tab to the clicked tab.
-
- This morph does not itself accept any events. The parent tab set will grab the mouse clicks and handle notifying the appropriate tabs that they have been activated or deactivated.
-
- There is a single selector which provides the text for the button label and affects the width of the tab. When the width changes the tab will inform its parent that it has changed and that the layout needs to be updated. The model for the text selector of course should be the client for the tab set.
-
- The button label can be a String, Text, or Morph. Texts work better than plain Strings.!
Item was removed:
- ----- Method: PluggableTabButtonMorph class>>on:label: (in category 'instance creation') -----
- on: anObject label: getTextSelector
- | instance |
- instance := super new.
- instance model: anObject.
- instance textSelector: getTextSelector.
- ^ instance !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>active (in category 'access') -----
- active
- active ifNil: [ active := false ].
- ^ active!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>active: (in category 'access') -----
- active: aBoolean
- active := aBoolean.
- self changed.!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>arcLengths (in category 'private - access') -----
- arcLengths
- arcLengths ifNil: [ self calculateArcLengths ].
- ^ arcLengths!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>arcLengths: (in category 'private - access') -----
- arcLengths: anArrayOfIntegers
- arcLengths := anArrayOfIntegers
- !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>calculateArcLengths (in category 'precalculations') -----
- calculateArcLengths
- | array radius |
- radius := self cornerRadius.
- array := Array new: radius.
-
- 1 to: radius do: [ :i | | x |
- x := i - 0.5.
- array at: i
- put: (radius - ((2 * x * radius) - (x * x)) sqrt) asInteger].
-
- self arcLengths: array!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>cornerRadius (in category 'private - access') -----
- cornerRadius
- ^ 5
- !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- self drawTabOn: aCanvas.
- self drawSubMorphOn: aCanvas!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>drawSubMorphOn: (in category 'drawing') -----
- drawSubMorphOn: aCanvas
- | morphBounds |
- morphBounds := self bounds insetBy: (self cornerRadius + 3) @ (self topInactiveGap // 2 + 2).
- morphBounds := morphBounds translateBy: 0@(self topInactiveGap // 2 + 1).
- self active ifTrue: [
- morphBounds := morphBounds translateBy: 0@((self topInactiveGap // 2 + 1) negated)].
- self subMorph bounds height < (morphBounds height)
- ifTrue: [
- morphBounds := morphBounds
- insetBy: 0@((morphBounds height - self subMorph bounds height) // 2)].
- self subMorph bounds width < (morphBounds width)
- ifTrue: [
- morphBounds := morphBounds
- insetBy: ((morphBounds width - self subMorph bounds width) // 2)@0].
-
- self subMorph bounds: morphBounds.
- aCanvas drawMorph: self subMorph!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>drawTabOn: (in category 'drawing') -----
- drawTabOn: aCanvas
- | top myColor cornerRadius myArcLengths myBounds |
- cornerRadius := self cornerRadius.
- myBounds := self bounds.
- self active
- ifTrue: [ top := myBounds top.
- myColor := self color ]
- ifFalse: [ top := myBounds top + self topInactiveGap.
- myColor := self color whiter whiter ].
- aCanvas fillRectangle:
- ((myBounds left + cornerRadius)
- @ (top + cornerRadius)
- corner: (myBounds right - cornerRadius)
- @ self bottom)
- color: myColor.
- aCanvas fillRectangle:
- ((myBounds left + (cornerRadius * 2)) @ top
- corner: (myBounds right - (cornerRadius * 2))
- @ (top + cornerRadius))
- color: myColor.
- aCanvas fillOval:
- ((myBounds left + self cornerRadius) @ top
- corner: (myBounds left + (self cornerRadius * 3))
- @ (top + (self cornerRadius * 2)))
- color: myColor.
- aCanvas fillOval:
- ((myBounds right - (self cornerRadius * 3)) @ top
- corner: (myBounds right - self cornerRadius)
- @ (top + (self cornerRadius * 2)))
- color: myColor.
-
- myArcLengths := self arcLengths.
- 1 to: myArcLengths size do: [ :i | | length |
- length := myArcLengths at: i.
- aCanvas line: (myBounds left + cornerRadius - i) @ (myBounds bottom - 1 )
- to: (myBounds left + cornerRadius - i) @ (myBounds bottom - length - 1)
- color: myColor.
- aCanvas line: (myBounds right - cornerRadius + i - 1) @ (myBounds bottom - 1)
- to: (myBounds right - cornerRadius + i - 1) @ (myBounds bottom - length - 1)
- color: myColor]
-
- !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>initialize (in category 'initialization') -----
- initialize
- ^ super initialize
- !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>innerExtent: (in category 'access') -----
- innerExtent: aPoint
- "Set the extent based on the primary visible part of the tab. In other words add twice the cornerRadius to this extent"
- self extent: (aPoint x + (self cornerRadius * 2)) @ (aPoint y)!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>model (in category 'access') -----
- model
- ^ model
- !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>model: (in category 'access') -----
- model: anObject
- model := anObject!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>outerGap (in category 'access') -----
- outerGap
- "The horizontal distance of the outer left and right edges of the tab excluding the inner visible part"
- ^ self cornerRadius * 2!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>step (in category 'stepping') -----
- step
- self subMorph step.
- self changed.
- !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>stepTime (in category 'stepping') -----
- stepTime
- ^ self subMorph stepTime
- !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>subMorph (in category 'private - access') -----
- subMorph
- subMorph ifNil: [ self update: self textSelector ].
- ^ subMorph!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>subMorph: (in category 'private - access') -----
- subMorph: aMorph
- subMorph := aMorph
- !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>textSelector (in category 'access') -----
- textSelector
- ^ textSelector
- !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>textSelector: (in category 'access') -----
- textSelector: aSymbol
- textSelector := aSymbol!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>toggle (in category 'actions') -----
- toggle
- self active: self active not!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>topInactiveGap (in category 'private - access') -----
- topInactiveGap
- ^ 5!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>update: (in category 'updating') -----
- update: aSelector
- self textSelector ifNotNil: [
- aSelector = self textSelector
- ifTrue: [ | morph |
- (aSelector isSymbol and: [model notNil])
- ifTrue: [
- morph :=
- (self model perform: aSelector) asMorph]
- ifFalse: [ morph := aSelector value asMorph].
- self subMorph: morph]].
- self changed!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>wantsSteps (in category 'stepping') -----
- wantsSteps
- ^ self subMorph wantsSteps!
Item was removed:
- ScrollPane subclass: #PluggableTextMorph
- instanceVariableNames: 'textMorph getTextSelector setTextSelector getSelectionSelector hasUnacceptedEdits hasUserEdited askBeforeDiscardingEdits selectionInterval hasEditingConflicts editTextSelector wantsWrapBorder getFontSelector getTextStyleSelector'
- classVariableNames: 'AdornmentCache SimpleFrameAdornments SoftLineWrap SoftLineWrapAtVisualWrapBorder VisualWrapBorder VisualWrapBorderLimit'
- poolDictionaries: ''
- category: 'Morphic-Pluggable Widgets'!
Item was removed:
- ----- Method: PluggableTextMorph class>>adornmentCache (in category 'frame adornments') -----
- adornmentCache
- "Cache for frame adornments"
-
- ^AdornmentCache ifNil:[AdornmentCache := Dictionary new].!
Item was removed:
- ----- Method: PluggableTextMorph class>>adornmentWithColor: (in category 'frame adornments') -----
- adornmentWithColor: aColor
- "Create and return a frame adornment with the given color"
-
- | size box form fillStyle |
- ^self adornmentCache at: aColor ifAbsentPut:[
- size := (16 * RealEstateAgent scaleFactor) rounded.
- box := 0 at 0 extent: size asPoint.
- form := Form extent: size at size depth: 32.
- fillStyle := MenuMorph gradientMenu ifFalse: [SolidFillStyle color: aColor] ifTrue: [
- (GradientFillStyle ramp: {
- 0.0->(aColor alpha: 0.01).
- 0.8->aColor.
- 1.0->aColor})
- origin: box topRight - (size at 0);
- direction: (size @ size negated) // 4;
- radial: false].
- form getCanvas drawPolygon: {
- box topRight.
- box topRight + (0 at size).
- box topRight - (size at 0)
- } fillStyle: fillStyle.
- form].
- !
Item was removed:
- ----- Method: PluggableTextMorph class>>applyUserInterfaceTheme (in category 'preferences') -----
- applyUserInterfaceTheme
-
- self flushAdornmentCache.
-
- TextEditor withAllSubclassesDo: [:cls |
- cls initializeYellowButtonMenu.
- cls initializeShiftedYellowButtonMenu].!
Item was removed:
- ----- Method: PluggableTextMorph class>>cleanUp: (in category 'initialize-release') -----
- cleanUp: aggressive
-
- aggressive ifTrue: [self flushAdornmentCache].!
Item was removed:
- ----- Method: PluggableTextMorph class>>flushAdornmentCache (in category 'frame adornments') -----
- flushAdornmentCache
- "Cache for frame adornments"
-
- AdornmentCache := nil!
Item was removed:
- ----- Method: PluggableTextMorph class>>on:text:accept: (in category 'instance creation') -----
- on: anObject text: getTextSel accept: setTextSel
-
- ^ self on: anObject
- text: getTextSel
- accept: setTextSel
- readSelection: nil
- menu: nil!
Item was removed:
- ----- Method: PluggableTextMorph class>>on:text:accept:readSelection:menu: (in category 'instance creation') -----
- on: anObject text: getTextSel accept: setTextSel readSelection: getSelectionSel menu: getMenuSel
-
- ^ self new on: anObject
- text: getTextSel
- accept: setTextSel
- readSelection: getSelectionSel
- menu: getMenuSel!
Item was removed:
- ----- Method: PluggableTextMorph class>>simpleFrameAdornments (in category 'frame adornments') -----
- simpleFrameAdornments
- <preference: 'Simple Frame Adornments'
- category: 'Morphic'
- description: 'When true, use a simple rectangle border as feedback for indicating unsaved changes in text editors, otherwise use a small triangle in the upper-right corner'
- type: #Boolean>
- ^SimpleFrameAdornments ifNil:[false]!
Item was removed:
- ----- Method: PluggableTextMorph class>>simpleFrameAdornments: (in category 'frame adornments') -----
- simpleFrameAdornments: aBool
- "Sets the simpleFrameAdornment preference
- PluggableTextMorph simpleFrameAdornments: true.
- PluggableTextMorph simpleFrameAdornments: false.
- "
- SimpleFrameAdornments := aBool
- !
Item was removed:
- ----- Method: PluggableTextMorph class>>softLineWrap (in category 'preferences') -----
- softLineWrap
- <preference: 'Use soft line wrap at widget border'
- categoryList: #(scrolling editing Accessibility)
- description: 'Wrap text lines to avoid horizontal scrolling in text widgets. This is the default for all kinds of multi-line text fields in a scrollable container, not only for source code.'
- type: #Boolean>
- ^ SoftLineWrap ifNil: [true]!
Item was removed:
- ----- Method: PluggableTextMorph class>>softLineWrap: (in category 'preferences') -----
- softLineWrap: aBooleanOrNil
-
- aBooleanOrNil == SoftLineWrap ifTrue: [^ self].
- SoftLineWrap := aBooleanOrNil.
- PluggableTextMorph allSubInstancesDo: [:m |
- m text lineCount > 1 ifTrue: [m wrapFlag: self softLineWrap]].!
Item was removed:
- ----- Method: PluggableTextMorph class>>softLineWrapAtVisualWrapBorder (in category 'preferences') -----
- softLineWrapAtVisualWrapBorder
- <preference: 'Use soft line wrap at wrap border (in code panes)'
- categoryList: #(scrolling editing Accessibility)
- description: 'Wrap text lines at the (maybe visual) wrap border in code panes. See #visualWrapBorderLimit and #visualWrapBorder.'
- type: #Boolean>
- ^ SoftLineWrapAtVisualWrapBorder ifNil: [false]!
Item was removed:
- ----- Method: PluggableTextMorph class>>softLineWrapAtVisualWrapBorder: (in category 'preferences') -----
- softLineWrapAtVisualWrapBorder: aBooleanOrNil
-
- aBooleanOrNil == SoftLineWrapAtVisualWrapBorder ifTrue: [^ self].
- SoftLineWrapAtVisualWrapBorder := aBooleanOrNil.
- self updateCodePanes.!
Item was removed:
- ----- Method: PluggableTextMorph class>>textMargins (in category 'defaults') -----
- textMargins
-
- | horizontal vertical |
- MorphicProject useCompactTextFields
- ifTrue: [
- horizontal := (3 * RealEstateAgent scaleFactor) truncated.
- vertical := 0]
- ifFalse: [
- horizontal := vertical := (UserInterfaceTheme current get: #keyboardFocusWidth for: Morph) ifNil: [2].
- vertical := (vertical * RealEstateAgent scaleFactor) truncated.
- horizontal >= 3
- ifTrue: [horizontal := vertical * 2]
- ifFalse: [horizontal := (3 * RealEstateAgent scaleFactor) truncated] ].
- ^ horizontal @ vertical corner: horizontal@ vertical!
Item was removed:
- ----- Method: PluggableTextMorph class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ super themeProperties, {
- { #font. 'Fonts'. 'Font for text if not styled.' }.
- { #textColor. 'Colors'. 'Color for text if not styled.' }.
- { #caretColor. 'Colors'. 'The color of the text cursor.' }.
- { #selectionColor. 'Colors'. 'The color of the text selection.' }.
- { #unfocusedSelectionModifier. 'Colors'. 'How to derive the text selection color if not focused.' }.
-
- { #adornmentReadOnly. 'Color'. 'How to indicate read-only contents.' }.
- { #adornmentRefuse. 'Color'. 'How to indicate that the model refuses to accept.' }.
- { #adornmentConflict. 'Color'. 'How to indicate that there are editing conflicts.' }.
- { #adornmentDiff. 'Color'. 'How to indicate that the model wants diff feedback.' }.
- { #adornmentNormalEdit. 'Color'. 'How to indicate that there are unaccepted edits.' }.
- { #adornmentDiffEdit. 'Color'. 'How to indicate that there are unaccepted edits in a diff view.' }.
-
- { #wrapBorderColorModifier. 'Color'. 'How to indicate a specific wrap border.' }.
- { #frameAdornmentWidth. 'Geometry'. 'Width of simple frame adornments.' }.
- }!
Item was removed:
- ----- Method: PluggableTextMorph class>>updateCodePanes (in category 'preferences') -----
- updateCodePanes
-
-
- self flag: #todo. "mt Only for code panes!!"
-
- self softLineWrapAtVisualWrapBorder
- ifTrue: [
- PluggableTextMorph allSubInstancesDo: [:m |
- (m styler class = (TextStyler for: #Smalltalk)) ifTrue: [
- m
- wantsWrapBorder: self visualWrapBorder;
- averageLineLength: self visualWrapBorderLimit]]]
- ifFalse: [
- PluggableTextMorph allSubInstancesDo: [:m |
- (m styler class = (TextStyler for: #Smalltalk)) ifTrue: [
- m
- wantsWrapBorder: self visualWrapBorder;
- averageLineLength: nil;
- changed "redraw #visualWrapBorderLimit"]]].!
Item was removed:
- ----- Method: PluggableTextMorph class>>visualWrapBorder (in category 'preferences') -----
- visualWrapBorder
- <preference: 'Show wrap border in code panes'
- categoryList: #(editing visuals performance Accessibility)
- description: 'Show a visual border after a specific amount of characters. Makes sense for monospaced fonts.'
- type: #Boolean>
- ^ VisualWrapBorder ifNil: [false]!
Item was removed:
- ----- Method: PluggableTextMorph class>>visualWrapBorder: (in category 'preferences') -----
- visualWrapBorder: aBooleanOrNil
-
- aBooleanOrNil == VisualWrapBorder ifTrue: [^ self].
- VisualWrapBorder := aBooleanOrNil.
- self updateCodePanes.!
Item was removed:
- ----- Method: PluggableTextMorph class>>visualWrapBorderLimit (in category 'preferences') -----
- visualWrapBorderLimit
- <preference: 'Wrap border limit (in code panes)'
- categoryList: #(editing visuals performance Accessibility)
- description: 'In all code panes, indicate an expected wrapping border after a certain amount of characters. It will be a perfect fit for monospaced fonts and average over lines for proportional fonts. This border can be purely visual or also introduce soft line breaks. See #visualWrapBorder and #softLineWrapAtVisualWrapBorder.'
- type: #String "Support negative values and floats">
- ^ VisualWrapBorderLimit ifNil: [80]!
Item was removed:
- ----- Method: PluggableTextMorph class>>visualWrapBorderLimit: (in category 'preferences') -----
- visualWrapBorderLimit: aNumberOrNil
-
- aNumberOrNil == VisualWrapBorderLimit ifTrue: [^ self].
- VisualWrapBorderLimit := aNumberOrNil ifNotNil: [:num | num asNumber].
- self updateCodePanes.!
Item was removed:
- ----- Method: PluggableTextMorph>>accept (in category 'menu commands') -----
- accept
- "Inform the model of text to be accepted, and return true if OK."
-
- | priorSelection priorScrollerOffset |
-
- (self canDiscardEdits and: [(self hasProperty: #alwaysAccept) not])
- ifTrue: [^ self flash].
-
- self hasEditingConflicts ifTrue: [
- (self confirm: 'Caution!! This method may have been\changed elsewhere since you started\editing it here. Accept anyway?' translated withCRs) ifFalse: [^ self flash]].
-
- priorSelection := self selectionInterval copy.
- priorScrollerOffset := scroller offset copy.
-
- self acceptTextInModel == true
- ifFalse: [^ self "something went wrong"].
-
- self setText: self getText.
- self hasUnacceptedEdits: false.
-
- (model dependents
- detect: [:dep | (dep isKindOf: PluggableTextMorph) and: [dep getTextSelector == #annotation]]
- ifNone: [nil])
- ifNotNil: [:aPane | model changed: #annotation].
-
- "Update the model's internal caches. Note that this is specific to CodeHolder and the stepping it uses for updating. We have to trigger this here manually to avoid that the next step message destroys our selection and scrolling offset."
- (model respondsTo: #updateCodePaneIfNeeded)
- ifTrue: [model updateCodePaneIfNeeded].
-
- "Restore prior selection:"
- scroller offset: priorScrollerOffset.
- selectionInterval := priorSelection.
- self selectFrom: priorSelection first to: priorSelection last.!
Item was removed:
- ----- Method: PluggableTextMorph>>acceptDroppingMorph:event: (in category 'layout') -----
- acceptDroppingMorph: aMorph event: evt
- "This message is sent when a morph is dropped onto a morph that has
- agreed to accept the dropped morph by responding 'true' to the
- wantsDroppedMorph:Event: message. The default implementation just
- adds the given morph to the receiver."
- "Here we let the model do its work."
-
- self model
- acceptDroppingMorph: aMorph
- event: evt
- inMorph: self.
-
- !
Item was removed:
- ----- Method: PluggableTextMorph>>acceptOnCR: (in category 'initialization') -----
- acceptOnCR: trueOrFalse
- textMorph acceptOnCR: trueOrFalse!
Item was removed:
- ----- Method: PluggableTextMorph>>acceptTextInModel (in category 'menu commands') -----
- acceptTextInModel
- "Inform the model that the receiver's textMorph's text should be accepted.
- Answer true if the model accepted ok, false otherwise"
- | textToAccept |
-
- textToAccept := textMorph contents copy.
- ^setTextSelector isNil or:
- [setTextSelector numArgs = 2
- ifTrue: [model perform: setTextSelector with: textToAccept with: self]
- ifFalse: [model perform: setTextSelector with: textToAccept]]
- !
Item was removed:
- ----- Method: PluggableTextMorph>>adoptPaneColor: (in category 'accessing') -----
- adoptPaneColor: aColor
-
- super adoptPaneColor: aColor.
-
- self wrapBorderColor: ((self userInterfaceTheme wrapBorderColorModifier ifNil: [ [:c | c muchLighter alpha: 0.3] ])
- value: self borderColor).!
Item was removed:
- ----- Method: PluggableTextMorph>>again (in category 'menu commands') -----
- again
- self handleEdit: [textMorph editor again]!
Item was removed:
- ----- Method: PluggableTextMorph>>appendEntry (in category 'transcript') -----
- appendEntry
- "Append the text in the model's writeStream to the editable text. "
- textMorph text size > model characterLimit ifTrue:
- ["Knock off first half of text"
- self selectInvisiblyFrom: 1 to: textMorph text size // 2.
- self replaceSelectionWith: Text new].
- self selectInvisiblyFrom: textMorph text size + 1 to: textMorph text size.
- self replaceSelectionWith: model contents asText.
- self selectInvisiblyFrom: textMorph text size + 1 to: textMorph text size!
Item was removed:
- ----- Method: PluggableTextMorph>>applyUserInterfaceTheme (in category 'updating') -----
- applyUserInterfaceTheme
-
- super applyUserInterfaceTheme.
- self textMorph releaseParagraph; paragraph.!
Item was removed:
- ----- Method: PluggableTextMorph>>askBeforeDiscardingEdits: (in category 'unaccepted edits') -----
- askBeforeDiscardingEdits: aBoolean
- "Set the flag that determines whether the user should be asked before discarding unaccepted edits."
-
- askBeforeDiscardingEdits := aBoolean!
Item was removed:
- ----- Method: PluggableTextMorph>>averageLineLength (in category 'accessing') -----
- averageLineLength
-
- ^ textMorph averageLineLength!
Item was removed:
- ----- Method: PluggableTextMorph>>averageLineLength: (in category 'accessing') -----
- averageLineLength: numCharsOrNil
-
- textMorph averageLineLength: numCharsOrNil.!
Item was removed:
- ----- Method: PluggableTextMorph>>browseChangeSetsWithSelector (in category 'menu commands') -----
- browseChangeSetsWithSelector
- "Help the user track down which change sets mention a particular selector"
-
- self handleEdit: [textMorph editor browseChangeSetsWithSelector]!
Item was removed:
- ----- Method: PluggableTextMorph>>browseIt (in category 'menu commands') -----
- browseIt
- self handleEdit: [textMorph editor browseIt]!
Item was removed:
- ----- Method: PluggableTextMorph>>bsText (in category 'transcript') -----
- bsText
- self changeText: (self text copyFrom: 1 to: (self text size - 1 max: 0))!
Item was removed:
- ----- Method: PluggableTextMorph>>buttonForIt (in category 'menu commands') -----
- buttonForIt
- self handleEdit: [textMorph editor buttonForIt]!
Item was removed:
- ----- Method: PluggableTextMorph>>canBeEncroached (in category 'testing') -----
- canBeEncroached
- "Fixed-height always report true, since they cannot be encroached."
- self layoutFrame ifNotNil: [ : frame | frame topFraction = frame bottomFraction ifTrue: [ ^ true ] ].
- ^ (textMorph height+10) < self height!
Item was removed:
- ----- Method: PluggableTextMorph>>canDiscardEdits (in category 'dependents access') -----
- canDiscardEdits
- "Return true if this view either has no text changes or does not care."
-
- ^ (hasUnacceptedEdits & askBeforeDiscardingEdits) not
- !
Item was removed:
- ----- Method: PluggableTextMorph>>cancel (in category 'menu commands') -----
- cancel
- self setText: self getText.
- self setSelection: self getSelection.
- getTextSelector == #annotation ifFalse:
- [(model dependents detect: [:dep | (dep isKindOf: PluggableTextMorph) and: [dep getTextSelector == #annotation]] ifNone: [nil]) ifNotNil:
- [:aPane | model changed: #annotation]]!
Item was removed:
- ----- Method: PluggableTextMorph>>cancelSafely (in category 'menu commands') -----
- cancelSafely
- "Cancel all edits by replacing the content with the original contents. Retain the undo history. The model can intervene via #okToRevertChanges, which is beneficial if all edits have already be communicated via #textEdited: so that the model can cancel its internal caches."
-
- (model respondsTo: #okToRevertChanges:) ==> [model okToRevertChanges: editTextSelector]
- ifFalse: [^ self].
-
- self handleEdit: [
- textMorph editor
- clearEmphasisHere;
- replaceAllWith: self getText.
- self selectInterval: self getSelection.
- self hasUnacceptedEdits: false.
- self hasUserEdited: false].!
Item was removed:
- ----- Method: PluggableTextMorph>>changeStyle (in category 'menu commands') -----
- changeStyle
- self handleEdit: [textMorph editor changeStyle]!
Item was removed:
- ----- Method: PluggableTextMorph>>changeText: (in category 'transcript') -----
- changeText: aText
- "The paragraph to be edited is changed to aText."
- self setText: aText!
Item was removed:
- ----- Method: PluggableTextMorph>>charactersOccluded (in category 'geometry') -----
- charactersOccluded
- "Let the receiver suggest to its neighboring vertical Splitter(s) that they try to optimize their position such that none of the receivers visible lines need to wrap."
- | numberOfPhysicalLines lastPhysicalLine logicalLines physicalLines |
- numberOfPhysicalLines := 0.
- lastPhysicalLine := (physicalLines := textMorph paragraph lines)
- detect:
- [ : each | numberOfPhysicalLines := numberOfPhysicalLines + 1.
- each bottom > self height ]
- ifNone: [ physicalLines last ].
- logicalLines := (self text
- copyFrom: 1
- to: lastPhysicalLine last) lineCount.
- ^ numberOfPhysicalLines - logicalLines!
Item was removed:
- ----- Method: PluggableTextMorph>>chooseAlignment (in category 'menu commands') -----
- chooseAlignment
- self handleEdit: [textMorph editor changeAlignment]!
Item was removed:
- ----- Method: PluggableTextMorph>>classCommentsContainingIt (in category 'menu commands') -----
- classCommentsContainingIt
- self handleEdit: [textMorph editor classCommentsContainingIt]!
Item was removed:
- ----- Method: PluggableTextMorph>>classNamesContainingIt (in category 'menu commands') -----
- classNamesContainingIt
- self handleEdit: [textMorph editor classNamesContainingIt]!
Item was removed:
- ----- Method: PluggableTextMorph>>copyHtml (in category 'menu commands') -----
- copyHtml
-
- self handleEdit: [textMorph editor copyHtml].!
Item was removed:
- ----- Method: PluggableTextMorph>>copyHtmlSelection (in category 'menu commands') -----
- copyHtmlSelection
-
- self handleEdit: [textMorph editor copyHtmlSelection].!
Item was removed:
- ----- Method: PluggableTextMorph>>copySelection (in category 'menu commands') -----
- copySelection
- self handleEdit: [textMorph editor copySelection]!
Item was removed:
- ----- Method: PluggableTextMorph>>correctFrom:to:with: (in category 'interactive error protocol') -----
- correctFrom: start to: stop with: aString
- ^ self handleEdit: [textMorph editor correctFrom: start to: stop with: aString]!
Item was removed:
- ----- Method: PluggableTextMorph>>correctSelectionWithString: (in category 'interactive error protocol') -----
- correctSelectionWithString: aString
- | result newPosition |
-
- "I can't tell if this is a hack or if it's the right thing to do."
- self setSelection: selectionInterval.
-
- result := self correctFrom: selectionInterval first to: selectionInterval last with: aString.
- newPosition := selectionInterval first + aString size.
- self setSelection: (newPosition to: newPosition - 1).
- ^ result!
Item was removed:
- ----- Method: PluggableTextMorph>>cut (in category 'menu commands') -----
- cut
- self handleEdit: [textMorph editor cut]!
Item was removed:
- ----- Method: PluggableTextMorph>>debugIt (in category 'menu commands') -----
- debugIt
- self handleEdit: [textMorph editor debugIt]!
Item was removed:
- ----- Method: PluggableTextMorph>>displayScaleChangedBy: (in category 'display scale') -----
- displayScaleChangedBy: factor
-
- | currentMargins |
- super displayScaleChangedBy: factor.
- (currentMargins := self textMorph margins) isRectangle
- ifTrue: [self textMorph margins: ((currentMargins origin * factor) rounded corner: (currentMargins corner * factor) rounded)]
- ifFalse: [self textMorph margins: (currentMargins * factor) rounded].!
Item was removed:
- ----- Method: PluggableTextMorph>>doIt (in category 'menu commands') -----
- doIt
- ^ self handleEdit: [textMorph editor doIt]!
Item was removed:
- ----- Method: PluggableTextMorph>>drawFrameAdornment:on: (in category 'drawing') -----
- drawFrameAdornment: aColor on: aCanvas
- "Indicate edit status for the text editor"
- self class simpleFrameAdornments
- ifTrue:
- [ | adornmentWidth |
- adornmentWidth := ((self valueOfProperty: #frameAdornmentWidth ifAbsent: [1])
- * RealEstateAgent scaleFactor) truncated.
- aCanvas
- frameRectangle: self innerBounds
- width: adornmentWidth
- color: aColor.
- aCanvas
- frameRectangle: (self innerBounds insetBy: adornmentWidth)
- width: adornmentWidth
- color: (aColor alpha: aColor alpha / 3.0) ]
- ifFalse:
- [ | form |
- "Class-side adornment cache is currently using pre-multiplied alpha, so we need to use rule 34 which works for < 32bpp, too."
- form := self class adornmentWithColor: aColor.
- aCanvas
- image: form
- at: self innerBounds topRight - (form width @ 0)
- sourceRect: form boundingBox
- rule: 34 ]!
Item was removed:
- ----- Method: PluggableTextMorph>>drawFrameAdornmentsOn: (in category 'drawing') -----
- drawFrameAdornmentsOn: aCanvas
- "Include a thin red inset border for unaccepted edits, or, if the unaccepted edits are known to conflict with a change made somewhere else to the same method (typically), put a thick red frame"
-
- self wantsFrameAdornments ifFalse: [^ self].
-
- self readOnly ifTrue: [^ self drawFrameAdornment: (self valueOfProperty: #adornmentReadOnly ifAbsent: [Color black]) on: aCanvas].
-
- (model notNil and: [model refusesToAcceptCode])
- ifTrue: [
- "Put up feedback showing that code cannot be submitted in this state"
- ^ self drawFrameAdornment: (self valueOfProperty: #adornmentRefuse ifAbsent: [Color tan]) on: aCanvas].
-
- self hasEditingConflicts
- ifTrue: [^ self drawFrameAdornment: (self valueOfProperty: #adornmentConflict ifAbsent: [Color red]) on: aCanvas].
-
- self hasUnacceptedEdits ifTrue: [
- model wantsDiffFeedback
- ifTrue: [self drawFrameAdornment: (self valueOfProperty: #adornmentDiffEdit ifAbsent: [Color yellow]) on: aCanvas]
- ifFalse: [self drawFrameAdornment: (self valueOfProperty: #adornmentNormalEdit ifAbsent: [Color orange]) on: aCanvas].
- ^ self].
-
- model wantsDiffFeedback
- ifTrue: [self drawFrameAdornment: (self valueOfProperty: #adornmentDiff ifAbsent: [Color green]) on: aCanvas].!
Item was removed:
- ----- Method: PluggableTextMorph>>drawOverlayOn: (in category 'drawing') -----
- drawOverlayOn: aCanvas
- "Draw frame adornments on top of everything otherwise they will partially overlap with text selection which looks ugly."
-
- self drawWrapBorderOn: aCanvas.
- super drawOverlayOn: aCanvas.
- self drawFrameAdornmentsOn: aCanvas.
- !
Item was removed:
- ----- Method: PluggableTextMorph>>drawWrapBorderOn: (in category 'drawing') -----
- drawWrapBorderOn: aCanvas
-
- | box offset rect |
- self wantsWrapBorder ifFalse: [^ self].
- textMorph ifNil: [^ self].
-
- box := textMorph innerBounds.
- textMorph margins ifNotNil: [:m | box := box insetBy: m].
-
- offset := box left + (textMorph textStyle compositionWidthFor: self class
- visualWrapBorderLimit).
- self averageLineLength ifNotNil: [
- "Respect right margins only if we wrap at that border to not draw over glyphs."
- offset := offset + (textMorph innerBounds right - box right) + self borderWidth].
- offset > scroller width ifTrue: [^ self].
-
- rect := scroller topLeft + (offset @ 0) corner: scroller bottomRight.
-
- aCanvas
- fillRectangle: rect
- color: self wrapBorderColor.
- aCanvas
- line: rect topLeft
- to: rect bottomLeft
- width: self borderWidth
- color: (self wrapBorderColor muchDarker alpha: 0.5).!
Item was removed:
- ----- Method: PluggableTextMorph>>editString: (in category 'initialization') -----
- editString: aString
- "Jam some text in. This is treated as clean text by default."
-
- self setText: aString asText!
Item was removed:
- ----- Method: PluggableTextMorph>>editTextSelector (in category 'accessing') -----
- editTextSelector
-
- ^ editTextSelector!
Item was removed:
- ----- Method: PluggableTextMorph>>editTextSelector: (in category 'accessing') -----
- editTextSelector: aSymbol
-
- editTextSelector := aSymbol.!
Item was removed:
- ----- Method: PluggableTextMorph>>explain (in category 'menu commands') -----
- explain
- self handleEdit: [textMorph editor explain]!
Item was removed:
- ----- Method: PluggableTextMorph>>exploreIt (in category 'menu commands') -----
- exploreIt
- ^ self handleEdit: [textMorph editor exploreIt]!
Item was removed:
- ----- Method: PluggableTextMorph>>extraScrollRange (in category 'geometry') -----
- extraScrollRange
- ^ self height // 4!
Item was removed:
- ----- Method: PluggableTextMorph>>fileItIn (in category 'menu commands') -----
- fileItIn
- self handleEdit: [textMorph editor fileItIn]!
Item was removed:
- ----- Method: PluggableTextMorph>>find (in category 'menu commands') -----
- find
- self handleEdit: [textMorph editor find]!
Item was removed:
- ----- Method: PluggableTextMorph>>findAgain (in category 'menu commands') -----
- findAgain
- self handleEdit: [textMorph editor findAgain]!
Item was removed:
- ----- Method: PluggableTextMorph>>findReplace (in category 'menu commands') -----
- findReplace
- self handleEdit: [textMorph editor findReplace]!
Item was removed:
- ----- Method: PluggableTextMorph>>font: (in category 'model access') -----
- font: aFont
-
- self flag: #deprecated.
- self setFont: aFont.!
Item was removed:
- ----- Method: PluggableTextMorph>>getFont (in category 'model access') -----
- getFont
- "Retrieve the current model text font"
-
- | newFont |
- getFontSelector ifNil: [^ TextStyle defaultFont].
- newFont := model perform: getFontSelector.
- newFont ifNil: [^ TextStyle defaultFont].
- ^ newFont!
Item was removed:
- ----- Method: PluggableTextMorph>>getFontSelector (in category 'accessing') -----
- getFontSelector
-
- ^ getFontSelector!
Item was removed:
- ----- Method: PluggableTextMorph>>getFontSelector: (in category 'accessing') -----
- getFontSelector: aSelector
-
- getFontSelector := aSelector.!
Item was removed:
- ----- Method: PluggableTextMorph>>getSelection (in category 'model access') -----
- getSelection
- "Answer the model's selection interval. Default to the null selection if path to model unknown or model not initialized correctly."
-
- ^ getSelectionSelector
- ifNil: [1 to: 0]
- ifNotNil: [(model perform: getSelectionSelector) ifNil: [1 to: 0]]!
Item was removed:
- ----- Method: PluggableTextMorph>>getText (in category 'model access') -----
- getText
- "Retrieve the current model text"
-
- | newText |
- getTextSelector ifNil: [^Text new].
- newText := model perform: getTextSelector.
- newText ifNil: [^Text new].
- ^newText shallowCopy!
Item was removed:
- ----- Method: PluggableTextMorph>>getTextSelector (in category 'accessing') -----
- getTextSelector
- ^getTextSelector!
Item was removed:
- ----- Method: PluggableTextMorph>>getTextStyle (in category 'model access') -----
- getTextStyle
- "Retrieve the current model text style"
-
- | newStyle |
- getTextStyleSelector ifNil: [^ TextStyle default].
- newStyle := model perform: getTextStyleSelector.
- newStyle ifNil: [^ TextStyle default].
- ^ newStyle!
Item was removed:
- ----- Method: PluggableTextMorph>>getTextStyleSelector (in category 'accessing') -----
- getTextStyleSelector
-
- ^ getTextStyleSelector!
Item was removed:
- ----- Method: PluggableTextMorph>>getTextStyleSelector: (in category 'accessing') -----
- getTextStyleSelector: aSelector
-
- getTextStyleSelector := aSelector.!
Item was removed:
- ----- Method: PluggableTextMorph>>handleEdit: (in category 'editor access') -----
- handleEdit: editBlock
- | result |
- textMorph editor selectFrom: selectionInterval first to: selectionInterval last;
- model: model. "For, eg, evaluateSelection"
- result := textMorph handleEdit: editBlock. "Update selection after edit"
- self scrollSelectionIntoView.
- ^ result!
Item was removed:
- ----- Method: PluggableTextMorph>>hasEditingConflicts (in category 'unaccepted edits') -----
- hasEditingConflicts
- "Return true if a conflicting edit to the same code (typically) is known to have occurred after the current contents started getting edited"
-
- ^ hasEditingConflicts == true!
Item was removed:
- ----- Method: PluggableTextMorph>>hasEditingConflicts: (in category 'unaccepted edits') -----
- hasEditingConflicts: aBoolean
-
- hasEditingConflicts := aBoolean!
Item was removed:
- ----- Method: PluggableTextMorph>>hasFocus (in category 'accessing') -----
- hasFocus
-
- ^ super hasFocus or: [textMorph notNil and: [textMorph hasKeyboardFocus]]!
Item was removed:
- ----- Method: PluggableTextMorph>>hasUnacceptedEdits (in category 'unaccepted edits') -----
- hasUnacceptedEdits
- "Return true if this view has unaccepted edits."
-
- ^ hasUnacceptedEdits!
Item was removed:
- ----- Method: PluggableTextMorph>>hasUnacceptedEdits: (in category 'unaccepted edits') -----
- hasUnacceptedEdits: wasJustEdited
-
- wasJustEdited = hasUnacceptedEdits ifFalse: [
- hasUnacceptedEdits := wasJustEdited.
- self changed].
-
- wasJustEdited
- ifTrue: [self hasUserEdited: true]
- ifFalse: [self hasEditingConflicts: false].!
Item was removed:
- ----- Method: PluggableTextMorph>>hasUserEdited (in category 'unaccepted edits') -----
- hasUserEdited
-
- ^ hasUserEdited!
Item was removed:
- ----- Method: PluggableTextMorph>>hasUserEdited: (in category 'unaccepted edits') -----
- hasUserEdited: aBoolean
-
- hasUserEdited := aBoolean.!
Item was removed:
- ----- Method: PluggableTextMorph>>implementorsOfIt (in category 'menu commands') -----
- implementorsOfIt
- self handleEdit: [textMorph editor implementorsOfIt]!
Item was removed:
- ----- Method: PluggableTextMorph>>initialize (in category 'initialization') -----
- initialize
-
- self initializeTextMorph.
- super initialize.
-
- hasUnacceptedEdits := false.
- hasEditingConflicts := false.
- askBeforeDiscardingEdits := true.
-
- self minimumWidth: (TextStyle defaultFont widthOf: $m) * 10.
-
- scroller
- layoutPolicy: TableLayout new;
- addMorph: textMorph.
-
- "Reset minExtent because only now we can anser #isAutoFit correctly."
- self minimumExtent: 0 at 0; updateMinimumExtent.!
Item was removed:
- ----- Method: PluggableTextMorph>>initializeTextMorph (in category 'initialization') -----
- initializeTextMorph
-
- textMorph := self textMorphClass new
- margins: self class textMargins;
- setEditView: self;
- hResizing: #shrinkWrap;
- vResizing: #shrinkWrap;
- setProperty: #indicateKeyboardFocus toValue: #never;
- yourself.
-
- LegacyShortcutsFilter legacyShortcutsEnabled
- ifTrue: [textMorph addKeyboardCaptureFilter: LegacyShortcutsFilter].!
Item was removed:
- ----- Method: PluggableTextMorph>>inspectIt (in category 'menu commands') -----
- inspectIt
- ^ self handleEdit: [textMorph editor inspectIt]!
Item was removed:
- ----- Method: PluggableTextMorph>>installModelIn: (in category 'debug and other') -----
- installModelIn: aWorld
- "No special inits for new components"
- ^ self!
Item was removed:
- ----- Method: PluggableTextMorph>>isAutoFit (in category 'accessing') -----
- isAutoFit
- "Whether I adjust the contents of my scroller to save a scroll bar."
-
- ^ self wrapFlag!
Item was removed:
- ----- Method: PluggableTextMorph>>isTextView (in category 'testing') -----
- isTextView
- "True if the reciever is a view on a text model, such as a view on a TranscriptStream"
- ^true!
Item was removed:
- ----- Method: PluggableTextMorph>>isWrapped (in category 'testing') -----
- isWrapped
-
- ^ self wrapFlag!
Item was removed:
- ----- Method: PluggableTextMorph>>keyStroke: (in category 'event handling') -----
- keyStroke: evt
- "A keystroke was hit while the receiver had keyboard focus. Pass the keystroke on to my textMorph, and and also, if I have an event handler, pass it on to that handler"
-
- textMorph keyStroke: evt.
- self eventHandler ifNotNil:
- [self eventHandler keyStroke: evt fromMorph: self].
- !
Item was removed:
- ----- Method: PluggableTextMorph>>keyboardFocusDelegate (in category 'event handling') -----
- keyboardFocusDelegate
-
- ^ textMorph ifNil: [self]!
Item was removed:
- ----- Method: PluggableTextMorph>>makeProjectLink (in category 'menu commands') -----
- makeProjectLink
- self handleEdit: [textMorph editor makeProjectLink]!
Item was removed:
- ----- Method: PluggableTextMorph>>methodNamesContainingIt (in category 'menu commands') -----
- methodNamesContainingIt
- self handleEdit: [textMorph editor methodNamesContainingIt]!
Item was removed:
- ----- Method: PluggableTextMorph>>methodSourceContainingIt (in category 'menu commands') -----
- methodSourceContainingIt
- self handleEdit: [textMorph editor methodSourceContainingIt]!
Item was removed:
- ----- Method: PluggableTextMorph>>methodStringsContainingit (in category 'menu commands') -----
- methodStringsContainingit
- self handleEdit: [textMorph editor methodStringsContainingit]!
Item was removed:
- ----- Method: PluggableTextMorph>>mouseEnter: (in category 'event handling') -----
- mouseEnter: event
- "Restore the selection in the text morph if there was a selection."
-
- super mouseEnter: event.
-
- selectionInterval ifNotNil: [:interval |
- textMorph editor
- selectInterval: selectionInterval;
- setEmphasisHere].
-
- Preferences mouseOverForKeyboardFocus
- ifTrue: [event hand newKeyboardFocus: self].!
Item was removed:
- ----- Method: PluggableTextMorph>>mouseLeave: (in category 'event handling') -----
- mouseLeave: event
- "Save the selection interval for later."
-
- self rememberSelectionInterval.
-
- super mouseLeave: event.
-
- Preferences mouseOverForKeyboardFocus
- ifTrue: [event hand releaseKeyboardFocus: self]!
Item was removed:
- ----- Method: PluggableTextMorph>>nextTokenFrom:direction: (in category 'interactive error protocol') -----
- nextTokenFrom: start direction: dir
- ^ textMorph editor nextTokenFrom: start direction: dir!
Item was removed:
- ----- Method: PluggableTextMorph>>notify:at:in: (in category 'interactive error protocol') -----
- notify: aString at: anInteger in: aStream
- ^ textMorph editor notify: aString at: anInteger in: aStream!
Item was removed:
- ----- Method: PluggableTextMorph>>offerFontMenu (in category 'menu commands') -----
- offerFontMenu
- self handleEdit: [textMorph editor changeTextFont]!
Item was removed:
- ----- Method: PluggableTextMorph>>on:text:accept:readSelection:menu: (in category 'initialization') -----
- on: anObject text: getTextSel accept: setTextSel readSelection: getSelectionSel menu: getMenuSel
-
- self model: anObject.
- getTextSelector := getTextSel.
- setTextSelector := setTextSel.
- getSelectionSelector := getSelectionSel.
- getMenuSelector := getMenuSel.
- self setText: self getText.
- self setSelection: self getSelection.!
Item was removed:
- ----- Method: PluggableTextMorph>>onKeyStrokeSend:to: (in category 'event handling') -----
- onKeyStrokeSend: sel to: recipient
- textMorph on: #keyStroke send: sel to: recipient.!
Item was removed:
- ----- Method: PluggableTextMorph>>paste (in category 'menu commands') -----
- paste
- self handleEdit: [textMorph editor paste]!
Item was removed:
- ----- Method: PluggableTextMorph>>pasteRecent (in category 'menu commands') -----
- pasteRecent
- "Paste an item chosen from RecentClippings."
-
- | clipping |
- (clipping := Clipboard chooseRecentClipping) ifNil: [^ self].
- Clipboard clipboardText: clipping.
- ^ self handleEdit: [textMorph editor paste]!
Item was removed:
- ----- Method: PluggableTextMorph>>plainTextOnly (in category 'accessing') -----
- plainTextOnly
-
- ^ textMorph plainTextOnly!
Item was removed:
- ----- Method: PluggableTextMorph>>plainTextOnly: (in category 'accessing') -----
- plainTextOnly: aBoolean
-
- textMorph plainTextOnly: aBoolean.!
Item was removed:
- ----- Method: PluggableTextMorph>>presentSpecialMenu (in category 'menu commands') -----
- presentSpecialMenu
- self handleEdit: [textMorph editor presentSpecialMenu]!
Item was removed:
- ----- Method: PluggableTextMorph>>prettyPrint (in category 'menu commands') -----
- prettyPrint
- self handleEdit: [textMorph editor prettyPrint]!
Item was removed:
- ----- Method: PluggableTextMorph>>prettyPrintWithColor (in category 'menu commands') -----
- prettyPrintWithColor
- self handleEdit: [textMorph editor prettyPrintWithColor]!
Item was removed:
- ----- Method: PluggableTextMorph>>printIt (in category 'menu commands') -----
- printIt
- ^ self handleEdit: [textMorph editor printIt]!
Item was removed:
- ----- Method: PluggableTextMorph>>printerSetup (in category 'menu commands') -----
- printerSetup
- self handleEdit: [textMorph editor printerSetup]!
Item was removed:
- ----- Method: PluggableTextMorph>>promptForCancel (in category 'unaccepted edits') -----
- promptForCancel
- "Ask if it is OK to cancel changes to text"
- (self confirm:
- 'Changes have not been saved.
- Is it OK to cancel those changes?' translated)
- ifTrue: [model changed: #clearUserEdits].
- !
Item was removed:
- ----- Method: PluggableTextMorph>>readOnly (in category 'accessing') -----
- readOnly
-
- ^ textMorph readOnly!
Item was removed:
- ----- Method: PluggableTextMorph>>readOnly: (in category 'accessing') -----
- readOnly: aBoolean
-
- textMorph readOnly: aBoolean.!
Item was removed:
- ----- Method: PluggableTextMorph>>redo (in category 'menu commands') -----
- redo
- self handleEdit: [textMorph editor redo]!
Item was removed:
- ----- Method: PluggableTextMorph>>referencesToIt (in category 'menu commands') -----
- referencesToIt
- self handleEdit: [textMorph editor referencesToIt]!
Item was removed:
- ----- Method: PluggableTextMorph>>rememberSelectionInterval (in category 'private') -----
- rememberSelectionInterval
-
- self flag: #fixIntervalCache. "mt: We should find a better design for discarding unused text editors in text morphs and restoring them on demand."
- selectionInterval := textMorph editor markIndex to: textMorph editor pointIndex - 1.!
Item was removed:
- ----- Method: PluggableTextMorph>>replaceSelectionWith: (in category 'transcript') -----
- replaceSelectionWith: aText
- ^ textMorph editor replaceSelectionWith: aText!
Item was removed:
- ----- Method: PluggableTextMorph>>restoreSelectionInterval (in category 'editor access') -----
- restoreSelectionInterval
-
- selectionInterval ifNotNil: [
- self selectionInterval: selectionInterval].!
Item was removed:
- ----- Method: PluggableTextMorph>>scrollBarMenuButtonPressed: (in category 'scroll bar events') -----
- scrollBarMenuButtonPressed: event
- "The menu button in the scrollbar was pressed; put up the menu"
-
- | menu |
- (menu := self getMenu: event shiftPressed) ifNotNil:
- ["Set up to use perform:orSendTo: for model/view dispatch"
- menu setInvokingView: self.
- menu invokeModal]!
Item was removed:
- ----- Method: PluggableTextMorph>>scrollDeltaHeight (in category 'geometry') -----
- scrollDeltaHeight
- "Return the increment in pixels which this pane should be scrolled."
- ^ textMorph ifNil: [super scrollDeltaHeight] ifNotNil: [:tm | tm defaultLineHeight]
- !
Item was removed:
- ----- Method: PluggableTextMorph>>scrollSelectionIntoView (in category 'editor access') -----
- scrollSelectionIntoView
- "Scroll my text into view if necessary and return true, else return false"
- ^ self scrollSelectionIntoView: nil!
Item was removed:
- ----- Method: PluggableTextMorph>>scrollSelectionIntoView: (in category 'editor access') -----
- scrollSelectionIntoView: event
- "Scroll my text into view. Due to line composition mechanism, we must never use the right of a character block because the lines last character block right value always comes from a global container and is *not* line specific."
-
- self rememberSelectionInterval.
-
- textMorph editor hasSelection
- ifFalse: [self scrollToShow: (textMorph editor startBlock withWidth: 1)]
- ifTrue: [
- self scrollToShow: (textMorph editor startBlock topLeft corner: textMorph editor stopBlock bottomLeft).
- self scrollToShow: (textMorph editor pointBlock withWidth: 1). "Ensure text cursor visibility."].
-
- ^ true!
Item was removed:
- ----- Method: PluggableTextMorph>>selectAll (in category 'editor access') -----
- selectAll
-
- textMorph selectAll.
- self rememberSelectionInterval.!
Item was removed:
- ----- Method: PluggableTextMorph>>selectFrom:to: (in category 'interactive error protocol') -----
- selectFrom: start to: stop
-
- textMorph selectFrom: start to: stop.
- self rememberSelectionInterval.!
Item was removed:
- ----- Method: PluggableTextMorph>>selectInterval: (in category 'editor access') -----
- selectInterval: anInterval
-
- textMorph selectInterval: anInterval.
- self rememberSelectionInterval.!
Item was removed:
- ----- Method: PluggableTextMorph>>selectIntervalInvisibly: (in category 'interactive error protocol') -----
- selectIntervalInvisibly: aSelectionInterval
- ^ textMorph editor selectIntervalInvisibly: aSelectionInterval!
Item was removed:
- ----- Method: PluggableTextMorph>>selectInvisiblyFrom:to: (in category 'interactive error protocol') -----
- selectInvisiblyFrom: start to: stop
- ^ textMorph editor selectInvisiblyFrom: start to: stop!
Item was removed:
- ----- Method: PluggableTextMorph>>selectionInterval (in category 'editor access') -----
- selectionInterval
-
- ^ textMorph selectionInterval!
Item was removed:
- ----- Method: PluggableTextMorph>>selectionInterval: (in category 'editor access') -----
- selectionInterval: anInterval
-
- textMorph selectionInterval: anInterval.
- self rememberSelectionInterval.!
Item was removed:
- ----- Method: PluggableTextMorph>>sendContentsToPrinter (in category 'menu commands') -----
- sendContentsToPrinter
- self handleEdit: [textMorph editor sendContentsToPrinterWithLabel: owner knownName]!
Item was removed:
- ----- Method: PluggableTextMorph>>sendersOfIt (in category 'menu commands') -----
- sendersOfIt
- self handleEdit: [textMorph editor sendersOfIt]!
Item was removed:
- ----- Method: PluggableTextMorph>>setDefaultParameters (in category 'initialization') -----
- setDefaultParameters
-
- super setDefaultParameters.
-
- self textMorph textStyle defaultFont hasFixedWidth "mt: Law of Demeter ... Can we rely on text styles to only bundle similar fonts?"
- ifFalse: [self setTextStyle: (self userInterfaceTheme textStyle ifNil: [TextStyle default]) copy]
- ifTrue: [self setTextStyle: (self userInterfaceTheme textStyleFixed ifNil: [TextStyle defaultFixed]) copy].
-
- self setTextColor: (self userInterfaceTheme textColor ifNil: [Color black]).
- self wrapBorderColor: ((self userInterfaceTheme wrapBorderColorModifier ifNil: [ [:c | c muchLighter alpha: 0.3] ])
- value: self borderColor).
-
- self
- setProperty: #adornmentReadOnly
- toValue: (self userInterfaceTheme adornmentReadOnly ifNil: [Color black]);
- setProperty: #adornmentRefuse
- toValue: (self userInterfaceTheme adornmentRefuse ifNil: [Color tan]);
- setProperty: #adornmentConflict
- toValue: (self userInterfaceTheme adornmentConflict ifNil: [Color red]);
- setProperty: #adornmentDiff
- toValue: (self userInterfaceTheme adornmentDiff ifNil: [Color green]);
- setProperty: #adornmentNormalEdit
- toValue: (self userInterfaceTheme adornmentNormalEdit ifNil: [Color orange]);
- setProperty: #adornmentDiffEdit
- toValue: (self userInterfaceTheme adornmentDiffEdit ifNil: [Color yellow]).
-
- self
- setProperty: #frameAdornmentWidth
- toValue: (self userInterfaceTheme frameAdornmentWidth ifNil: [1]).
-
- textMorph
- caretColor: (self userInterfaceTheme caretColor ifNil: [Color red]);
- selectionColor: (self userInterfaceTheme selectionColor ifNil: [TranslucentColor r: 0.0 g: 0.0 b: 0.8 alpha: 0.2]);
- unfocusedSelectionColor: ((self userInterfaceTheme unfocusedSelectionModifier ifNil: [ [:c | Color gray: 0.9] ])
- value: textMorph selectionColor).!
Item was removed:
- ----- Method: PluggableTextMorph>>setFont: (in category 'model access') -----
- setFont: aFont
- textMorph font: aFont.!
Item was removed:
- ----- Method: PluggableTextMorph>>setSearchString (in category 'menu commands') -----
- setSearchString
- self handleEdit: [textMorph editor setSearchString]!
Item was removed:
- ----- Method: PluggableTextMorph>>setSelection: (in category 'model access') -----
- setSelection: anInterval
- "Sets a new selection of characters. If the argument is nil, give the model a chance to just leave the selection where it currently is."
-
- (anInterval notNil and: [anInterval ~= selectionInterval]) ifTrue: [
-
- "Note old selection."
- textMorph selectionChanged.
-
- "Update selection."
- selectionInterval := anInterval.
- textMorph editor selectFrom: anInterval first to: anInterval last.
-
- "Note new selection."
- textMorph selectionChanged].
-
- "Even if there is no change, ensure that the selection is visible."
- self scrollSelectionIntoView.!
Item was removed:
- ----- Method: PluggableTextMorph>>setText: (in category 'model access') -----
- setText: aText
-
- textMorph newContents: aText.
- self hasUnacceptedEdits: false.
- self setScrollDeltas.
-
- self flag: #performance. "mt: Needed only to redraw overlays such as the help text."
- self changed.!
Item was removed:
- ----- Method: PluggableTextMorph>>setTextColor: (in category 'model access') -----
- setTextColor: aColor
- "Set the color of my text to the given color"
-
- self flag: #todo. "See commentary in #font:. Maybe we cant to remove all current TextColor attributes here, too?"
- textMorph textColor: aColor!
Item was removed:
- ----- Method: PluggableTextMorph>>setTextMorphToSelectAllOnMouseEnter (in category 'editor access') -----
- setTextMorphToSelectAllOnMouseEnter
- "Tell my textMorph's editor to select all when the mouse enters"
-
- textMorph on: #mouseEnter send: #selectAll to: textMorph!
Item was removed:
- ----- Method: PluggableTextMorph>>setTextSelector (in category 'accessing') -----
- setTextSelector
- ^setTextSelector!
Item was removed:
- ----- Method: PluggableTextMorph>>setTextStyle: (in category 'model access') -----
- setTextStyle: aTextStyle
- "Always copy the argument to avoid messing up TextStyle >> #default."
-
- textMorph textStyle: aTextStyle copy.!
Item was removed:
- ----- Method: PluggableTextMorph>>spawn (in category 'menu commands') -----
- spawn
- self handleEdit: [textMorph editor spawn].
- self cancel!
Item was removed:
- ----- Method: PluggableTextMorph>>spyOnIt (in category 'menu commands') -----
- spyOnIt
- self handleEdit: [textMorph editor spyOnIt]!
Item was removed:
- ----- Method: PluggableTextMorph>>styler (in category 'accessing') -----
- styler
- "The styler responsible for highlighting text in the receiver.
- Instances of PluggableTextMorph don;t have one."
- ^nil!
Item was removed:
- ----- Method: PluggableTextMorph>>tallyIt (in category 'menu commands') -----
- tallyIt
- self handleEdit: [textMorph editor tallyIt]!
Item was removed:
- ----- Method: PluggableTextMorph>>text (in category 'model access') -----
- text
- ^ textMorph contents!
Item was removed:
- ----- Method: PluggableTextMorph>>textEdited: (in category 'editor access') -----
- textEdited: someText
- "Tell the model about some edits in the text if interested. This is not #accept, which means that it will be send on every keystroke."
-
- self editTextSelector ifNotNil: [:selector |
- model perform: selector with: someText].
-
- self flag: #performance. "mt: Needed only to redraw overlays such as the help text."
- self changed.!
Item was removed:
- ----- Method: PluggableTextMorph>>textMorph (in category 'accessing') -----
- textMorph
- ^ textMorph!
Item was removed:
- ----- Method: PluggableTextMorph>>textMorphClass (in category 'private') -----
- textMorphClass
- "Answer the class used to create the receiver's textMorph"
-
- ^TextMorphForEditView!
Item was removed:
- ----- Method: PluggableTextMorph>>tileForIt (in category 'menu commands') -----
- tileForIt
- "Return a tile referring to the object resulting form evaluating my current selection. Not currently threaded in, but useful in earlier demos and possibly still of value."
-
-
- self handleEdit:
- [textMorph editor evaluateSelectionAndDo: [:result | self currentHand attachMorph: result tileToRefer]]!
Item was removed:
- ----- Method: PluggableTextMorph>>toggleAnnotationPaneSize (in category 'menu commands') -----
- toggleAnnotationPaneSize
-
- | handle origin aHand siblings |
-
- self flag: #bob. "CRUDE HACK to enable changing the size of the annotations pane"
-
- owner ifNil: [^self].
- siblings := owner submorphs.
- siblings size > 3 ifTrue: [^self].
- siblings size < 2 ifTrue: [^self].
-
- aHand := self primaryHand.
- origin := aHand position.
- (handle := HandleMorph new)
- forEachPointDo: [:newPoint | | lf ht prevBottom newHeight m |
- handle removeAllMorphs.
- newHeight := (newPoint - origin) y asInteger min: owner height - 50 max: 16.
- lf := siblings last layoutFrame.
- lf bottomOffset: newHeight.
- prevBottom := newHeight.
- siblings size - 1 to: 1 by: -1 do: [ :index |
- m := siblings at: index.
- lf := m layoutFrame.
- ht := lf bottomOffset - lf topOffset.
- lf topOffset: prevBottom.
- lf bottomOffset = 0 ifFalse: [
- lf bottomOffset: (prevBottom + ht).
- ].
- prevBottom := prevBottom + ht.
- ].
- owner layoutChanged.
-
- ]
- lastPointDo:
- [:newPoint | handle deleteBalloon.
- self halo ifNotNil: [:halo | halo addHandles].
- ].
- aHand attachMorph: handle.
- handle setProperty: #helpAtCenter toValue: true.
- handle showBalloon:
- 'Move cursor farther from
- this point to increase pane.
- Click when done.' hand: aHand.
- handle startStepping
-
- !
Item was removed:
- ----- Method: PluggableTextMorph>>undo (in category 'menu commands') -----
- undo
- self handleEdit: [textMorph editor undo]!
Item was removed:
- ----- Method: PluggableTextMorph>>update: (in category 'updating') -----
- update: aSymbol
- aSymbol ifNil: [^self].
- aSymbol == #flash ifTrue: [^self flash].
-
- aSymbol == getTextSelector
- ifTrue: [
- self setText: self getText.
- getSelectionSelector
- ifNotNil: [self setSelection: self getSelection].
- ^ self].
- aSymbol == getSelectionSelector
- ifTrue: [^self setSelection: self getSelection].
-
- aSymbol == getTextStyleSelector
- ifTrue: [^ self setTextStyle: self getTextStyle].
- aSymbol == getFontSelector
- ifTrue: [^ self setFont: self getFont].
-
- aSymbol == #acceptChanges ifTrue: [^ self accept].
- aSymbol == #revertChanges ifTrue: [^ self cancelSafely].
-
- (aSymbol == #autoSelect and: [getSelectionSelector notNil])
- ifTrue:
- [self handleEdit:
- [(textMorph editor)
- abandonChangeText; "no replacement!!"
- setSearch: model autoSelectString;
- findAgainNow "do not reset search string"]].
- aSymbol == #clearUserEdits ifTrue: [^self hasUnacceptedEdits: false].
- aSymbol == #wantToChange
- ifTrue:
- [self canDiscardEdits ifFalse: [^self promptForCancel].
- ^self].
- aSymbol == #appendEntry
- ifTrue:
- [self handleEdit: [self appendEntry].
- ^self refreshWorld].
- aSymbol == #appendEntryLater
- ifTrue: [self handleEdit: [self appendEntry]].
- aSymbol == #clearText
- ifTrue:
- [self handleEdit: [self changeText: Text new].
- ^self refreshWorld].
- aSymbol == #bs
- ifTrue:
- [self handleEdit: [self bsText].
- ^self refreshWorld].
- aSymbol == #codeChangedElsewhere
- ifTrue:
- [self hasEditingConflicts: true.
- ^self changed].
- aSymbol == #saveContents
- ifTrue:
- [^(self respondsTo: #saveContentsInFile) ifTrue: [self saveContentsInFile]].
- aSymbol == #showContents
- ifTrue:
- [^ self scrollToTop].
- !
Item was removed:
- ----- Method: PluggableTextMorph>>update:with: (in category 'updating') -----
- update: aSymbol with: arg1
-
- aSymbol == #editString
- ifTrue: [
- self editString: arg1.
- self hasUnacceptedEdits: true.
- ^ self].
-
- (aSymbol == #inputRequested and: [self getTextSelector == arg1 or: [self setTextSelector == arg1]])
- ifTrue: [
- self activeHand newKeyboardFocus: self.
- ^ self].
-
- aSymbol == #textStyle
- ifTrue: [
- self setTextStyle: arg1.
- ^ self].
-
- aSymbol == #font
- ifTrue: [
- self setFont: arg1.
- ^ self].
-
-
- ^super update: aSymbol with: arg1!
Item was removed:
- ----- Method: PluggableTextMorph>>wantsBalloon (in category 'halos and balloon help') -----
- wantsBalloon
-
- ^ self textMorph contents notEmpty and: [super wantsBalloon]!
Item was removed:
- ----- Method: PluggableTextMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
- wantsDroppedMorph: aMorph event: anEvent
- ^ self model wantsDroppedMorph: aMorph event: anEvent inMorph: self!
Item was removed:
- ----- Method: PluggableTextMorph>>wantsFrameAdornments (in category 'drawing') -----
- wantsFrameAdornments
- "Answer whether the receiver wishes to have red borders, etc.,
- used to show editing state"
- "A 'long-term temporary workaround': a nonmodular,
- unsavory, but expedient way to get the desired effect, sorry.
- Clean up someday."
- ^ self
- valueOfProperty: #wantsFrameAdornments
- ifAbsent: [(#(#annotation #searchString #infoViewContents ) includes: getTextSelector) not]!
Item was removed:
- ----- Method: PluggableTextMorph>>wantsFrameAdornments: (in category 'drawing') -----
- wantsFrameAdornments: aBoolean
- self setProperty: #wantsFrameAdornments toValue: aBoolean!
Item was removed:
- ----- Method: PluggableTextMorph>>wantsWrapBorder (in category 'accessing') -----
- wantsWrapBorder
-
- ^ wantsWrapBorder ifNil: [false]!
Item was removed:
- ----- Method: PluggableTextMorph>>wantsWrapBorder: (in category 'accessing') -----
- wantsWrapBorder: aBoolean
-
- wantsWrapBorder = aBoolean ifTrue: [^ self].
- wantsWrapBorder := aBoolean.
- self changed.!
Item was removed:
- ----- Method: PluggableTextMorph>>wrapBorderColor (in category 'accessing') -----
- wrapBorderColor
-
- ^ self valueOfProperty: #wrapBorderColor ifAbsent: [Color gray alpha: 0.3]!
Item was removed:
- ----- Method: PluggableTextMorph>>wrapBorderColor: (in category 'accessing') -----
- wrapBorderColor: aColor
-
- self setProperty: #wrapBorderColor toValue: aColor.
- self changed.!
Item was removed:
- ----- Method: PluggableTextMorph>>wrapFlag (in category 'accessing') -----
- wrapFlag
-
- ^ textMorph ifNil: [false] ifNotNil: [:tm | tm isWrapped]!
Item was removed:
- ----- Method: PluggableTextMorph>>wrapFlag: (in category 'accessing') -----
- wrapFlag: aBoolean
-
- textMorph ifNil: [self setText: ''].
-
- aBoolean
- ifTrue: [
- textMorph hResizing: #spaceFill.
- self hideHScrollBarIndefinitely]
- ifFalse: [
- textMorph hResizing: #shrinkWrap.
- self showHScrollBarOnlyWhenNeeded].
-
- self layoutChanged.!
Item was removed:
- ----- Method: PluggableTextMorph>>yellowButtonActivity (in category 'menu commands') -----
- yellowButtonActivity
- "Called when the shifted-menu's 'more' item is chosen"
- self yellowButtonActivity: false!
Item was removed:
- PluggableTextMorph subclass: #PluggableTextMorphWithModel
- instanceVariableNames: 'myContents'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Pluggable Widgets'!
Item was removed:
- ----- Method: PluggableTextMorphWithModel class>>authoringPrototype (in category 'scripting') -----
- authoringPrototype
- "Answer an instance of the receiver suitable for placing in a parts bin"
-
- | proto |
- proto := super authoringPrototype.
- proto color: (Color r: 0.972 g: 0.972 b: 0.662).
- ^ proto!
Item was removed:
- ----- Method: PluggableTextMorphWithModel>>delete (in category 'submorphs - add/remove') -----
- delete
- "Delete the receiver. Since I have myself as a dependent, I need to remove it. which is odd in itself. Also, the release of dependents will seemingly not be done if the *container* of the receiver is deleted rather than the receiver itself, a further problem"
-
- self removeDependent: self.
- super delete!
Item was removed:
- ----- Method: PluggableTextMorphWithModel>>getMyText (in category 'contents') -----
- getMyText
- ^myContents!
Item was removed:
- ----- Method: PluggableTextMorphWithModel>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- self
- on: self
- text: #getMyText
- accept: #setMyText:
- readSelection: nil
- menu: nil!
Item was removed:
- ----- Method: PluggableTextMorphWithModel>>newTextContents: (in category 'contents') -----
- newTextContents: stringOrText
- "Accept new text contents."
-
- | newText myText |
- "Just underway; trying to make this work like TextMorph does, but not quite there yet."
-
- newText := stringOrText asText.
- (myText := textMorph text) = newText ifTrue: [^ self]. "No substantive change"
-
- self world ifNotNil:
- [self world startSteppingSubmorphsOf: self ].
- !
Item was removed:
- ----- Method: PluggableTextMorphWithModel>>setMyText: (in category 'contents') -----
- setMyText: someText
- myContents := someText.
- ^true.!
Item was removed:
- BorderedMorph subclass: #PolygonMorph
- instanceVariableNames: 'vertices closed filledForm arrows arrowForms smoothCurve curveState borderDashSpec handles borderForm'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Basic'!
-
- !PolygonMorph commentStamp: 'md 2/24/2006 20:34' prior: 0!
- This class implements a morph which can behave as four different objects depending on the the following two facts:
- - is it OPEN or CLOSED?
- - is it SEGMENTED or SMOOTHED.
-
- 1. The OPEN and SEGMENTED variant looks like polyline.
-
- 2. The OPEN and SMOOTHED variant looks like spline (kind of curve)
-
- 3. The CLOSED and SEGMENTED variant looks like polygon. This is actually what you get when you do
- PolygonMorph new openInWorld
- You get a triangle. See below how to manipulate these objects...
-
- 4. The CLOSED and SMOOTHED variant looks like blob (???)
-
- Prototypes of this morph can also be found in "Object Catalog". Several (different variants) of this object are among "Basic" morphs.
-
- Explore the assiciated morph-menu. It enables you
- - to toggle showing of "handles". They make it possible to
- - reposition already existing vertices (by moving yellow handles)
- - create new vertices (by moving green handles)
- - delete already existing vertices (by dragging and dropping one yellow handle closely
- nearby the adjacent yellow handle
- Handles can be made visible/hidden by shift+leftclicking the morph. This way it is possible
- to quickly show handles, adjust vertices and then again hide handles.
- - making closed polygon open, i.e. converting it to a curve (and vice versa)
- - toggle smoothed/segmented line/outline
- - set up custom dashing (for line, curves or borders of closed polygons
- - set up custom arrow-heads (for lines resp. curves)
-
- ------------------------------------------------------------------------------------------
- Implementation notes:
-
- This class combines the old Polygon and Curve classes.
-
- The 1-bit fillForm to make display and containment tests reasonably fast. However, this functionality is in the process of being supplanted by balloon capabilities, which should eventually provide anti-aliasing as well.
-
- wiz 7/18/2004 21:26
- s have made some changes to this class to
-
- 1) correct some bugs associated with one vertex polygons.
-
- 2) prepare for some enhancements with new curves.
-
- 3) add shaping items to menu.!
Item was removed:
- ----- Method: PolygonMorph class>>arrowPrototype (in category 'instance creation') -----
- arrowPrototype
- "Answer an instance of the receiver that will serve as a prototypical arrow"
-
- | aa |
- aa := self new.
- aa vertices: (Array with: 0 at 0 with: 40 at 40)
- color: Color black
- borderWidth: 2
- borderColor: Color black.
- "aa setProperty: #noNewVertices toValue: true."
- "Revert to expected behavior. Remove vestigial code."
- aa makeForwardArrow. "is already open"
- aa computeBounds.
- ^ aa!
Item was removed:
- ----- Method: PolygonMorph class>>descriptionForPartsBin (in category 'parts bin') -----
- descriptionForPartsBin
- ^ self partName: 'Polygon' translatedNoop
- categories: {'Graphics' translatedNoop. 'Basic' translatedNoop}
- documentation: 'A series of connected line segments, which may be a closed solid, or a zig-zag line. Shift-click to get handles and move the points.' translatedNoop!
Item was removed:
- ----- Method: PolygonMorph class>>fromHand: (in category 'instance creation') -----
- fromHand: hand
- "Let the user draw a polygon, clicking at each vertex, and ending
- by clicking within 5 of the first point..."
- | p1 poly oldVerts pN opposite |
- Cursor crossHair showWhile:
- [[Sensor anyButtonPressed] whileFalse:
- [self currentWorld displayWorldSafely; runStepMethods].
- p1 := Sensor cursorPoint].
- opposite := (Display colorAt: p1) negated.
- opposite = Color transparent ifTrue: [opposite := Color red].
- (poly := LineMorph from: p1 to: p1 color: opposite width: 2) openInWorld.
- oldVerts := {p1}.
- self currentWorld displayWorldSafely; runStepMethods.
-
- [[Sensor anyButtonPressed] whileTrue:
- [pN := Sensor cursorPoint.
- poly setVertices: (oldVerts copyWith: pN).
- self currentWorld displayWorldSafely; runStepMethods].
- (oldVerts size > 1 and: [(pN dist: p1) < 5]) ifTrue:
- [hand position: Sensor cursorPoint. "Done -- update hand pos"
- ^ (poly setVertices: (poly vertices copyWith: p1)) delete].
- oldVerts := poly vertices.
- [Sensor anyButtonPressed] whileFalse:
- [pN := Sensor cursorPoint.
- poly setVertices: (oldVerts copyWith: pN).
- self currentWorld displayWorldSafely; runStepMethods]] repeat!
Item was removed:
- ----- Method: PolygonMorph class>>fromHandFreehand: (in category 'instance creation') -----
- fromHandFreehand: hand
- "Let the user draw a polygon, holding the mouse down, and ending
- by clicking within 5 of the first point..."
- | p1 poly pN opposite |
- Cursor crossHair showWhile:
- [[Sensor anyButtonPressed] whileFalse:
- [self currentWorld displayWorldSafely; runStepMethods].
- p1 := Sensor cursorPoint].
- opposite := (Display colorAt: p1) negated.
- opposite = Color transparent ifTrue: [opposite := Color red].
- (poly := LineMorph from: p1 to: p1 color: opposite width: 2) openInWorld.
- self currentWorld displayWorldSafely; runStepMethods.
- [Sensor anyButtonPressed] whileTrue:
- [pN := Sensor cursorPoint.
- (pN dist: poly vertices last) > 3 ifTrue:
- [poly setVertices: (poly vertices copyWith: pN).
- self currentWorld displayWorldSafely; runStepMethods]].
- hand position: Sensor cursorPoint. "Done -- update hand pos"
- ^ (poly setVertices: (poly vertices copyWith: p1)) delete!
Item was removed:
- ----- Method: PolygonMorph class>>shapeFromPen:color:borderWidth:borderColor: (in category 'instance creation') -----
- shapeFromPen: penBlock color: c borderWidth: bw borderColor: bc
- "World addMorph: (PolygonMorph
- shapeFromPen: [:p | p hilbert: 4 side: 5. p go: 5.
- p hilbert: 4 side: 5. p go: 5]
- color: Color red borderWidth: 1 borderColor: Color black)"
-
- | pen |
- penBlock value: (pen := PenPointRecorder new).
- ^ (self vertices: pen points asArray color: c borderWidth: bw borderColor: bc)
- quickFill: false!
Item was removed:
- ----- Method: PolygonMorph class>>vertices:color:borderWidth:borderColor: (in category 'instance creation') -----
- vertices: verts color: c borderWidth: bw borderColor: bc
- ^ self basicNew beStraightSegments vertices: verts color: c borderWidth: bw borderColor: bc!
Item was removed:
- ----- Method: PolygonMorph>>addCustomMenuItems:hand: (in category 'menu') -----
- addCustomMenuItems: aMenu hand: aHandMorph
- "Add morph-specific items to the given menu which was invoked by the given hand. This method provides is invoked both from the halo-menu and from the control-menu regimes."
-
- super addCustomMenuItems: aMenu hand: aHandMorph.
- aMenu addUpdating: #handlesShowingPhrase target: self action: #showOrHideHandles.
- vertices size > 2 ifTrue:
- [aMenu addUpdating: #openOrClosePhrase target: self action: #makeOpenOrClosed].
-
- aMenu addUpdating: #smoothPhrase target: self action: #toggleSmoothing.
- aMenu addLine.
- aMenu add: 'specify dashed line' translated action: #specifyDashedLine.
-
- self isOpen ifTrue:
- [aMenu addLine.
- aMenu addWithLabel: '---' enablement: [self isOpen and: [arrows ~~ #none]] action: #makeNoArrows.
- aMenu addWithLabel: '-->' enablement: [self isOpen and: [arrows ~~ #forward]] action: #makeForwardArrow.
- aMenu addWithLabel: '<--' enablement: [self isOpen and: [arrows ~~ #back]] action: #makeBackArrow.
- aMenu addWithLabel: '<->' enablement: [self isOpen and: [arrows ~~ #both]] action: #makeBothArrows.
- aMenu add: 'customize arrows' translated action: #customizeArrows:.
- (self hasProperty: #arrowSpec)
- ifTrue: [aMenu add: 'standard arrows' translated action: #standardArrows]].!
Item was removed:
- ----- Method: PolygonMorph>>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: PolygonMorph>>addHandles (in category 'editing') -----
- addHandles
- "Put moving handles at the vertices. Put adding handles at
- edge midpoints.
- Moving over adjacent vertex and dropping will delete a
- vertex. "
- | tri |
- self removeHandles.
- handles := OrderedCollection new.
- tri := Array
- with: 0 @ -4
- with: 4 @ 3
- with: -3 @ 3.
- tri := (tri * RealEstateAgent scaleFactor) truncated.
- vertices
- withIndexDo: [:vertPt :vertIndex |
- | handle |
- handle := EllipseMorph
- newBounds: (Rectangle center: vertPt extent: (8 at 8) * RealEstateAgent scaleFactor)
- color: (self handleColorAt: vertIndex) .
- handle disableLayout: true.
- handle
- on: #mouseMove
- send: #dragVertex:event:fromHandle:
- to: self
- withValue: vertIndex.
- handle
- on: #mouseUp
- send: #dropVertex:event:fromHandle:
- to: self
- withValue: vertIndex.
- handle
- on: #click
- send: #clickVertex:event:fromHandle:
- to: self
- withValue: vertIndex.
- self addMorph: handle.
- handles addLast: handle.
- (closed
- or: [1 = vertices size
- "Give a small polygon a chance to grow.
- -wiz"
- or: [vertIndex < vertices size]])
- ifTrue: [| newVert |
- newVert := PolygonMorph
- vertices: (tri
- collect: [:p | p + (vertPt
- + (vertices atWrap: vertIndex + 1) // 2)])
- color: Color green
- borderWidth: 1
- borderColor: Color black.
- newVert disableLayout: true.
- newVert
- on: #mouseDown
- send: #newVertex:event:fromHandle:
- to: self
- withValue: vertIndex.
- self addMorph: newVert.
- handles addLast: newVert]].
- self isCurvy
- ifTrue: [self updateHandles; layoutChanged].
- self changed!
Item was removed:
- ----- Method: PolygonMorph>>addPolyArrowMenuItems:hand: (in category 'menu') -----
- addPolyArrowMenuItems: aMenu hand: aHandMorph
- aMenu addLine.
- aMenu
- addWithLabel: '---'
- enablement: [self isOpen
- and: [arrows ~~ #none]]
- action: #makeNoArrows.
- aMenu
- addWithLabel: '-->'
- enablement: [self isOpen
- and: [arrows ~~ #forward]]
- action: #makeForwardArrow.
- aMenu
- addWithLabel: '<--'
- enablement: [self isOpen
- and: [arrows ~~ #back]]
- action: #makeBackArrow.
- aMenu
- addWithLabel: '<->'
- enablement: [self isOpen
- and: [arrows ~~ #both]]
- action: #makeBothArrows.
- aMenu add: 'customize arrows' translated action: #customizeArrows:.
- (self hasProperty: #arrowSpec)
- ifTrue: [aMenu add: 'standard arrows' translated action: #standardArrows]!
Item was removed:
- ----- Method: PolygonMorph>>addPolyLIneCurveMenuItems:hand: (in category 'menu') -----
- addPolyLIneCurveMenuItems: aMenu hand: aHandMorph
-
- aMenu addLine;
- addUpdating: #openOrClosePhrase
- target: self
- action: #makeOpenOrClosed.
-
- aMenu
- addUpdating: #smoothOrSegmentedPhrase
- target: self
- action: #toggleSmoothing.!
Item was removed:
- ----- Method: PolygonMorph>>addPolyShapingMenuItems:hand: (in category 'menu') -----
- addPolyShapingMenuItems: aMenu hand: aHandMorph
- aMenu addLine.
- aMenu
- addWithLabel: 'make inscribed diamondOval'
- enablement: [self isClosed ]
- action: #diamondOval.
- aMenu
- addWithLabel: 'make enclosing rectangleOval'
- enablement: [self isClosed ]
- action: #rectOval.
- !
Item was removed:
- ----- Method: PolygonMorph>>areasRemainingToFill: (in category 'drawing') -----
- areasRemainingToFill: aRectangle
- "Could be improved by quick check of inner rectangle"
-
- ^ Array with: aRectangle!
Item was removed:
- ----- Method: PolygonMorph>>arrowBoundsAt:from: (in category 'private') -----
- arrowBoundsAt: endPoint from: priorPoint
- "Answer a triangle oriented along the line from priorPoint to endPoint."
- | d v angle wingBase arrowSpec length width |
- v := endPoint - priorPoint.
- angle := v degrees.
- d := self borderWidth max: 1.
- arrowSpec := self valueOfProperty: #arrowSpec ifAbsent: [5 at 4].
- length := arrowSpec x abs. width := arrowSpec y abs.
- wingBase := endPoint + (Point r: d * length degrees: angle + 180.0).
- arrowSpec x >= 0
- ifTrue: [^ { endPoint.
- wingBase + (Point r: d * width degrees: angle + 125.0).
- wingBase + (Point r: d * width degrees: angle - 125.0) }]
- ifFalse: ["Negative length means concave base."
- ^ { endPoint.
- wingBase + (Point r: d * width degrees: angle + 125.0).
- wingBase.
- wingBase + (Point r: d * width degrees: angle - 125.0) }]!
Item was removed:
- ----- Method: PolygonMorph>>arrowForms (in category 'private') -----
- arrowForms
- "ArrowForms are computed only upon demand"
- arrowForms
- ifNotNil: [^ arrowForms].
- arrowForms := Array new.
- self hasArrows
- ifFalse: [^ arrowForms].
- (arrows == #forward
- or: [arrows == #both])
- ifTrue: [arrowForms := arrowForms
- copyWith: (self computeArrowFormAt: vertices last from: self nextToLastPoint)].
- (arrows == #back
- or: [arrows == #both])
- ifTrue: [arrowForms := arrowForms
- copyWith: (self computeArrowFormAt: vertices first from: self nextToFirstPoint)].
- ^ arrowForms!
Item was removed:
- ----- Method: PolygonMorph>>arrowLength: (in category 'menu') -----
- arrowLength: aLength
- "Assumes that I have exactly two vertices"
-
- | theta horizontalOffset verticalOffset newTip delta |
- delta := vertices second - vertices first.
- theta := delta theta.
- horizontalOffset := aLength * (theta cos).
- verticalOffset := aLength * (theta sin).
- newTip := vertices first + (horizontalOffset @ verticalOffset).
- self verticesAt: 2 put: newTip!
Item was removed:
- ----- Method: PolygonMorph>>arrowSpec: (in category 'menu') -----
- arrowSpec: specPt
- "Specify a custom arrow for this line.
- specPt x abs gives the length of the arrow (point to base) in terms of borderWidth.
- If specPt x is negative, then the base of the arrow will be concave.
- specPt y abs gives the width of the arrow.
- The standard arrow is equivalent to arrowSpec: 5 at 4.
- See arrowBoundsAt:From: for details."
-
- self setProperty: #arrowSpec toValue: specPt.
- self computeBounds!
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>>beSmoothCurve (in category 'initialization') -----
- beSmoothCurve
-
- smoothCurve == true ifFalse:
- [smoothCurve := true.
- self computeBounds]!
Item was removed:
- ----- Method: PolygonMorph>>beStraightSegments (in category 'initialization') -----
- beStraightSegments
-
- smoothCurve == false ifFalse:
- [smoothCurve := false.
- self computeBounds]!
Item was removed:
- ----- Method: PolygonMorph>>borderColor: (in category 'accessing') -----
- borderColor: aColor
- "Recompute fillForm and borderForm if translucency of border changes."
-
- super borderColor: aColor.
-
- (self borderColor isColor and: [self borderColor isTranslucentColor])
- == (aColor isColor and: [aColor isTranslucentColor])
- ifFalse: [self releaseCachedState]!
Item was removed:
- ----- Method: PolygonMorph>>borderDashOffset (in category 'dashes') -----
- borderDashOffset
- borderDashSpec size < 4 ifTrue: [^0.0].
- ^(borderDashSpec fourth) asFloat!
Item was removed:
- ----- Method: PolygonMorph>>borderDashSpec (in category 'accessing') -----
- borderDashSpec
- ^ borderDashSpec!
Item was removed:
- ----- Method: PolygonMorph>>borderForm (in category 'private') -----
- borderForm
- "A form must be created for drawing the border whenever the borderColor is translucent."
-
- | borderCanvas |
- borderForm ifNotNil: [^ borderForm].
- borderCanvas := (Display defaultCanvasClass extent: bounds extent depth: 1)
- shadowColor: Color black.
- borderCanvas translateBy: bounds topLeft negated
- during:[:tempCanvas| self drawBorderOn: tempCanvas].
- borderForm := borderCanvas form.
- self arrowForms do:
- [:f | "Eliminate overlap between line and arrowheads if transparent."
- borderForm copy: f boundingBox from: f to: f offset - self position rule: Form erase].
- ^ borderForm!
Item was removed:
- ----- Method: PolygonMorph>>borderStyle: (in category 'accessing') -----
- borderStyle: aBorderStyle
-
- super borderStyle: aBorderStyle.
- self computeBounds!
Item was removed:
- ----- Method: PolygonMorph>>borderWidth: (in category 'accessing') -----
- borderWidth: anInteger
-
- super borderWidth: anInteger.
- self computeBounds!
Item was removed:
- ----- Method: PolygonMorph>>bounds: (in category 'geometry') -----
- bounds: newBounds
- "This method has to be reimplemented since self extent: will also change self bounds origin,
- super bounds would leave me in wrong position when container is growing.
- Always change extent first then position"
-
- self extent: newBounds extent; position: newBounds topLeft
- !
Item was removed:
- ----- Method: PolygonMorph>>canHaveFillStyles (in category 'visual properties') -----
- canHaveFillStyles
- "Return true if the receiver can have general fill styles; not just colors.
- This method is for gradually converting old morphs."
- ^true!
Item was removed:
- ----- Method: PolygonMorph>>clickVertex:event:fromHandle: (in category 'editing') -----
- clickVertex: ix event: evt fromHandle: handle
- "Backstop for MixedCurveMorph"!
Item was removed:
- ----- Method: PolygonMorph>>closestPointTo: (in category 'geometry') -----
- closestPointTo: aPoint
- | closestPoint minDist |
- closestPoint := minDist := nil.
- self lineSegmentsDo:
- [:p1 :p2 | | dist curvePoint |
- curvePoint := aPoint nearestPointOnLineFrom: p1 to: p2.
- dist := curvePoint dist: aPoint.
- (closestPoint isNil or: [dist < minDist])
- ifTrue:
- [closestPoint := curvePoint.
- minDist := dist]].
- ^closestPoint!
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>>coefficients (in category 'smoothing') -----
- coefficients
- "Compute an array for the coefficients."
- | verts vertXs vertYs slopeXs slopeYs coefficients |
- curveState
- ifNotNil: [^ curveState at: 1].
- verts := self vertices.
- verts size < 1
- ifTrue: [^ self].
- "Less than three points handled as segments by our
- lineSegmentsDo:"
- (self isCurvier)
- ifFalse: [closed
- ifTrue: [verts := verts , verts first asOrderedCollection]].
- coefficients := {
- vertXs := verts collect: [:p | p x asFloat].
- slopeXs := self slopes: vertXs.
- vertXs changeInSlopes: slopeXs.
- vertXs changeOfChangesInSlopes: slopeXs.
- vertYs := verts collect: [:p | p y asFloat].
- slopeYs := self slopes: vertYs.
- vertYs changeInSlopes: slopeYs.
- vertYs changeOfChangesInSlopes: slopeYs.
- Array new: verts size withAll: 12}.
- coefficients
- at: 9
- put: ((1 to: verts size)
- collect: [:i | (coefficients cubicPointPolynomialAt: i) bestSegments]).
- (self isCurvier)
- ifFalse: [closed
- ifTrue: [coefficients := coefficients
- collect: [:each | each allButLast]]].
- curveState := {coefficients. nil. nil}.
- self computeNextToEndPoints.
- ^ coefficients!
Item was removed:
- ----- Method: PolygonMorph>>computeArrowFormAt:from: (in category 'private') -----
- computeArrowFormAt: endPoint from: priorPoint
- "Compute a triangle oriented along the line from priorPoint to
- endPoint. Then draw those lines in a form and return that
- form, with appropriate offset"
-
- | p1 pts box arrowForm bb origin |
- pts := self arrowBoundsAt: endPoint from: priorPoint.
- box := ((pts first rect: pts last) encompass: (pts second)) expandBy: 1.
- arrowForm := Form extent: box extent asIntegerPoint.
- bb := (BitBlt toForm: arrowForm)
- sourceForm: nil;
- fillColor: Color black;
- combinationRule: Form over;
- width: 1;
- height: 1.
- origin := box topLeft.
- p1 := pts last - origin.
- pts do:
- [:p |
- bb drawFrom: p1 to: p - origin.
- p1 := p - origin].
- arrowForm convexShapeFill: Color black.
- ^arrowForm offset: box topLeft!
Item was removed:
- ----- Method: PolygonMorph>>computeBounds (in category 'private') -----
- computeBounds
- | oldBounds delta excludeHandles |
-
- self flag: #refactor. "mt: Make it lazy like all layout policies in Morph. See #fullBounds and #doLayoutIn:."
-
- vertices ifNil: [^ self].
-
- self changed.
- oldBounds := bounds.
- self releaseCachedState.
- bounds := self curveBounds expanded copy.
- self arrowForms do:
- [:f | bounds swallow: (f offset extent: f extent)].
- handles ifNotNil: [self updateHandles].
-
- "since we are directly updating bounds, see if any ordinary submorphs exist and move them accordingly"
- (oldBounds notNil and: [(delta := bounds origin - oldBounds origin) ~= (0 at 0)]) ifTrue: [
- excludeHandles := IdentitySet new.
- handles ifNotNil: [excludeHandles addAll: handles].
- self submorphsDo: [ :each |
- (excludeHandles includes: each) ifFalse: [
- each position: each position + delta
- ].
- ].
- ].
- self layoutChanged.
- self changed.
- !
Item was removed:
- ----- Method: PolygonMorph>>computeNextToEndPoints (in category 'smoothing') -----
- computeNextToEndPoints
- | pointAfterFirst pointBeforeLast |
- pointAfterFirst := nil.
- self lineSegmentsDo:
- [:p1 :p2 |
- pointAfterFirst ifNil: [pointAfterFirst := p2 asIntegerPoint].
- pointBeforeLast := p1 asIntegerPoint].
- curveState at: 2 put: pointAfterFirst.
- curveState at: 3 put: pointBeforeLast!
Item was removed:
- ----- Method: PolygonMorph>>containsPoint: (in category 'geometry testing') -----
- containsPoint: aPoint
- (super containsPoint: aPoint) ifFalse: [^ false].
-
- closed & color isTransparent not ifTrue:
- [^ (self filledForm pixelValueAt: aPoint - self topLeft + 1) > 0].
-
- self lineSegmentsDo:
- [:p1 :p2 |
- (aPoint onLineFrom: p1 to: p2 within: (3 max: self borderWidth+1//2) asFloat)
- ifTrue: [^ true]].
-
- self arrowForms do:
- [:f | (f pixelValueAt: aPoint - f offset) > 0 ifTrue: [^ true]].
-
- ^ false!
Item was removed:
- ----- Method: PolygonMorph>>convertToCurrentVersion:refStream: (in category 'objects from disk') -----
- convertToCurrentVersion: varDict refStream: smartRefStrm
-
- smoothCurve ifNil: [smoothCurve := false].
- ^super convertToCurrentVersion: varDict refStream: smartRefStrm.
-
- !
Item was removed:
- ----- Method: PolygonMorph>>cornerStyle: (in category 'rounding') -----
- cornerStyle: aSymbol
- "Set the receiver's corner style. But, in this case, do *not*"
-
- self removeProperty: #cornerStyle.
- self changed!
Item was removed:
- ----- Method: PolygonMorph>>couldHaveRoundedCorners (in category 'accessing') -----
- couldHaveRoundedCorners
- ^ false!
Item was removed:
- ----- Method: PolygonMorph>>curveBounds (in category 'private') -----
- curveBounds
- "Compute the bounds from actual curve traversal, with
- leeway for borderWidth.
- Also note the next-to-first and next-to-last points for arrow
- directions."
- "wiz - to avoid roundoff errors we return unrounded curvebounds."
- "we expect our receiver to take responsibility for approriate rounding adjustment."
- "hint: this is most likely 'self curveBounds expanded' "
- | pointAfterFirst pointBeforeLast oX oY cX cY |
- self isCurvy
- ifFalse: [^ (Rectangle encompassing: vertices)
- expandBy: self borderWidth * 0.5 ].
- curveState := nil.
- "Force recomputation"
- "curveBounds := vertices first corner: vertices last."
- pointAfterFirst := nil.
- self
- lineSegmentsDo: [:p1 :p2 |
- pointAfterFirst isNil
- ifTrue: [pointAfterFirst := p2 floor .
- oX := cX := p1 x.
- oY := cY := p1 y. ].
- "curveBounds := curveBounds encompass: p2 ."
- oX:= oX min: p2 x.
- cX := cX max: p2 x.
- oY := oY min: p2 y.
- cY := cY max: p2 y.
- pointBeforeLast := p1 floor ].
- curveState at: 2 put: pointAfterFirst.
- curveState at: 3 put: pointBeforeLast.
- ^ ( oX @ oY corner: cX @ cY ) expandBy: self borderWidth * 0.5 !
Item was removed:
- ----- Method: PolygonMorph>>customizeArrows: (in category 'menu') -----
- customizeArrows: evt
- | handle origin aHand |
- aHand := evt ifNil: [self primaryHand] ifNotNil: [evt hand].
- origin := aHand position.
- (handle := HandleMorph new)
- forEachPointDo:
- [:newPoint | handle removeAllMorphs.
- handle addMorph:
- (LineMorph from: origin to: newPoint color: Color black width: 1).
- self arrowSpec: (newPoint - origin) / 5.0]
- lastPointDo:
- [:newPoint | handle deleteBalloon.
- self halo ifNotNil: [:halo | halo addHandles].].
- aHand attachMorph: handle.
- handle setProperty: #helpAtCenter toValue: true.
- handle showBalloon:
- 'Move cursor left and right
- to change arrow length and style.
- Move it up and down to change width.
- Click when done.' hand: evt hand.
- handle startStepping!
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>>dashedBorder: (in category 'dashes') -----
- dashedBorder: dashSpec
- "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."
-
- borderDashSpec := dashSpec.
- self changed!
Item was removed:
- ----- Method: PolygonMorph>>defaultAttachmentPointSpecs (in category 'attachments') -----
- defaultAttachmentPointSpecs
- ^{
- { #firstVertex } .
- { #midpoint } .
- { #lastVertex }
- }!
Item was removed:
- ----- Method: PolygonMorph>>defaultBorderColor (in category 'initialization') -----
- defaultBorderColor
- "answer the default border color/fill style for the receiver"
-
- ^ Color black
-
- "Until September 2007, this had long been...
- ^ Color
- r: 0.0
- g: 0.419
- b: 0.935"!
Item was removed:
- ----- Method: PolygonMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color orange!
Item was removed:
- ----- Method: PolygonMorph>>deleteVertexAt: (in category 'editing') -----
- deleteVertexAt: anIndex
- "This acts as a backstop for MixedCurveMorph."
- self
- setVertices: (vertices
- copyReplaceFrom: anIndex
- to: anIndex
- with: Array new).
- !
Item was removed:
- ----- Method: PolygonMorph>>derivs:first:second:third: (in category 'smoothing') -----
- derivs: a first: point1 second: point2 third: point3
- "Compute the first, second and third derivitives (in coeffs) from
- the Points in this Path (coeffs at: 1 and coeffs at: 5)."
-
- | len v anArray |
- len := a size.
- len < 2 ifTrue: [^self].
- len > 2
- ifTrue:
- [v := Array new: len.
- v at: 1 put: 4.0.
- anArray := Array new: len.
- anArray at: 1 put: 6.0 * (a first - (a second * 2.0) + (a third)).
- 2 to: len - 2
- do:
- [:i |
- v at: i put: 4.0 - (1.0 / (v at: i - 1)).
- anArray at: i
- put: 6.0 * ((a at: i) - ((a at: i + 1) * 2.0) + (a at: i + 2))
- - ((anArray at: i - 1) / (v at: i - 1))].
- point2 at: len - 1 put: (anArray at: len - 2) / (v at: len - 2).
- len - 2 to: 2
- by: 0 - 1
- do:
- [:i |
- point2 at: i
- put: ((anArray at: i - 1) - (point2 at: i + 1)) / (v at: i - 1)]].
- point2 at: 1 put: (point2 at: len put: 0.0).
- 1 to: len - 1
- do:
- [:i |
- point1 at: i
- put: (a at: i + 1) - (a at: i)
- - (((point2 at: i) * 2.0 + (point2 at: i + 1)) / 6.0).
- point3 at: i put: (point2 at: i + 1) - (point2 at: i)]!
Item was removed:
- ----- Method: PolygonMorph>>diamondOval (in category 'shaping') -----
- diamondOval
- "Set my vertices to an array of edge midpoint vertices.
- Order of vertices is in the tradion of warpblt quads."
- | b r |
- b := self bounds.
- r := {b leftCenter. b bottomCenter. b rightCenter. b topCenter}.
- self setVertices: r!
Item was removed:
- ----- Method: PolygonMorph>>dragVertex:event:fromHandle: (in category 'editing') -----
- dragVertex: ix event: evt fromHandle: handle
- | p |
- p := evt cursorPoint.
- self flag: #workaround. "mt: Explicitely check for grid layout in owner to then let the vertex snap to that grid."
- (self owner notNil and: [self owner layoutPolicy notNil and: [self owner layoutPolicy isGridLayout]])
- ifTrue: [p := self owner layoutPolicy griddedPoint: p in: self owner].
- handle position: p - (handle extent//2).
- self verticesAt: ix put: p.
- !
Item was removed:
- ----- Method: PolygonMorph>>dragVertex:fromHandle:vertIndex: (in category 'editing') -----
- dragVertex: arg1 fromHandle: arg2 vertIndex: arg3
- "Reorder the arguments for existing event handlers"
- (arg3 isMorph and:[arg3 eventHandler notNil]) ifTrue:[arg3 eventHandler fixReversedValueMessages].
- ^self dragVertex: arg1 event: arg2 fromHandle: arg3!
Item was removed:
- ----- Method: PolygonMorph>>drawArrowOn:at:from: (in category 'drawing') -----
- drawArrowOn: aCanvas at: endPoint from: priorPoint
- "Draw a triangle oriented along the line from priorPoint to
- endPoint. Answer the wingBase."
-
- | pts spec wingBase |
- pts := self arrowBoundsAt: endPoint from: priorPoint.
- wingBase := pts size = 4
- ifTrue: [pts third]
- ifFalse: [(pts copyFrom: 2 to: 3) average].
- spec := self valueOfProperty: #arrowSpec ifAbsent: [5 @ 4].
- spec x sign = spec y sign
- ifTrue: [aCanvas drawPolygon: pts fillStyle: self borderColor]
- ifFalse:
- [aCanvas
- drawPolygon: pts
- fillStyle: Color transparent
- borderWidth: (self borderWidth + 1) // 2
- borderColor: self borderColor].
- ^wingBase!
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"
- self 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>>drawBorderOn: (in category 'drawing') -----
- drawBorderOn: aCanvas
- self
- drawClippedBorderOn: aCanvas
- usingEnds: (Array with: vertices first with: vertices last)!
Item was removed:
- ----- Method: PolygonMorph>>drawBorderOn:usingEnds: (in category 'drawing') -----
- drawBorderOn: aCanvas usingEnds: anArray
- "Display my border on the canvas."
- "NOTE: Much of this code is also copied in
- drawDashedBorderOn:
- (should be factored)"
- | bigClipRect style |
- borderDashSpec
- ifNotNil: [^ self drawDashedBorderOn: aCanvas usingEnds: anArray].
- style := self borderStyle.
- bigClipRect := aCanvas clipRect expandBy: self borderWidth + 1 // 2.
- self
- lineSegmentsDo: [:p1 :p2 | | p2i p1i |
- p1i := p1 asIntegerPoint.
- p2i := p2 asIntegerPoint.
- self hasArrows
- ifTrue: ["Shorten line ends so as not to interfere with tip
- of arrow."
- ((arrows == #back
- or: [arrows == #both])
- and: [p1 = vertices first])
- ifTrue: [p1i := anArray first asIntegerPoint].
- ((arrows == #forward
- or: [arrows == #both])
- and: [p2 = vertices last])
- ifTrue: [p2i := anArray last asIntegerPoint]].
- (closed
- or: ["bigClipRect intersects: (p1i rect: p2i)
- optimized:"
- ((p1i min: p2i)
- max: bigClipRect origin)
- <= ((p1i max: p2i)
- min: bigClipRect corner)])
- ifTrue: [style
- drawLineFrom: p1i
- to: p2i
- on: aCanvas]]!
Item was removed:
- ----- Method: PolygonMorph>>drawClippedBorderOn:usingEnds: (in category 'drawing') -----
- drawClippedBorderOn: aCanvas usingEnds: anArray
- aCanvas clipBy: self bounds during:[:cc| self drawBorderOn: cc usingEnds: anArray].!
Item was removed:
- ----- Method: PolygonMorph>>drawDashedBorderOn: (in category 'drawing') -----
- drawDashedBorderOn: aCanvas
- self
- drawDashedBorderOn: aCanvas
- usingEnds: (Array with: vertices first with: vertices last)!
Item was removed:
- ----- Method: PolygonMorph>>drawDashedBorderOn:usingEnds: (in category 'drawing') -----
- drawDashedBorderOn: aCanvas usingEnds: anArray
- "Display my border on the canvas. NOTE: mostly copied from
- drawBorderOn:"
- | bevel topLeftColor bottomRightColor bigClipRect lineColor segmentOffset |
- (self borderColor isNil
- or: [self borderColor isColor
- and: [self borderColor isTransparent]])
- ifTrue: [^ self].
- lineColor := self borderColor.
- bevel := false.
- "Border colors for bevelled effects depend on CW ordering of
- vertices"
- self borderStyle style == #raised
- ifTrue: [topLeftColor := self color lighter.
- bottomRightColor := self color darker.
- bevel := true].
- self borderStyle style == #inset
- ifTrue: [topLeftColor := owner colorForInsets darker.
- bottomRightColor := owner colorForInsets lighter.
- bevel := true].
- bigClipRect := aCanvas clipRect expandBy: self borderWidth + 1 // 2.
- segmentOffset := self borderDashOffset.
- self
- lineSegmentsDo: [:p1 :p2 | | p1i p2i |
- p1i := p1 asIntegerPoint.
- p2i := p2 asIntegerPoint.
- self hasArrows
- ifTrue: ["Shorten line ends so as not to interfere with tip
- of arrow."
- ((arrows == #back
- or: [arrows == #both])
- and: [p1 = vertices first])
- ifTrue: [p1i := anArray first asIntegerPoint].
- ((arrows == #forward
- or: [arrows == #both])
- and: [p2 = vertices last])
- ifTrue: [p2i := anArray last asIntegerPoint]].
- (closed
- or: ["bigClipRect intersects: (p1i rect: p2i)
- optimized:"
- ((p1i min: p2i)
- max: bigClipRect origin)
- <= ((p1i max: p2i)
- min: bigClipRect corner)])
- ifTrue: [bevel
- ifTrue: [lineColor := (p1i quadrantOf: p2i)
- > 2
- ifTrue: [topLeftColor]
- ifFalse: [bottomRightColor]].
- segmentOffset := aCanvas
- line: p1i
- to: p2i
- width: self borderWidth
- color: lineColor
- dashLength: self borderDashSpec first
- secondColor: self borderDashSpec third
- secondDashLength: self borderDashSpec second
- startingOffset: segmentOffset]]!
Item was removed:
- ----- Method: PolygonMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- "Display the receiver, a spline curve, approximated by straight
- line segments."
- | array |
- vertices size < 1
- ifTrue: [self error: 'a polygon must have at least one point'].
- closed ifTrue:
- [aCanvas drawPolygon: self getVertices fillStyle: self fillStyle.
- aCanvas isShadowDrawing ifTrue: [^ self]].
- array := self drawArrowsOn: aCanvas.
- self drawClippedBorderOn: aCanvas usingEnds: array.
- !
Item was removed:
- ----- Method: PolygonMorph>>drawOnFormCanvas: (in category 'drawing') -----
- drawOnFormCanvas: aCanvas
- "Display the receiver, a spline curve, approximated by straight line segments."
-
- | |
- vertices size < 1 ifTrue: [self error: 'a polygon must have at least one point'].
- closed & color isTransparent not
- ifTrue: [aCanvas stencil: self filledForm at: self bounds topLeft - 1 color: self color].
- (self borderColor isColor and: [self borderColor isTranslucentColor])
- ifTrue: [aCanvas stencil: self borderForm at: self bounds topLeft
- color: self borderColor]
- ifFalse: [self drawBorderOn: aCanvas].
- self arrowForms do:
- [:f | aCanvas stencil: f at: f offset
- color: (self borderColor isColor ifTrue: [self borderColor] ifFalse: [self color])]!
Item was removed:
- ----- Method: PolygonMorph>>dropVertex:event:fromHandle: (in category 'editing') -----
- dropVertex: ix event: evt fromHandle: handle
- "Leave vertex in new position. If dropped ontop another vertex delete this one.
- Check for too few vertices before deleting. The alternative
- is not pretty -wiz"
- | p |
- p := vertices at: ix.
- (vertices size >= 2
- and: ["check for too few vertices before deleting. The alternative
- is not pretty -wiz"
- ((vertices atWrap: ix - 1)
- dist: p)
- < 3
- or: [((vertices atWrap: ix + 1)
- dist: p)
- < 3]])
- ifTrue: ["Drag a vertex onto its neighbor means delete"
- self deleteVertexAt: ix .].
- evt shiftPressed
- ifTrue: [self removeHandles]
- ifFalse: [self addHandles
- "remove then add to recreate"]!
Item was removed:
- ----- Method: PolygonMorph>>dropVertex:fromHandle:vertIndex: (in category 'editing') -----
- dropVertex: arg1 fromHandle: arg2 vertIndex: arg3
- "Reorder the arguments for existing event handlers"
- (arg3 isMorph and:[arg3 eventHandler notNil]) ifTrue:[arg3 eventHandler fixReversedValueMessages].
- ^self dropVertex: arg1 event: arg2 fromHandle: arg3!
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 at 0 ]
- ].
- transform := MorphicTransform offset: 0 at 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>>extent: (in category 'geometry') -----
- extent: newExtent
- "Not really advisable, but we can preserve most of the geometry if we don't
- shrink things too small."
- | safeExtent |
- (self extent closeTo: newExtent) ifTrue: [^ self].
- safeExtent := newExtent max: self minimumExtent.
- self setVertices: (vertices collect:
- [:p | p - self position * (safeExtent asFloatPoint / (bounds extent max: 1 at 1)) + self position])!
Item was removed:
- ----- Method: PolygonMorph>>fillStyle (in category 'visual properties') -----
- fillStyle
- "Answer the receiver's fillStyle. For an *open* polygon, we return the borderColor, provided it's a true color rather than something strange like the symbol #raised."
-
- | aColor |
- self isOpen
- ifTrue:
- [(aColor := self borderColor) isColor ifTrue: [^ aColor]]. "easy access to line color from halo -- di's old note"
-
- ^ super fillStyle!
Item was removed:
- ----- Method: PolygonMorph>>fillStyle: (in category 'visual properties') -----
- fillStyle: newColor
-
- self isOpen
- ifTrue: [^ self borderColor: newColor asColor "easy access to line color from halo"]
- ifFalse: [^ super fillStyle: newColor]!
Item was removed:
- ----- Method: PolygonMorph>>filledForm (in category 'private') -----
- filledForm
- "Note: The filled form is actually 2 pixels bigger than bounds, and the point corresponding to this morphs' position is at 1 at 1 in the form. This is due to the details of the fillig routines, at least one of which requires an extra 1-pixel margin around the outside. Computation of the filled form is done only on demand."
- | bb origin |
- closed ifFalse: [^ filledForm := nil].
- filledForm ifNotNil: [^ filledForm].
- filledForm := Form extent: bounds extent+2.
-
- "Draw the border..."
- bb := (BitBlt toForm: filledForm) sourceForm: nil; fillColor: Color black;
- combinationRule: Form over; width: 1; height: 1.
- origin := bounds topLeft asIntegerPoint-1.
- self lineSegmentsDo: [:p1 :p2 | bb drawFrom: p1 asIntegerPoint-origin
- to: p2 asIntegerPoint-origin].
-
- "Fill it in..."
- filledForm convexShapeFill: Color black.
-
- (self borderColor isColor and: [self borderColor isTranslucentColor]) ifTrue:
- ["If border is stored as a form, then erase any overlap now."
- filledForm copy: self borderForm boundingBox from: self borderForm
- to: 1 at 1 rule: Form erase].
-
- ^ filledForm!
Item was removed:
- ----- Method: PolygonMorph>>firstVertex (in category 'attachments') -----
- firstVertex
- ^vertices first!
Item was removed:
- ----- Method: PolygonMorph>>flipHAroundX: (in category 'geometry') -----
- flipHAroundX: centerX
- "Flip me horizontally around the center. If centerX is nil, compute my center of gravity."
-
- | cent |
- cent := centerX
- ifNil: [bounds center x
- "cent := 0.
- vertices do: [:each | cent := cent + each x].
- cent asFloat / vertices size"] "average is the center"
- ifNotNil: [centerX].
- self setVertices: (vertices collect: [:vv |
- ((vv x - cent) * -1 + cent) @ vv y]) reversed.!
Item was removed:
- ----- Method: PolygonMorph>>flipVAroundY: (in category 'geometry') -----
- flipVAroundY: centerY
- "Flip me vertically around the center. If centerY is nil, compute my center of gravity."
-
- | cent |
- cent := centerY
- ifNil: [bounds center y
- "cent := 0.
- vertices do: [:each | cent := cent + each y].
- cent asFloat / vertices size"] "average is the center"
- ifNotNil: [centerY].
- self setVertices: (vertices collect: [:vv |
- vv x @ ((vv y - cent) * -1 + cent)]) reversed.!
Item was removed:
- ----- Method: PolygonMorph>>getVertices (in category 'private') -----
- getVertices
-
- smoothCurve ifFalse: [^ vertices].
-
- "For curves, enumerate the full set of interpolated points"
- ^ Array streamContents:
- [:s | self lineSegmentsDo: [:pt1 :pt2 | s nextPut: pt1]]!
Item was removed:
- ----- Method: PolygonMorph>>handleColorAt: (in category 'editing') -----
- handleColorAt: vertIndex
- "This is a backstop for MixedCurveMorph"
-
- ^ Color yellow
- !
Item was removed:
- ----- Method: PolygonMorph>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: evt
-
- ^ (super handlesMouseDown: evt) or: [evt shiftPressed]!
Item was removed:
- ----- Method: PolygonMorph>>handlesShowingPhrase (in category 'menu') -----
- handlesShowingPhrase
- "Answer a phrase characterizing whether handles are showing or not."
-
- ^ (self showingHandles ifTrue: ['<yes>'] ifFalse: ['<no>']), ('show handles' translated)!
Item was removed:
- ----- Method: PolygonMorph>>hasArrows (in category 'testing') -----
- hasArrows
- "Are all the conditions meet for having arrows?"
- ^ (closed
- or: [arrows == #none
- or: [vertices size < 2]]) not!
Item was removed:
- ----- Method: PolygonMorph>>heading (in category 'rotate scale and flex') -----
- heading
- "Overwritten to store the angle in #forwardDirection."
-
- ^ self rotationDegrees!
Item was removed:
- ----- Method: PolygonMorph>>heading: (in category 'rotate scale and flex') -----
- heading: newHeading
- "Overwritten to store the angle in #forwardDirection."
-
- self rotationDegrees: newHeading.!
Item was removed:
- ----- Method: PolygonMorph>>includesHandle: (in category 'private') -----
- includesHandle: aMorph
-
- handles ifNil: [^ false].
- ^ handles includes: aMorph!
Item was removed:
- ----- Method: PolygonMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
- self minimumExtent: 20 at 20.
- vertices := Array
- with: 5 @ 0
- with: 20 @ 10
- with: 0 @ 20.
- closed := true.
- smoothCurve := false.
- arrows := #none.
- self computeBounds!
Item was removed:
- ----- Method: PolygonMorph>>insertVertexAt:put: (in category 'editing') -----
- insertVertexAt: anIndex put: aValue
- "This serves as a hook and a backstop for MixedCurveMorph."
- self setVertices: (vertices copyReplaceFrom: anIndex + 1 to: anIndex
- with: (Array with: aValue)).!
Item was removed:
- ----- Method: PolygonMorph>>installModelIn: (in category 'debug and other') -----
- installModelIn: aWorld
- aWorld isWorldMorph ifTrue: [self addHandles]!
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>>isClosed (in category 'access') -----
- isClosed
- ^ closed!
Item was removed:
- ----- Method: PolygonMorph>>isCurve (in category 'access') -----
- isCurve
- ^ smoothCurve!
Item was removed:
- ----- Method: PolygonMorph>>isCurvier (in category 'testing') -----
- isCurvier
- "Test used by smoothing routines. If true use true closed curve splines for closed curves. If not mimic old stodgy curveMorph curves with one sharp bend.. Override this routine in classes where backward compatability is still needed."
- ^ CurvierMorph drawCurvier!
Item was removed:
- ----- Method: PolygonMorph>>isCurvy (in category 'testing') -----
- isCurvy
- "Test for significant curves.
- Small smoothcurves in practice are straight."
- ^ smoothCurve
- and: [vertices size > 2]!
Item was removed:
- ----- Method: PolygonMorph>>isLineMorph (in category 'testing') -----
- isLineMorph
- ^closed not!
Item was removed:
- ----- Method: PolygonMorph>>isOpen (in category 'access') -----
- isOpen
- ^ 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>>lineSegments (in category 'private') -----
- lineSegments
- | lineSegments |
- lineSegments := OrderedCollection new.
- self lineSegmentsDo: [:p1 :p2 | lineSegments addLast: (Array with: p1 with: p2)].
- ^ lineSegments!
Item was removed:
- ----- Method: PolygonMorph>>lineSegmentsDo: (in category 'smoothing') -----
- lineSegmentsDo: endPointsBlock
- "Emit a sequence of segment endpoints into endPointsBlock."
- "Unlike the method this one replaces we expect the curve
- coefficents not the dirivatives"
- "Also unlike the replaced method the smooth closed curve
- does
- not need an extra vertex.
- We take care of the extra endpoint here. Just like for
- segmented curves."
- | cs x y beginPoint |
- vertices size < 1
- ifTrue: [^ self].
- "test too few vertices first"
- self isCurvy
- ifFalse: [beginPoint := nil.
- "smoothCurve
- ifTrue: [cs := self coefficients]."
- "some things still depend on smoothCurves having
- curveState"
- vertices
- do: [:vert |
- beginPoint
- ifNotNil: [endPointsBlock value: beginPoint value: vert].
- beginPoint := vert].
- (closed
- or: [vertices size = 1])
- ifTrue: [endPointsBlock value: beginPoint value: vertices first].
- ^ self].
- "For curves we include all the interpolated sub segments."
- "self assert: [(vertices size > 2 )]. "
- cs := self coefficients.
- beginPoint := (x := cs first first) @ (y := cs fifth first).
- (closed
- ifTrue: [1 to: cs first size]
- ifFalse: [1 to: cs first size - 1])
- do: [:i | | x1 y1 endPoint n y2 t x3 y3 x2 |
- "taylor series coefficients"
- x1 := cs second at: i.
- y1 := cs sixth at: i.
- x2 := cs third at: i.
- y2 := cs seventh at: i.
- x3 := cs fourth at: i.
- y3 := cs eighth at: i.
- n := cs ninth at: i.
- "guess n
- n := 5 max: (x2 abs + y2 abs * 2.0 + (cs third atWrap:
- i
- + 1) abs + (cs seventh atWrap: i + 1) abs / 100.0)
- rounded."
- 1
- to: n - 1
- do: [:j |
- t := j asFloat / n asFloat.
- endPoint := x3 * t + x2 * t + x1 * t + x @ (y3 * t + y2 * t + y1 * t + y).
- endPointsBlock value: beginPoint value: endPoint.
- beginPoint := endPoint].
- endPoint := (x := cs first atWrap: i + 1) @ (y := cs fifth atWrap: i + 1).
- endPointsBlock value: beginPoint value: endPoint.
- beginPoint := endPoint]!
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>>loadCachedState (in category 'caching') -----
- loadCachedState
- "Prepare for fast response -- next page of a book?"
- self filledForm.
- self arrowForms!
Item was removed:
- ----- Method: PolygonMorph>>makeBackArrow (in category 'menu') -----
- makeBackArrow
- arrows := #back.
- self computeBounds!
Item was removed:
- ----- Method: PolygonMorph>>makeBothArrows (in category 'menu') -----
- makeBothArrows
- arrows := #both.
- self computeBounds!
Item was removed:
- ----- Method: PolygonMorph>>makeClosed (in category 'menu') -----
- makeClosed
- closed := true.
- handles ifNotNil: [self removeHandles; addHandles].
- self computeBounds!
Item was removed:
- ----- Method: PolygonMorph>>makeForwardArrow (in category 'menu') -----
- makeForwardArrow
- arrows := #forward.
- self computeBounds!
Item was removed:
- ----- Method: PolygonMorph>>makeNoArrows (in category 'menu') -----
- makeNoArrows
- arrows := #none.
- self computeBounds!
Item was removed:
- ----- Method: PolygonMorph>>makeOpen (in category 'menu') -----
- makeOpen
- closed := false.
- handles ifNotNil: [self removeHandles; addHandles].
- self computeBounds!
Item was removed:
- ----- Method: PolygonMorph>>makeOpenOrClosed (in category 'access') -----
- makeOpenOrClosed
- "toggle the open/closed status of the receiver"
- closed ifTrue: [self makeOpen] ifFalse: [self makeClosed]!
Item was removed:
- ----- Method: PolygonMorph>>merge: (in category 'geometry') -----
- merge: aPolygon
- "Expand myself to enclose the other polygon. (Later merge overlapping or disjoint in a smart way.) For now, the two polygons must share at least two vertices. Shared vertices must come one after the other in each polygon. Polygons must not overlap."
-
- | shared mv vv hv xx |
- shared := vertices select: [:mine | aPolygon vertices includes: mine].
- shared size < 2 ifTrue: [^nil]. "not sharing a segment"
- mv := vertices asOrderedCollection.
- [shared includes: mv first] whileFalse:
- ["rotate them"
-
- vv := mv removeFirst.
- mv addLast: vv].
- hv := aPolygon vertices asOrderedCollection.
- [mv first = hv first] whileFalse:
- ["rotate him until same shared vertex is first"
-
- vv := hv removeFirst.
- hv addLast: vv].
- [shared size > 2] whileTrue:
- [shared := shared asOrderedCollection.
- (self
- mergeDropThird: mv
- in: hv
- from: shared) ifNil: [^nil]].
- "works by side effect on the lists"
- (mv second) = hv last
- ifTrue:
- [mv
- removeFirst;
- removeFirst.
- ^self setVertices: (hv , mv) asArray].
- (hv second) = mv last
- ifTrue:
- [hv
- removeFirst;
- removeFirst.
- ^self setVertices: (mv , hv) asArray].
- (mv second) = (hv second)
- ifTrue:
- [hv removeFirst.
- mv remove: (mv second).
- xx := mv removeFirst.
- ^self setVertices: (hv , (Array with: xx) , mv reversed) asArray].
- mv last = hv last
- ifTrue:
- [mv removeLast.
- hv removeFirst.
- ^self setVertices: (mv , hv reversed) asArray].
- ^nil!
Item was removed:
- ----- Method: PolygonMorph>>mergeDropThird:in:from: (in category 'geometry') -----
- mergeDropThird: mv in: hv from: shared
- "We are merging two polygons. In this case, they have at least three identical shared vertices. Make sure they are sequential in each, and drop the middle one from vertex lists mv, hv, and shared. First vertices on lists are identical already."
-
- "know (mv first = hv first)"
-
- | mdrop vv |
- (shared includes: (mv at: mv size - 2))
- ifTrue: [(shared includes: mv last) ifTrue: [mdrop := mv last]]
- ifFalse:
- [(shared includes: mv last)
- ifTrue: [(shared includes: mv second) ifTrue: [mdrop := mv first]]].
- (shared includes: (mv third))
- ifTrue: [(shared includes: mv second) ifTrue: [mdrop := mv second]].
- mdrop ifNil: [^nil].
- mv remove: mdrop.
- hv remove: mdrop.
- shared remove: mdrop.
- [shared includes: mv first] whileFalse:
- ["rotate them"
-
- vv := mv removeFirst.
- mv addLast: vv].
- [mv first = hv first] whileFalse:
- ["rotate him until same shared vertex is first"
-
- vv := hv removeFirst.
- hv addLast: vv]!
Item was removed:
- ----- Method: PolygonMorph>>midVertices (in category 'access') -----
- midVertices
- "Return and array of midpoints for this line or closed curve"
- | midPts nextVertIx tweens |
- vertices size < 2
- ifTrue: [^ vertices].
- midPts := OrderedCollection new.
- nextVertIx := 2.
- tweens := OrderedCollection new.
- tweens add: vertices first asIntegerPoint.
- "guarantee at least two points."
- self
- lineSegmentsDo: [:p1 :p2 |
- tweens addLast: p2 asIntegerPoint.
- p2
- = (vertices atWrap: nextVertIx)
- ifTrue: ["Found endPoint."
- midPts addLast: (tweens atWrap: tweens size + 1 // 2)
- + (tweens at: tweens size // 2 + 1) // 2.
- "wiz 6/19/2004 20:11 adjusted to handle
- one segment properly"
- tweens := OrderedCollection new.
- tweens add: p2 asIntegerPoint.
- "guarantee at least two points."
- nextVertIx := nextVertIx + 1]].
- ^ midPts asArray!
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>>mouseDown: (in category 'event handling') -----
- mouseDown: evt
- "Handle a mouse-down event."
-
- ^ (evt shiftPressed and: [(self hasProperty: #activateOnShift) not])
- ifTrue: [((owner isKindOf: PolygonMorph) and: [owner includesHandle: self])
- ifTrue: ["Prevent insertion handles from getting edited"
- ^ super mouseDown: evt].
- self toggleHandles.
- handles ifNil: [^ self].
- vertices withIndexDo: "Check for click-to-drag at handle site"
- [:vertPt :vertIndex |
- ((handles at: vertIndex*2-1 ifAbsent: [ ^self ]) containsPoint: evt cursorPoint) ifTrue:
- ["If clicked near a vertex, jump into drag-vertex action"
- evt hand newMouseFocus: (handles at: vertIndex*2-1)]]]
- ifFalse: [super mouseDown: evt]!
Item was removed:
- ----- Method: PolygonMorph>>newVertex:event:fromHandle: (in category 'editing') -----
- newVertex: ix event: evt fromHandle: handle
- "Insert a new vertex and fix everything up!! Install the drag-handle of the new vertex as recipient of further mouse events."
-
- | pt |
- "(self hasProperty: #noNewVertices) ifFalse:
- [pt := evt cursorPoint.
- self setVertices: (vertices copyReplaceFrom: ix + 1 to: ix with: (Array with: pt)).
- evt hand newMouseFocus: (handles at: ((ix + 1) * 2) - 1)]"
- "modified to remove now vestigial test. see PolygonMorph class>>arrowprototype"
- pt := evt cursorPoint.
- self insertVertexAt: ix put: pt .
- evt hand newMouseFocus: (handles at: ((ix + 1) * 2) - 1)!
Item was removed:
- ----- Method: PolygonMorph>>newVertex:fromHandle:afterVert: (in category 'editing') -----
- newVertex: arg1 fromHandle: arg2 afterVert: arg3
- "Reorder the arguments for existing event handlers"
- (arg3 isMorph and:[arg3 eventHandler notNil]) ifTrue:[arg3 eventHandler fixReversedValueMessages].
- ^self newVertex: arg1 event: arg2 fromHandle: arg3!
Item was removed:
- ----- Method: PolygonMorph>>nextDuplicateVertexIndex (in category 'geometry') -----
- nextDuplicateVertexIndex
- vertices
- withIndexDo: [: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>>nextToFirstPoint (in category 'smoothing') -----
- nextToFirstPoint
- "For arrow direction"
- self isCurvy
- ifTrue: [curveState
- ifNil: [self coefficients].
- ^ curveState second]
- ifFalse: [^ vertices second]!
Item was removed:
- ----- Method: PolygonMorph>>nextToLastPoint (in category 'smoothing') -----
- nextToLastPoint
- "For arrow direction"
- self isCurvy
- ifTrue: [curveState
- ifNil: [self coefficients].
- ^ curveState third]
- ifFalse: [^ vertices at: vertices size - 1]!
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"
- [ 2r0000 ] -> [ 0 @ 0 ].
- "2 adjacent sides only"
- [ 2r1001 ] -> [ 1 @ 1 ].
- [ 2r0011 ] -> [ -1 @ 1 ].
- [ 2r1100 ] -> [ 1 @ -1 ].
- [ 2r0110 ] -> [ -1 @ -1 ].
- "2 opposite sides only"
- [ 2r1010 ] -> [ 0 @ -1 ].
- [ 2r0101 ] -> [ 1 @ 0 ].
- "only 1 side"
- [ 2r1000 ] -> [ -1 @ 0 ].
- [ 2r0001 ] -> [ 0 @ -1 ].
- [ 2r0010 ] -> [ 1 @ 0 ].
- [ 2r0100 ] -> [ 0 @ 1 ].
- "3 sides"
- [ 2r1011 ] -> [ 0 @ 1 ].
- [ 2r1101 ] -> [ 1 @ 0 ].
- [ 2r1110 ] -> [ 0 @ -1 ].
- [ 2r0111 ] -> [ -1 @ 0 ].
- "all sides"
- [ 2r1111 ] -> [ 1 @ -1 "move up and to the right" ].
- }.
- ^nudge!
Item was removed:
- ----- Method: PolygonMorph>>openOrClosePhrase (in category 'access') -----
- openOrClosePhrase
- "Answer a string indicating whether the receiver is open or closed."
-
- ^ (closed ifTrue: ['<yes>'] ifFalse: ['<no>']), 'closed' translated!
Item was removed:
- ----- Method: PolygonMorph>>privateMoveBy: (in category 'private') -----
- privateMoveBy: delta
- super privateMoveBy: delta.
- vertices := vertices collect: [:p | p + delta].
- self arrowForms do: [:f | f offset: f offset + delta].
- curveState := nil. "Force recomputation"
- (self valueOfProperty: #referencePosition) ifNotNil:
- [:oldPos | self setProperty: #referencePosition toValue: oldPos + delta]!
Item was removed:
- ----- Method: PolygonMorph>>quickFill: (in category 'menu') -----
- quickFill: ignored!
Item was removed:
- ----- Method: PolygonMorph>>rectOval (in category 'shaping') -----
- rectOval
- "Set my vertices to an array of corner vertices.
- Order of vertices is in the tradion of warpblt quads."
-
- self setVertices: self bounds corners.!
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>>referencePosition (in category 'rotate scale and flex') -----
- referencePosition
- "Return the current reference position of the receiver"
- ^ self valueOfProperty: #referencePosition ifAbsent: [super referencePosition]
- !
Item was removed:
- ----- Method: PolygonMorph>>releaseCachedState (in category 'caching') -----
- releaseCachedState
- super releaseCachedState.
- filledForm := nil.
- arrowForms := nil.
- borderForm := nil.
- curveState := nil.
- (self hasProperty: #flex) ifTrue:
- [self removeProperty: #unflexedVertices;
- removeProperty: #flex].
- !
Item was removed:
- ----- Method: PolygonMorph>>removeHandles (in category 'menu') -----
- removeHandles
- "tk 9/2/97 allow it to be called twice (when nil already)"
-
- handles ifNotNil: [
- handles do: [:h | h delete].
- handles := nil].!
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>>rotateTestFlip: (in category 'debug and other') -----
- rotateTestFlip: aBool
- "Return one copy of me for each vertex using each vertex as
- the
- starting point.
- Vary to border color to destinguish the copies.
- This tests closed curves for their consistency.
- The flip boolean tests the reversed rotations."
- | len colors verts flip |
- verts := self vertices.
- flip := aBool == true
- ifTrue: [1]
- ifFalse: [0].
- len := verts size.
- colors := Color wheel: len*2 .
- (1 to: len)
- do: [:i | | j | (self copy
- borderColor: (colors at: (j:=i * 2 - flip));
- yourself)
- setVertices: (verts flipRotated: j);
- openInWorld]!
Item was removed:
- ----- Method: PolygonMorph>>rotationCenter (in category 'rotate scale and flex') -----
- 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 valueOfProperty: #referencePosition
- ifAbsent: [^ 0.5 at 0.5].
- ^ (refPos - self bounds origin) / self bounds extent asFloatPoint!
Item was removed:
- ----- Method: PolygonMorph>>rotationCenter: (in category 'rotate scale and flex') -----
- 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."
- | box |
- aPointOrNil isNil
- ifTrue: [self removeProperty: #referencePosition]
- ifFalse: [box := self bounds.
- self setProperty: #referencePosition
- toValue: box origin + (aPointOrNil * box extent)]
- !
Item was removed:
- ----- Method: PolygonMorph>>rotationDegrees (in category 'rotate scale and flex') -----
- rotationDegrees
-
- ^ self forwardDirection!
Item was removed:
- ----- Method: PolygonMorph>>rotationDegrees: (in category 'rotate scale and flex') -----
- rotationDegrees: degrees
- | flex center |
- (center := self valueOfProperty: #referencePosition) ifNil:
- [self setProperty: #referencePosition toValue: (center := self bounds center)].
- flex := (MorphicTransform offset: center negated)
- withAngle: (degrees - self forwardDirection) degreesToRadians.
- self setVertices: (vertices collect: [:v | (flex transform: v) - flex offset]).
- self forwardDirection: degrees.
-
- !
Item was removed:
- ----- Method: PolygonMorph>>setRotationCenterFrom: (in category 'menu') -----
- setRotationCenterFrom: aPoint
- "Polygons store their referencePosition."
- self setProperty: #referencePosition toValue: aPoint!
Item was removed:
- ----- Method: PolygonMorph>>setVertices: (in category 'private') -----
- setVertices: newVertices
- vertices := newVertices.
- handles ifNotNil: [self removeHandles; addHandles].
- self computeBounds!
Item was removed:
- ----- Method: PolygonMorph>>showOrHideHandles (in category 'menu') -----
- showOrHideHandles
- self showingHandles
- ifTrue: [self removeHandles]
- ifFalse: [self addHandles]!
Item was removed:
- ----- Method: PolygonMorph>>showingHandles (in category 'menu') -----
- showingHandles
- ^ handles notNil!
Item was removed:
- ----- Method: PolygonMorph>>slopes: (in category 'smoothing') -----
- slopes: knots
- "Choose slopes according to state of polygon and preferences"
- self isCurvy
- ifFalse: [^ knots segmentedSlopes].
- ^ (closed
- and: [self isCurvier])
- ifTrue: [knots closedCubicSlopes]
- ifFalse: [knots naturalCubicSlopes]!
Item was removed:
- ----- Method: PolygonMorph>>smoothOrSegmentedPhrase (in category 'access') -----
- smoothOrSegmentedPhrase
-
- | lineName |
- lineName := closed
- ifTrue: ['outline' translated]
- ifFalse: ['line' translated].
-
- ^ self isCurve
- ifTrue: ['make segmented {1}' translated format: {lineName}]
- ifFalse: ['make smooth {1}' translated format: {lineName}]!
Item was removed:
- ----- Method: PolygonMorph>>specifyDashedLine (in category 'menu') -----
- specifyDashedLine
-
- | executableSpec newSpec |
- executableSpec := UIManager default
- request:
- 'Enter a dash specification as
- { major dash length. minor dash length. minor dash color }
- The major dash will have the normal border color.
- A blank response will remove the dash specification.
- [Note: You may give 5 items as, eg, {10. 5. Color white. 0. 3}
- where the 4th ityem is zero, and the 5th is the number of pixels
- by which the dashes will move in each step of animation]' translated
- initialAnswer: '{ 10. 5. Color red }'.
- executableSpec isEmpty ifTrue:
- [^ self stopStepping; dashedBorder: nil].
- newSpec := [Compiler evaluate: executableSpec] ifError:
- [^ self stopStepping; dashedBorder: nil].
- newSpec first isNumber & newSpec second isNumber & newSpec third isColor ifFalse:
- [^ self stopStepping; dashedBorder: nil].
- newSpec size = 3 ifTrue:
- [^ self stopStepping; dashedBorder: newSpec].
- (newSpec size = 5 and: [newSpec fourth isNumber & newSpec fifth isNumber]) ifTrue:
- [^ self dashedBorder: newSpec; startStepping].
- !
Item was removed:
- ----- Method: PolygonMorph>>standardArrows (in category 'menu') -----
- standardArrows
-
- self removeProperty: #arrowSpec.
- self computeBounds!
Item was removed:
- ----- Method: PolygonMorph>>step (in category 'stepping and presenter') -----
- step
- borderDashSpec ifNil: [^super step].
- borderDashSpec size < 5 ifTrue: [^super step].
-
- "Only for dashed lines with creep"
- borderDashSpec at: 4 put: (borderDashSpec fourth) + borderDashSpec fifth.
- self changed.
- ^super step!
Item was removed:
- ----- Method: PolygonMorph>>stepTime (in category 'stepping and presenter') -----
- stepTime
- "Answer the desired time between steps in milliseconds."
-
- ^ self topRendererOrSelf player ifNotNil: [10] ifNil: [100]
-
- "NB: in all currently known cases, polygons are not actually wrapped in TransformationMorphs, so the #topRendererOrSelf call above is probably redundant, but is retained for safety."!
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>>toggleHandles (in category 'menu') -----
- toggleHandles
-
- handles ifNil: [self addHandles] ifNotNil: [self removeHandles].
-
- !
Item was removed:
- ----- Method: PolygonMorph>>toggleSmoothing (in category 'menu') -----
- toggleSmoothing
-
- smoothCurve := smoothCurve not.
- handles ifNotNil: [self removeHandles; addHandles].
- self computeBounds!
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>>transformedBy: (in category 'geometry') -----
- transformedBy: aTransform
- self setVertices: (self vertices collect:[:v| aTransform localPointToGlobal: v])!
Item was removed:
- ----- Method: PolygonMorph>>unrotatedLength (in category 'menu') -----
- unrotatedLength
- "If the receiver bears rotation without a transformation morph, answer what its length in the direction it is headed is"
-
- vertices size = 2 ifTrue:
- [^ (vertices second - vertices first) r].
-
- ^ ((PolygonMorph new setVertices: vertices) rotationDegrees: self rotationDegrees negated) height!
Item was removed:
- ----- Method: PolygonMorph>>unrotatedLength: (in category 'menu') -----
- unrotatedLength: aLength
- "If the receiver bears rotation without a transformation morph, answer what its length in the direction it is headed is"
-
- vertices size = 2 ifTrue: [^ self arrowLength: aLength].
-
- self setVertices: ((((PolygonMorph new setVertices: vertices) rotationDegrees: self rotationDegrees negated) height: aLength) rotationDegrees: 0) vertices!
Item was removed:
- ----- Method: PolygonMorph>>unrotatedWidth (in category 'menu') -----
- unrotatedWidth
- "If the receiver bears rotation without a transformation morph, answer what its length in the direction it is headed is"
-
- vertices size = 2 ifTrue: [^ self borderWidth].
- ^ ((PolygonMorph new setVertices: vertices) rotationDegrees: self rotationDegrees negated) width!
Item was removed:
- ----- Method: PolygonMorph>>unrotatedWidth: (in category 'menu') -----
- unrotatedWidth: aWidth
- "If the receiver bears rotation without a transformation morph, answer what its length in the direction it is headed is"
-
- self borderWidth: aWidth!
Item was removed:
- ----- Method: PolygonMorph>>updateHandles (in category 'editing') -----
- updateHandles
- self isCurvy
- ifTrue: [handles first center: vertices first.
- handles last center: vertices last.
- self midVertices
- withIndexDo: [:midPt :vertIndex | (closed
- or: [vertIndex < vertices size])
- ifTrue: [| newVert |
- newVert := handles atWrap: vertIndex * 2.
- newVert position: midPt - (newVert extent // 2)]]]
- ifFalse: [vertices
- withIndexDo: [:vertPt :vertIndex |
- | oldVert |
- oldVert := handles at: vertIndex * 2 - 1.
- oldVert position: vertPt - (oldVert extent // 2).
- (closed
- or: [vertIndex < vertices size])
- ifTrue: [| newVert |
- newVert := handles at: vertIndex * 2.
- newVert position: vertPt
- + (vertices atWrap: vertIndex + 1) - newVert extent // 2 + (1 @ -1)]]]!
Item was removed:
- ----- Method: PolygonMorph>>vertexAt: (in category 'dashes') -----
- vertexAt: n
- ^vertices at: (n min: vertices size).!
Item was removed:
- ----- Method: PolygonMorph>>vertices (in category 'access') -----
- vertices
- ^ vertices!
Item was removed:
- ----- Method: PolygonMorph>>vertices:color:borderWidth:borderColor: (in category 'initialization') -----
- vertices: verts color: aColor borderWidth: borderWidthInteger borderColor: anotherColor
- super initialize.
- ""
- vertices := verts.
- color := aColor.
-
- closed := vertices size > 2.
- arrows := #none.
-
- self borderStyle
- color: anotherColor;
- width: borderWidthInteger.
-
- self computeBounds!
Item was removed:
- ----- Method: PolygonMorph>>verticesAt:put: (in category 'editing') -----
- verticesAt: anInteger put: aPoint
-
- self vertices at: anInteger put: aPoint asFloatPoint.
- self computeBounds!
Item was removed:
- ----- Method: PolygonMorph>>wantsSteps (in category 'stepping and presenter') -----
- wantsSteps
- super wantsSteps ifTrue: [^true].
-
- "For crawling ants effect of dashed line."
- borderDashSpec ifNil: [^false].
- ^borderDashSpec size = 5 and: [(borderDashSpec fifth) > 0]!
Item was removed:
- StringMorph subclass: #PopUpChoiceMorph
- instanceVariableNames: 'target actionSelector arguments getItemsSelector getItemsArgs choiceSelector choiceArgs'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
Item was removed:
- ----- Method: PopUpChoiceMorph>>actionSelector (in category 'accessing') -----
- actionSelector
-
- ^ actionSelector
- !
Item was removed:
- ----- Method: PopUpChoiceMorph>>actionSelector: (in category 'accessing') -----
- actionSelector: aSymbolOrString
-
- (nil = aSymbolOrString or:
- ['nil' = aSymbolOrString or:
- [aSymbolOrString isEmpty]])
- ifTrue: [^ actionSelector := nil].
-
- actionSelector := aSymbolOrString asSymbol.
- !
Item was removed:
- ----- Method: PopUpChoiceMorph>>arguments (in category 'accessing') -----
- arguments
-
- ^ arguments
- !
Item was removed:
- ----- Method: PopUpChoiceMorph>>arguments: (in category 'accessing') -----
- arguments: aCollection
-
- arguments := aCollection asArray copy.
- !
Item was removed:
- ----- Method: PopUpChoiceMorph>>getItemsArgs (in category 'accessing') -----
- getItemsArgs
-
- ^ getItemsArgs
- !
Item was removed:
- ----- Method: PopUpChoiceMorph>>getItemsArgs: (in category 'accessing') -----
- getItemsArgs: aCollection
-
- getItemsArgs := aCollection asArray copy.
- !
Item was removed:
- ----- Method: PopUpChoiceMorph>>getItemsSelector (in category 'accessing') -----
- getItemsSelector
-
- ^ getItemsSelector
- !
Item was removed:
- ----- Method: PopUpChoiceMorph>>getItemsSelector: (in category 'accessing') -----
- getItemsSelector: aSymbolOrString
-
- (nil = aSymbolOrString or:
- ['nil' = aSymbolOrString or:
- [aSymbolOrString isEmpty]])
- ifTrue: [^ getItemsSelector := nil].
-
- getItemsSelector := aSymbolOrString asSymbol.
- !
Item was removed:
- ----- Method: PopUpChoiceMorph>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: evt
-
- ^ true
- !
Item was removed:
- ----- Method: PopUpChoiceMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- self contents: 'PopUpChoice of Colors'.
- target := Color.
- actionSelector := nil.
- arguments := Array empty.
- getItemsSelector := #colorNames.
- getItemsArgs := Array empty!
Item was removed:
- ----- Method: PopUpChoiceMorph>>mouseUp: (in category 'event handling') -----
- mouseUp: evt
- | items selectedItem |
- (target isNil or: [getItemsSelector isNil]) ifTrue: [^self].
- items := ((target perform: getItemsSelector withArguments: getItemsArgs)
- ifNil: [#()]) asOrderedCollection.
- selectedItem := UIManager default
- chooseFrom: items
- values: items.
- selectedItem ifNil: [^self].
- self contentsClipped: selectedItem. "Client can override this if necess"
- actionSelector ifNotNil:
- [target perform: actionSelector
- withArguments: (arguments copyWith: selectedItem)]!
Item was removed:
- ----- Method: PopUpChoiceMorph>>target (in category 'accessing') -----
- target
-
- ^ target
- !
Item was removed:
- ----- Method: PopUpChoiceMorph>>target: (in category 'accessing-backstop') -----
- target: anObject
-
- target := anObject
- !
Item was removed:
- ----- Method: PopUpChoiceMorph>>veryDeepFixupWith: (in category 'copying') -----
- veryDeepFixupWith: deepCopier
- "If target and arguments fields were weakly copied, fix them here. If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"
-
- super veryDeepFixupWith: deepCopier.
- target := deepCopier references at: target ifAbsent: [target].
- arguments := arguments collect: [:each |
- deepCopier references at: each ifAbsent: [each]].
- getItemsArgs := getItemsArgs collect: [:each |
- deepCopier references at: each ifAbsent: [each]].
- choiceArgs ifNotNil: [choiceArgs := choiceArgs collect: [:each |
- deepCopier references at: each ifAbsent: [each]]].!
Item was removed:
- ----- Method: PopUpChoiceMorph>>veryDeepInner: (in category 'copying') -----
- veryDeepInner: deepCopier
- "Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment."
-
- super veryDeepInner: deepCopier.
- "target := target. Weakly copied"
- "actionSelector := actionSelector. a Symbol"
- "arguments := arguments. All weakly copied"
- "getItemsSelector := getItemsSelector. a Symbol"
- "getItemsArgs := getItemsArgs. All weakly copied"
- "choiceSelector := choiceSelector. a Symbol"
- choiceArgs := choiceArgs. "All weakly copied"
- !
Item was removed:
- ----- Method: PopUpMenu>>morphicStartUpLeftFlush (in category '*Morphic-Menus') -----
- morphicStartUpLeftFlush
- "Build and invoke this menu with no initial selection. By Jerry Archibald, 4/01.
- If in MVC, align menus items with the left margin.
- Answer the selection associated with the menu item chosen by the user or nil if none is chosen.
- The mechanism for getting left-flush appearance in mvc leaves a tiny possibility for misadventure: if the user, in mvc, puts up the jump-to-project menu, then hits cmd period while it is up, then puts up a second jump-to-project menu before dismissing or proceeding through the debugger, it's possible for mvc popup-menus thereafter to appear left-aligned rather than centered; this very unlikely condition can be cleared by evaluating 'PopUpMenu alignment: 2'"
-
- ^self startUp!
Item was removed:
- ----- Method: PopUpMenu>>morphicStartUpWithCaption:icon:at:allowKeyboard: (in category '*Morphic-Menus') -----
- morphicStartUpWithCaption: captionOrNil icon: aForm at: location allowKeyboard: aBoolean
- "Display the menu, with caption if supplied. Wait for the mouse button to go down, then track the selection as long as the button is pressed. When the button is released,
- Answer the index of the current selection, or zero if the mouse is not released over any menu item. Location specifies the desired topLeft of the menu body rectangle. The final argument indicates whether the menu should seize the keyboard focus in order to allow the user to navigate it via the keyboard."
-
- selection := Cursor normal
- showWhile: [| menuMorph |
- menuMorph := MVCMenuMorph from: self title: nil.
- (captionOrNil notNil
- or: [aForm notNil])
- ifTrue: [menuMorph addTitle: captionOrNil icon: aForm].
- MenuIcons decorateMenu: menuMorph.
- menuMorph
- invokeAt: location
- in: self currentWorld
- allowKeyboard: aBoolean].
- ^ selection!
Item was removed:
- Object subclass: #Presenter
- instanceVariableNames: ''
- classVariableNames: 'DefaultPresenterClass'
- poolDictionaries: ''
- category: 'Morphic-Worlds'!
-
- !Presenter commentStamp: '<historical>' prior: 0!
- Optionally associated with a PasteUpMorph, provides a local scope for the running of scripts.
-
- Once more valuable, may be again, but at present occupies primarily a historical niche.
-
- Maintains a playerList cache.
-
- Holds, optionally three 'standard items' -- standardPlayer standardPlayfield standardPalette -- originally providing idiomatic support of ongoing squeak-team internal work, but now extended to more general applicability.
-
- !
Item was removed:
- ----- Method: Presenter class>>defaultPresenterClass (in category 'accessing') -----
- defaultPresenterClass
- "The default presenter class to use"
- ^DefaultPresenterClass ifNil:[self]!
Item was removed:
- ----- Method: Presenter class>>defaultPresenterClass: (in category 'accessing') -----
- defaultPresenterClass: aPresenterClass
- "The default presenter class to use"
- DefaultPresenterClass := aPresenterClass!
Item was removed:
- ----- Method: Presenter>>allCurrentlyTickingScriptInstantiations (in category 'stubs') -----
- allCurrentlyTickingScriptInstantiations
- "Answer a list of ScriptInstantiation objects representing all the scripts within the scope of the receiver which are currently ticking."
-
- ^ Array streamContents:
- [:aStream |
- self allExtantPlayers do:
- [:aPlayer | aPlayer instantiatedUserScriptsDo:
- [:aScriptInstantiation |
- aScriptInstantiation status == #ticking ifTrue:
- [aStream nextPut: aScriptInstantiation]]]]!
Item was removed:
- ----- Method: Presenter>>allExtantPlayers (in category 'stubs') -----
- allExtantPlayers
- ^#()!
Item was removed:
- ----- Method: Presenter>>associatedMorph: (in category 'accessing') -----
- associatedMorph: m!
Item was removed:
- ----- Method: Presenter>>browseAllScriptsTextually (in category 'stubs') -----
- browseAllScriptsTextually
- "Open a method-list browser on all the scripts in the project"
-
- | aList aMethodList |
- self flushPlayerListCache. "Just to be certain we get everything"
-
- (aList := self uniclassesAndCounts) size == 0 ifTrue: [^ self inform: 'there are no scripted players' translated].
- aMethodList := OrderedCollection new.
- aList do:
- [:aPair | aPair first addMethodReferencesTo: aMethodList].
- aMethodList size > 0 ifFalse: [^ self inform: 'there are no scripts in this project!!' translated].
-
- SystemNavigation new
- browseMessageList: aMethodList
- name: 'All scripts in this project'
- autoSelect: nil
-
- "
- ActiveWorld presenter browseAllScriptsTextually
- "!
Item was removed:
- ----- Method: Presenter>>currentlyViewing: (in category 'stubs') -----
- currentlyViewing: aPlayer
- ^false!
Item was removed:
- ----- Method: Presenter>>drawingJustCompleted: (in category 'stubs') -----
- drawingJustCompleted: aSketch!
Item was removed:
- ----- Method: Presenter>>flushPlayerListCache (in category 'stubs') -----
- flushPlayerListCache!
Item was removed:
- ----- Method: Presenter>>morph:droppedIntoPasteUpMorph: (in category 'stubs') -----
- morph: aMorph droppedIntoPasteUpMorph: aPasteUpMorph!
Item was removed:
- ----- Method: Presenter>>ownStandardPalette (in category 'stubs') -----
- ownStandardPalette
- ^nil!
Item was removed:
- ----- Method: Presenter>>positionStandardPlayer (in category 'stubs') -----
- positionStandardPlayer!
Item was removed:
- ----- Method: Presenter>>viewMorph: (in category 'stubs') -----
- viewMorph: aMorph
- aMorph inspect.
- !
Item was removed:
- ----- Method: Presenter>>viewObjectDirectly: (in category 'stubs') -----
- viewObjectDirectly: aMorph
- aMorph inspect.
- !
Item was removed:
- ----- Method: Project class>>allMorphicProjects (in category '*Morphic-Support') -----
- allMorphicProjects
-
- ^ self allProjects select: [:p | p isMorphic]!
Item was removed:
- ImageMorph subclass: #ProjectViewMorph
- instanceVariableNames: 'project lastProjectThumbnail'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
-
- !ProjectViewMorph commentStamp: '<historical>' prior: 0!
- I am a Morphic view of a project. I display a scaled version of the project's thumbnail, which itself is a scaled-down snapshot of the screen taken when the project was last exited. When I am displayed, I check to see if the project thumbnail has changed and, if so, I update my own view of that thumbnail.
- !
Item was removed:
- ----- Method: ProjectViewMorph class>>defaultNameStemForInstances (in category 'scripting') -----
- defaultNameStemForInstances
- ^ 'ProjectView' translatedNoop!
Item was removed:
- ----- Method: ProjectViewMorph class>>fileReaderServicesForFile:suffix: (in category 'fileIn/Out') -----
- fileReaderServicesForFile: fullName suffix: suffix
-
- ^({ 'extseg'. 'project'. 'pr'. 'morph'. 'morphs'. 'sp'. '*' } includes: suffix)
- ifTrue: [ self services]
- ifFalse: [#()]!
Item was removed:
- ----- Method: ProjectViewMorph class>>initialize (in category 'class initialization') -----
- initialize
-
- FileServices registerFileReader: self!
Item was removed:
- ----- Method: ProjectViewMorph class>>newMVCProject (in category 'project window creation') -----
- newMVCProject
- "Create an instance of me on a new MVC project (in a SystemWindow)."
-
- | proj window |
- proj := Project new.
- window := (SystemWindow labelled: proj name) model: proj.
- window
- addMorph: (self on: proj)
- frame: (0 at 0 corner: 1.0 at 1.0).
- ^ window
- !
Item was removed:
- ----- Method: ProjectViewMorph class>>newProjectViewInAWindowFor: (in category 'project window creation') -----
- newProjectViewInAWindowFor: aProject
- "Return an instance of me on a new Morphic project (in a SystemWindow)."
-
- | window proj |
- proj := self on: aProject.
- window := (SystemWindow labelled: aProject name) model: aProject.
- window extent: proj extent.
- window
- addMorph: proj
- frame: (0 at 0 corner: 1.0 at 1.0).
- proj borderWidth: 0.
- ^ window
- !
Item was removed:
- ----- Method: ProjectViewMorph class>>on: (in category 'instance creation') -----
- on: aProject
-
- ^ self new on: aProject
- !
Item was removed:
- ----- Method: ProjectViewMorph class>>openFromDirectory:andFileName: (in category 'project window creation') -----
- openFromDirectory: aDirectory andFileName: aFileName
-
- Project canWeLoadAProjectNow ifFalse: [^ self].
- ^ProjectLoading openFromDirectory: aDirectory andFileName: aFileName!
Item was removed:
- ----- Method: ProjectViewMorph class>>openFromDirectoryAndFileName: (in category 'project window creation') -----
- openFromDirectoryAndFileName: anArray
-
- Project canWeLoadAProjectNow ifFalse: [^ self].
- ^ProjectLoading
- openFromDirectory: anArray first
- andFileName: anArray second!
Item was removed:
- ----- Method: ProjectViewMorph class>>openFromFile: (in category 'project window creation') -----
- openFromFile: fileName
-
- self flag: #bob. "better not to use this one. nil directories are not nice.
- see #openFromDirectoryAndFileName: or
- #openFromDirectory:andFileName: instead"
-
- self halt.
-
- Project canWeLoadAProjectNow ifFalse: [^ self].
- ^ProjectLoading openFromDirectory: nil andFileName: fileName!
Item was removed:
- ----- Method: ProjectViewMorph class>>openFromFileList: (in category 'project window creation') -----
- openFromFileList: fullName
-
- self flag: #bob. "not sent??"
-
- self halt.
-
- ^self openFromFile: fullName!
Item was removed:
- ----- Method: ProjectViewMorph class>>openOn: (in category 'instance creation') -----
- openOn: aProject
- "Open a ProjectViewMorph for the project in question"
- ProjectViewOpenNotification signal ifFalse: [^ self].
-
- (Preferences projectViewsInWindows
- ifTrue: [ (self newProjectViewInAWindowFor: aProject) ]
- ifFalse: [ (self on: aProject) ])
- openAsTool.!
Item was removed:
- ----- Method: ProjectViewMorph class>>serviceOpenProjectFromFile (in category 'project window creation') -----
- serviceOpenProjectFromFile
- "Answer a service for opening a .pr project file"
-
- ^ (SimpleServiceEntry
- provider: self
- label: 'load as project' translatedNoop
- selector: #openFromDirectoryAndFileName:
- description: 'open project from file' translatedNoop
- buttonLabel: 'load' translatedNoop
- )
- argumentGetter: [ :fileList | fileList dirAndFileName]!
Item was removed:
- ----- Method: ProjectViewMorph class>>services (in category 'fileIn/Out') -----
- services
-
- ^ Array with: self serviceOpenProjectFromFile
-
- !
Item was removed:
- ----- Method: ProjectViewMorph class>>unload (in category 'initialize-release') -----
- unload
-
- FileServices unregisterFileReader: self !
Item was removed:
- ----- Method: ProjectViewMorph>>abandon (in category 'submorphs - add/remove') -----
- abandon
- "Home ViewMorph of project is going away."
-
- project := nil.
- super abandon.
-
- !
Item was removed:
- ----- Method: ProjectViewMorph>>acceptDroppingMorph:event: (in category 'layout') -----
- acceptDroppingMorph: morphToDrop event: evt
- "Accept -- in a custom sense here -- a morph dropped on the receiver."
-
- | myCopy smallR |
-
- (self isTheRealProjectPresent) ifFalse: [
- ^morphToDrop rejectDropMorphEvent: evt. "can't handle it right now"
- ].
- (morphToDrop isKindOf: NewHandleMorph) ifTrue: [ "don't send these"
- ^morphToDrop rejectDropMorphEvent: evt.
- ].
- self dropEnabled ifFalse:
- [^ morphToDrop rejectDropMorphEvent: evt].
-
- self eToyRejectDropMorph: morphToDrop event: evt. "we will send a copy"
- myCopy := morphToDrop veryDeepCopy. "gradient fills require doing this second"
- smallR := (morphToDrop bounds scaleBy: image height / Display height) rounded.
- smallR := smallR squishedWithin: image boundingBox.
- image getCanvas
- paintImage: (morphToDrop imageForm scaledToSize: smallR extent)
- at: smallR topLeft.
- myCopy openInWorld: project world
-
- !
Item was removed:
- ----- Method: ProjectViewMorph>>addProjectNameMorph (in category 'private') -----
- addProjectNameMorph
-
- | m |
-
- self removeAllMorphs.
- m := UpdatingStringMorph contents: self safeProjectName font: self fontForName.
- m target: self; getSelector: #safeProjectName; putSelector: #safeProjectName:.
- m useStringFormat; fitContents.
- self addMorphBack: m.
- self updateNamePosition.
- ^m
-
- !
Item was removed:
- ----- Method: ProjectViewMorph>>addProjectNameMorphFiller (in category 'private') -----
- addProjectNameMorphFiller
-
- | m |
-
- self removeAllMorphs.
- m := AlignmentMorph newRow color: Color transparent.
- self addMorphBack: m.
- m
- on: #mouseDown send: #editTheName: to: self;
- on: #mouseUp send: #yourself to: self.
- self updateNamePosition.
-
- !
Item was removed:
- ----- Method: ProjectViewMorph>>balloonText (in category 'events') -----
- balloonText
- ^ 'Click here to enter the
- project named
- "{1}"' translated format: {project name}!
Item was removed:
- ----- Method: ProjectViewMorph>>borderWidthForRounding (in category 'accessing') -----
- borderWidthForRounding
-
- ^1!
Item was removed:
- ----- Method: ProjectViewMorph>>checkForNewerVersionAndLoad (in category 'events') -----
- checkForNewerVersionAndLoad
-
- self withProgressDo: [
- project loadFromServer
- ]
-
- !
Item was removed:
- ----- Method: ProjectViewMorph>>colorAroundName (in category 'drawing') -----
- colorAroundName
-
- ^Color gray: 0.8!
Item was removed:
- ----- Method: ProjectViewMorph>>dismissViaHalo (in category 'initialization') -----
- dismissViaHalo
- | choice |
- project ifNil:[^self delete]. "no current project"
- choice := Project uiManager
- chooseOptionFrom:
- {'yes - delete the window and the project' translated.
- 'no - delete the window only' translated}
- title: ('Do you really want to delete {1}
- and all its content?' translated format: {project name printString}).
- choice = 1 ifTrue:[^self expungeProject].
- choice = 2 ifTrue:[^self delete].!
Item was removed:
- ----- Method: ProjectViewMorph>>doButtonAction (in category 'events') -----
- doButtonAction
- "My inherent button action consists of entering the project I represent"
-
- self enter!
Item was removed:
- ----- Method: ProjectViewMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- | font projectName nameForm rectForName |
-
- self ensureImageReady.
- super drawOn: aCanvas.
- self isEditingName ifTrue: [^self].
-
- font := self fontForName.
- projectName := self safeProjectName.
- nameForm := (StringMorph contents: projectName font: font) imageForm.
- nameForm := nameForm scaledToSize: (self extent - (4 at 2) min: nameForm extent).
- rectForName := self bottomLeft +
- (self width - nameForm width // 2 @ (nameForm height + 2) negated)
- extent: nameForm extent.
- rectForName topLeft eightNeighbors do: [ :pt |
- aCanvas
- stencil: nameForm
- at: pt
- color: self colorAroundName.
- ].
- aCanvas
- drawImage: nameForm
- at: rectForName topLeft
- !
Item was removed:
- ----- Method: ProjectViewMorph>>editTheName: (in category 'events') -----
- editTheName: evt
-
- self isTheRealProjectPresent ifFalse: [
- ^self inform: 'The project is not present and may not be renamed now' translated
- ].
- self addProjectNameMorph launchMiniEditor: evt.!
Item was removed:
- ----- Method: ProjectViewMorph>>ensureImageReady (in category 'drawing') -----
- ensureImageReady
-
- self isTheRealProjectPresent ifFalse: [^self].
- project thumbnail ifNil: [
- image fill: image boundingBox rule: Form over
- fillColor: project color.
- ^self
- ].
- project thumbnail ~~ lastProjectThumbnail ifTrue: ["scale thumbnail to fit my bounds"
- lastProjectThumbnail := project thumbnail.
- self updateImageFrom: lastProjectThumbnail.
- project thumbnail ifNotNil: [project thumbnail hibernate].
- image borderWidth: 1
- ].
-
-
- !
Item was removed:
- ----- Method: ProjectViewMorph>>enter (in category 'events') -----
- enter
- "Enter my project."
-
- self world == self outermostWorldMorph ifFalse: [^Beeper beep]. "can't do this at the moment"
- project class == DiskProxy
- ifFalse:
- [(project world notNil and:
- [project world isMorph
- and: [project world hasOwner: self outermostWorldMorph]])
- ifTrue: [^Beeper beep "project is open in a window already"]].
- project class == DiskProxy
- ifTrue:
- ["When target is not in yet"
-
- self enterWhenNotPresent. "will bring it in"
- project class == DiskProxy ifTrue: [^self inform: 'Project not found' translated]].
- (owner isSystemWindow) ifTrue: [project viewSize: self extent].
- self showMouseState: 3.
- project
- enter: false
- revert: false
- saveForRevert: false!
Item was removed:
- ----- Method: ProjectViewMorph>>enterAsActiveSubproject (in category 'events') -----
- enterAsActiveSubproject
- "Enter my project."
-
- project class == DiskProxy
- ifTrue:
- ["When target is not in yet"
-
- [self enterWhenNotPresent "will bring it in"] on: ProjectEntryNotification
- do: [:ex | ^ex projectToEnter enterAsActiveSubprojectWithin: self world].
- project class == DiskProxy ifTrue: [self error: 'Could not find view']].
- (owner isSystemWindow) ifTrue: [project viewSize: self extent].
- self showMouseState: 3.
- project enterAsActiveSubprojectWithin: self world!
Item was removed:
- ----- Method: ProjectViewMorph>>enterWhenNotPresent (in category 'events') -----
- enterWhenNotPresent
-
- self withProgressDo: [
- project enter: false revert: false saveForRevert: false. "will bring it in"
- ]
-
- !
Item was removed:
- ----- Method: ProjectViewMorph>>expungeProject (in category 'events') -----
- expungeProject
-
- (self confirm: ('Do you really want to delete {1}
- and all its content?' translated format: {project name}))
- ifFalse: [^ self].
- owner isSystemWindow
- ifTrue: [owner model: nil;
- delete].
-
- project delete.
- self delete.!
Item was removed:
- ----- Method: ProjectViewMorph>>extent: (in category 'geometry') -----
- extent: aPoint
- "Set my image form to the given extent."
-
- | newExtent scaleP scale |
-
- ((bounds extent = aPoint) and: [image depth = Display depth]) ifFalse: [
- lastProjectThumbnail ifNil: [ lastProjectThumbnail := image ].
- scaleP := aPoint / lastProjectThumbnail extent.
- scale := scaleP "scaleP x asFloat max: scaleP y asFloat".
- newExtent := (lastProjectThumbnail extent * scale) rounded.
- self image: (Form extent: newExtent depth: Display depth).
- self updateImageFrom: lastProjectThumbnail.
- ].
- self updateNamePosition.!
Item was removed:
- ----- Method: ProjectViewMorph>>fontForName (in category 'drawing') -----
- fontForName
-
- ^TextStyle defaultFont emphasized: 1
- !
Item was removed:
- ----- Method: ProjectViewMorph>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: evt
-
- ^ true
- !
Item was removed:
- ----- Method: ProjectViewMorph>>handlesMouseOver: (in category 'event handling') -----
- handlesMouseOver: evt
- ^ true!
Item was removed:
- ----- Method: ProjectViewMorph>>handlesMouseOverDragging: (in category 'event handling') -----
- handlesMouseOverDragging: evt
-
- ^ true!
Item was removed:
- ----- Method: ProjectViewMorph>>initialExtent (in category 'geometry') -----
- initialExtent
-
- ^ 300 @ 200!
Item was removed:
- ----- Method: ProjectViewMorph>>initialize (in category 'initialization') -----
- initialize
- "Initialize the receiver."
-
- super initialize.
- self extent: self initialExtent * RealEstateAgent scaleFactor.
- "currentBorderColor := Color gray."
- self addProjectNameMorphFiller.
- self enableDragNDrop: true.
- self isOpaque: true.
- !
Item was removed:
- ----- Method: ProjectViewMorph>>isEditingName (in category 'drawing') -----
- isEditingName
-
- | nameMorph |
- nameMorph := self findA: UpdatingStringMorph.
- nameMorph ifNil: [^false].
-
- ^nameMorph hasFocus
- !
Item was removed:
- ----- Method: ProjectViewMorph>>isTheRealProjectPresent (in category 'drawing') -----
- isTheRealProjectPresent
-
- project ifNil: [^ false].
- project isInMemory ifFalse: [^ false].
- project class == DiskProxy ifTrue: [^ false].
- ^true
- !
Item was removed:
- ----- Method: ProjectViewMorph>>lastProjectThumbnail: (in category 'events') -----
- lastProjectThumbnail: aForm
-
- lastProjectThumbnail := aForm!
Item was removed:
- ----- Method: ProjectViewMorph>>mouseDown: (in category 'event handling') -----
- mouseDown: evt
-
- evt yellowButtonPressed ifTrue:
- [self showMenuForProjectView].
- evt hand newMouseFocus: self.
- self removeProperty: #wasOpenedAsSubproject.
- self showMouseState: 2.!
Item was removed:
- ----- Method: ProjectViewMorph>>mouseEnter: (in category 'event handling') -----
- mouseEnter: evt
-
- self showMouseState: 1!
Item was removed:
- ----- Method: ProjectViewMorph>>mouseLeave: (in category 'event handling') -----
- mouseLeave: evt
-
- self showMouseState: 3.
- !
Item was removed:
- ----- Method: ProjectViewMorph>>mouseLeaveDragging: (in category 'event handling') -----
- mouseLeaveDragging: evt
-
- self mouseLeave: evt
-
- !
Item was removed:
- ----- Method: ProjectViewMorph>>mouseUp: (in category 'event handling') -----
- mouseUp: evt
-
- ((self containsPoint: evt cursorPoint) and:
- [(self hasProperty: #wasOpenedAsSubproject) not]) ifTrue:
- [^ self enter].
- self showMouseState: 3.
- !
Item was removed:
- ----- Method: ProjectViewMorph>>objectForDataStream: (in category 'objects from disk') -----
- objectForDataStream: refStrm
-
- | copy |
-
- 1 = 1 ifTrue: [^self]. "this didn't really work"
-
- copy := self copy lastProjectThumbnail: nil.
- "refStrm replace: self with: copy."
- ^copy
- !
Item was removed:
- ----- Method: ProjectViewMorph>>on: (in category 'events') -----
- on: aProject
-
- project := aProject.
- self addProjectNameMorphFiller.
- lastProjectThumbnail := nil.
- project viewSize ifNil: [project viewSize: self extent].
- project thumbnail: project previewImageForm.
- self extent: project thumbnail extent.!
Item was removed:
- ----- Method: ProjectViewMorph>>project (in category 'accessing') -----
- project
- ^project!
Item was removed:
- ----- Method: ProjectViewMorph>>project: (in category 'events') -----
- project: aProject
-
- project := aProject.
- self addProjectNameMorphFiller.!
Item was removed:
- ----- Method: ProjectViewMorph>>releaseCachedState (in category 'caching') -----
- releaseCachedState
-
- "see if we can reduce size of published file, but there may be problems"
- super releaseCachedState.
- lastProjectThumbnail := image.
- !
Item was removed:
- ----- Method: ProjectViewMorph>>safeProjectName (in category 'drawing') -----
- safeProjectName
- | projectName args |
- projectName := self valueOfProperty: #SafeProjectName ifAbsent: ['???'].
- self isTheRealProjectPresent
- ifFalse:
- [project class == DiskProxy
- ifTrue:
- [args := project constructorArgs.
- ((args isKindOf: Array)
- and: [args size = 1 and: [args first isString]])
- ifTrue: [^args first]]
- ifFalse: [^projectName]].
- self setProperty: #SafeProjectName toValue: project name.
- ^project name!
Item was removed:
- ----- Method: ProjectViewMorph>>safeProjectName: (in category 'drawing') -----
- safeProjectName: aString
- self addProjectNameMorphFiller.
- self isTheRealProjectPresent ifFalse: [^self].
- project renameTo: aString.
- self setProperty: #SafeProjectName toValue: project name.
- self updateNamePosition.
- (owner isSystemWindow) ifTrue: [owner setLabel: aString]!
Item was removed:
- ----- Method: ProjectViewMorph>>seeIfNameChanged (in category 'events') -----
- seeIfNameChanged
-
- | nameBefore nameNow |
-
- nameBefore := self valueOfProperty: #SafeProjectName ifAbsent: ['???'].
- nameNow := self safeProjectName.
- (submorphs notEmpty and: [nameBefore = nameNow]) ifTrue: [^self].
- self addProjectNameMorphFiller.
- !
Item was removed:
- ----- Method: ProjectViewMorph>>showBorderAs: (in category 'drawing') -----
- showBorderAs: aColor
-
- "image border: image boundingBox width: 1 fillColor: aColor.
- currentBorderColor := aColor.
- self changed"
- !
Item was removed:
- ----- Method: ProjectViewMorph>>showMenuForProjectView (in category 'events') -----
- showMenuForProjectView
- | menu |
- (menu := MenuMorph new)
- add: 'enter this project' translated
- action: [^ self enter];
-
- add: 'ENTER ACTIVE' translated
- action: [self setProperty: #wasOpenedAsSubproject toValue: true.
- ^ self enterAsActiveSubproject];
-
- add: 'PUBLISH (also saves a local copy)' translated
- action: [^ project storeOnServerShowProgressOn: self forgetURL: false];
-
- add: 'PUBLISH to a different server' translated
- action: [project forgetExistingURL.
- ^ project storeOnServerShowProgressOn: self forgetURL: true];
-
- add: 'see if server version is more recent' translated
- action: [^ self checkForNewerVersionAndLoad];
-
- addLine;
- add: 'expunge this project' translated
- action: [^ self expungeProject].
-
- menu title: ('Project Named \"{1}"' translated withCRs format: {project name}).
- menu invokeModal.!
Item was removed:
- ----- Method: ProjectViewMorph>>showMouseState: (in category 'events') -----
- showMouseState: anInteger
- | aMorph |
- (owner isSystemWindow)
- ifTrue: [aMorph := owner]
- ifFalse: [aMorph := self].
- anInteger = 1
- ifTrue: ["enter"
- aMorph
- addMouseActionIndicatorsWidth: 10
- color: (Color blue alpha: 0.3)].
- anInteger = 2
- ifTrue: ["down"
- aMorph
- addMouseActionIndicatorsWidth: 15
- color: (Color blue alpha: 0.7)].
- anInteger = 3
- ifTrue: ["leave"
- aMorph deleteAnyMouseActionIndicators]!
Item was removed:
- ----- Method: ProjectViewMorph>>step (in category 'stepping and presenter') -----
- step
- | cmd |
- "Check for a command that could not be executed in my subproject. Once it is done, remove the trigger. If this is too slow, make armsLengthCmd an inst var."
-
- self seeIfNameChanged.
- cmd := self valueOfProperty: #armsLengthCmd.
- cmd ifNil: [^ super step].
- self removeProperty: #armsLengthCmd.
- project perform: cmd.
- project enter.!
Item was removed:
- ----- Method: ProjectViewMorph>>stepTime (in category 'stepping and presenter') -----
- stepTime
-
- ^1000!
Item was removed:
- ----- Method: ProjectViewMorph>>storeSegment (in category 'fileIn/out') -----
- storeSegment
- "Store my project out on the disk as an ImageSegment. Keep the outPointers in memory. Name it <project name>.seg"
-
- project storeSegment
- !
Item was removed:
- ----- Method: ProjectViewMorph>>thumbnail (in category 'accessing') -----
- thumbnail
- ^ project ifNotNil: [project thumbnail]!
Item was removed:
- ----- Method: ProjectViewMorph>>triggerActionFromPianoRoll (in category '*Morphic-Sound-piano rolls') -----
- triggerActionFromPianoRoll
-
- WorldState addDeferredUIMessage: [
- project world setProperty: #letTheMusicPlay toValue: true.
- self enter.
- ]!
Item was removed:
- ----- Method: ProjectViewMorph>>updateImageFrom: (in category 'drawing') -----
- updateImageFrom: sourceForm
-
- (WarpBlt toForm: image)
- sourceForm: sourceForm;
- cellSize: 2; "installs a colormap"
- combinationRule: Form over;
- copyQuad: (sourceForm boundingBox) innerCorners
- toRect: image boundingBox.
- !
Item was removed:
- ----- Method: ProjectViewMorph>>updateNamePosition (in category 'drawing') -----
- updateNamePosition
-
- | nameMorph shadowMorph nameFillerMorph |
-
- (nameMorph := self findA: UpdatingStringMorph) ifNotNil: [
- nameMorph position:
- (self left + (self width - nameMorph width // 2)) @
- (self bottom - nameMorph height - 2).
- ].
- (nameFillerMorph := self findA: AlignmentMorph) ifNotNil: [
- nameFillerMorph
- position: self bottomLeft - (0 at 20);
- extent: self width at 20.
- ].
- (shadowMorph := self findA: ImageMorph) ifNotNil: [
- shadowMorph delete "no longer used"
- ].
-
- !
Item was removed:
- ----- Method: ProjectViewMorph>>veryDeepFixupWith: (in category 'copying') -----
- veryDeepFixupWith: deepCopier
- "If target and arguments fields were weakly copied, fix them here. If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"
-
- super veryDeepFixupWith: deepCopier.
- project := deepCopier references at: project ifAbsent: [project].
- lastProjectThumbnail := deepCopier references at: lastProjectThumbnail
- ifAbsent: [lastProjectThumbnail].
- !
Item was removed:
- ----- Method: ProjectViewMorph>>veryDeepInner: (in category 'copying') -----
- veryDeepInner: deepCopier
- "Copy all of my instance variables. Some need to be not copied at all, but shared. See DeepCopier class comment."
-
- super veryDeepInner: deepCopier.
- project := project. "Weakly copied"
- lastProjectThumbnail := lastProjectThumbnail veryDeepCopyWith: deepCopier.
- !
Item was removed:
- ----- Method: ProjectViewMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
- wantsDroppedMorph: aMorph event: evt
- "Answer if the receiver would accept a drop of a given morph."
-
- "If drop-enabled not set, answer false"
- (super wantsDroppedMorph: aMorph event: evt) ifFalse: [^ false].
-
- "If project not present, not morphic, or not initialized, answer false"
- self isTheRealProjectPresent ifFalse: [^ false].
- project isMorphic ifFalse: [^ false].
- project world viewBox ifNil: [^ false].
-
- ^ true!
Item was removed:
- ----- Method: ProjectViewMorph>>wantsKeyboardFocusFor: (in category 'event handling') -----
- wantsKeyboardFocusFor: aSubmorph
-
- ^true!
Item was removed:
- ----- Method: ProjectViewMorph>>wantsRoundedCorners (in category 'rounding') -----
- wantsRoundedCorners
- ^SystemWindow roundedWindowCorners
- and: [(owner isSystemWindow) not]!
Item was removed:
- ----- Method: ProjectViewMorph>>withProgressDo: (in category 'events') -----
- withProgressDo: aBlock
-
- ComplexProgressIndicator new
- targetMorph: self;
- historyCategory: 'project loading';
- withProgressDo: aBlock
- !
Item was removed:
- LayoutPolicy subclass: #ProportionalLayout
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Layouts'!
-
- !ProportionalLayout commentStamp: '<historical>' prior: 0!
- I represent a layout that places all children of some morph in their given LayoutFrame.!
Item was removed:
- ----- Method: ProportionalLayout>>isProportionalLayout (in category 'testing') -----
- isProportionalLayout
- ^true!
Item was removed:
- ----- Method: ProportionalLayout>>layout:in: (in category 'layout') -----
- layout: aMorph in: layoutBounds
- "Compute the layout for the given morph based on the new bounds"
-
- aMorph submorphsDo: [:m |
- m
- layoutProportionallyInBounds: layoutBounds
- positioning: aMorph cellPositioning].!
Item was removed:
- ----- Method: ProportionalLayout>>minExtentOf:in: (in category 'layout') -----
- minExtentOf: aMorph in: newBounds
- "Return the minimal size aMorph's children would require given the new bounds"
- | min |
- min := 0 at 0.
- aMorph submorphsDo:[:m| | extent frame |
- "Map the minimal size of the child through the layout frame.
- Note: This is done here and not in the child because its specific
- for proportional layouts. Perhaps we'll generalize this for table
- layouts but I'm not sure how and when."
- extent := m minExtent.
- "frame := m layoutFrame.
- frame ifNotNil:[extent := frame minExtentFrom: extent]."
- min := min max: extent].
- ^min!
Item was removed:
- AbstractResizerMorph subclass: #ProportionalSplitterMorph
- instanceVariableNames: 'leftOrTop rightOrBottom splitsTopAndBottom traceMorph movements'
- classVariableNames: 'SmartHorizontalSplitters SmartVerticalSplitters'
- poolDictionaries: ''
- category: 'Morphic-Windows'!
-
- !ProportionalSplitterMorph commentStamp: 'jmv 1/29/2006 17:16' prior: 0!
- I am the morph the user grabs to adjust pane splitters.!
Item was removed:
- ----- Method: ProportionalSplitterMorph class>>fastSplitterResize (in category 'preferences') -----
- fastSplitterResize
-
- ^ Preferences fastDragWindowForMorphic!
Item was removed:
- ----- Method: ProportionalSplitterMorph class>>preferenceChanged: (in category 'private') -----
- preferenceChanged: aBoolean
- "Take immediate effect for all in a World."
- self allInstances do:
- [ : each | (each isInWorld and: [ aBoolean and: [ each wantsSteps ] ])
- ifTrue: [ each startStepping ]
- ifFalse: [ each stopStepping ] ]!
Item was removed:
- ----- Method: ProportionalSplitterMorph class>>showSplitterHandles (in category 'preferences') -----
- showSplitterHandles
-
- ^ Preferences valueOfPreference: #showSplitterHandles ifAbsent: [true]!
Item was removed:
- ----- Method: ProportionalSplitterMorph class>>showSplitterHandles: (in category 'preferences') -----
- showSplitterHandles: aBoolean
-
- Preferences setPreference: #showSplitterHandles toValue: aBoolean.
- Project current restoreDisplay.!
Item was removed:
- ----- Method: ProportionalSplitterMorph class>>smartHorizontalSplitters (in category 'preferences') -----
- smartHorizontalSplitters
- <preference: 'Smart Horizontal Splitters'
- category: 'Morphic'
- description: 'When true, horizontal splitter bars will automatically reposition themselves to increase the quantity of exposed information, if possible..'
- type: #Boolean>
- ^ SmartHorizontalSplitters ifNil: [ false ]!
Item was removed:
- ----- Method: ProportionalSplitterMorph class>>smartHorizontalSplitters: (in category 'preferences') -----
- smartHorizontalSplitters: aBooleanOrNil
- SmartHorizontalSplitters := aBooleanOrNil.
- self preferenceChanged: self smartHorizontalSplitters.!
Item was removed:
- ----- Method: ProportionalSplitterMorph class>>smartVerticalSplitters (in category 'preferences') -----
- smartVerticalSplitters
- <preference: 'Smart Vertical Splitters'
- category: 'Morphic'
- description: 'When true, vertical bars between lists will automatically reposition themselves to balance the number of characters occluded on either side of the bar.'
- type: #Boolean>
- ^ SmartVerticalSplitters ifNil: [ false ]!
Item was removed:
- ----- Method: ProportionalSplitterMorph class>>smartVerticalSplitters: (in category 'preferences') -----
- smartVerticalSplitters: aBooleanOrNil
- SmartVerticalSplitters := aBooleanOrNil.
- self preferenceChanged: self smartHorizontalSplitters.!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>addLeftOrTop: (in category 'initialization') -----
- addLeftOrTop: aMorph
-
- leftOrTop add: aMorph!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>addRightOrBottom: (in category 'initialization') -----
- addRightOrBottom: aMorph
-
- rightOrBottom add: aMorph.
-
- !
Item was removed:
- ----- Method: ProportionalSplitterMorph>>balanceOffsets (in category 'events') -----
- balanceOffsets
-
- | fdx fdy |
-
- (self hasProperty: #fullDelta) ifFalse: [^ self].
-
- fdx := (self valueOfProperty: #fullDelta) x.
- fdy := (self valueOfProperty: #fullDelta) y.
-
- self layoutFrame hasFixedHeight ifTrue: [
- | otop obot ctop cbot topf |
-
- otop := (owner submorphs detect: [:m |
- m layoutFrame topFraction isZero] ifNone: [^ self]) in: [:tm |
- tm top - (tm layoutFrame topOffset)].
-
- obot := (owner submorphs detect: [:m |
- m layoutFrame bottomFraction = 1] ifNone: [^ self]) in: [:tm |
- tm bottom - (tm layoutFrame bottomOffset)].
-
- ctop := (self layoutFrame topFraction * (obot - otop)) rounded
- + otop + (self layoutFrame topOffset).
- cbot := (self layoutFrame bottomFraction * (obot - otop)) rounded
- + otop + (self layoutFrame bottomOffset).
-
- topf := self layoutFrame topFraction.
- self layoutFrame topFraction: ((ctop + cbot) * 0.5 - otop) / (obot - otop) asFloat.
- self layoutFrame bottomFraction: self layoutFrame topFraction.
- self layoutFrame topOffset: self layoutFrame topOffset - fdy.
- self layoutFrame bottomOffset: self layoutFrame bottomOffset - fdy.
-
- (leftOrTop copy union: rightOrBottom) do: [:m |
- (m layoutFrame topFraction closeTo: topf) ifTrue: [
- m layoutFrame topFraction: self layoutFrame topFraction.
- m layoutFrame topOffset: m layoutFrame topOffset - fdy].
- (m layoutFrame bottomFraction closeTo: topf) ifTrue: [
- m layoutFrame bottomFraction: self layoutFrame topFraction.
- m layoutFrame bottomOffset: m layoutFrame bottomOffset - fdy]]] .
-
- self layoutFrame hasFixedWidth ifTrue: [
- | oleft oright cleft cright leftf |
-
- oleft := (owner submorphs detect: [:m |
- m layoutFrame leftFraction isZero] ifNone: [^ self]) in: [:tm |
- tm left - (tm layoutFrame leftOffset)].
-
- oright := (owner submorphs detect: [:m |
- m layoutFrame rightFraction = 1] ifNone: [^ self]) in: [:tm |
- tm right - (tm layoutFrame rightOffset)].
-
- cleft := (self layoutFrame leftFraction * (oright - oleft)) rounded
- + oleft + (self layoutFrame leftOffset).
- cright := (self layoutFrame rightFraction * (oright - oleft)) rounded
- + oleft + (self layoutFrame rightOffset).
-
- leftf := self layoutFrame leftFraction.
- self layoutFrame leftFraction: ((cleft + cright) * 0.5 - oleft) / (oright - oleft) asFloat.
- self layoutFrame rightFraction: self layoutFrame leftFraction.
-
-
- self layoutFrame leftOffset: self layoutFrame leftOffset - fdx.
- self layoutFrame rightOffset: self layoutFrame rightOffset - fdx.
-
- (leftOrTop copy union: rightOrBottom) do: [:m |
- (m layoutFrame leftFraction closeTo: leftf) ifTrue: [
- m layoutFrame leftFraction: self layoutFrame leftFraction.
- m layoutFrame leftOffset: m layoutFrame leftOffset - fdx].
- (m layoutFrame rightFraction closeTo: leftf) ifTrue: [
- m layoutFrame rightFraction: self layoutFrame leftFraction.
- m layoutFrame rightOffset: m layoutFrame rightOffset - fdx.]]] .
-
- self removeProperty: #fullDelta.
- owner layoutChanged
- !
Item was removed:
- ----- Method: ProportionalSplitterMorph>>beSplitsLeftAndRight (in category 'initialization') -----
- beSplitsLeftAndRight
-
- splitsTopAndBottom := false.
- self
- hResizing: #rigid;
- vResizing: #spaceFill.
- self width: self class gripThickness.!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>beSplitsTopAndBottom (in category 'initialization') -----
- beSplitsTopAndBottom
-
- splitsTopAndBottom := true.
- self
- vResizing: #rigid;
- hResizing: #spaceFill.
- self height: self class gripThickness.!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>bordersOn: (in category 'queries - controlled morphs') -----
- bordersOn: aMorph
- "Answer true if the aMorph is one of my neighbours."
-
- ^ (leftOrTop includes: aMorph) or: [rightOrBottom includes: aMorph]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>bottomBoundary (in category 'queries - geometry') -----
- bottomBoundary
- "Answert the bottommost x position the receiver could be moved."
-
- | splitter morphs |
- splitter := self splitterBelow.
- morphs := self commonNeighbours: rightOrBottom with: splitter.
- ^ (splitter
- ifNil: [owner isSystemWindow ifTrue: [owner panelRect bottom]
- ifFalse: [owner innerBounds bottom]]
- ifNotNil: [splitter top])
- - (self minimumHeightOf: morphs)!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>canEncroachWhiteSpaceOf: (in category 'smart splitters - queries') -----
- canEncroachWhiteSpaceOf: morphs
- ^ morphs allSatisfy: [ : each | each canBeEncroached ]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>charactersOccludedIn: (in category 'smart splitters - queries') -----
- charactersOccludedIn: aCollection
- ^ aCollection
- inject: 0
- into:
- [ : sum : each | sum +
- (each isMorphicModel
- ifTrue: [ each charactersOccluded ]
- ifFalse: [ 0 ]) ]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>commonNeighbours:with: (in category 'queries - controlled morphs') -----
- commonNeighbours: morphs with: aProportionalSplitterMorphOrNil
- "Answer the subset of morphs which is also confined by aProportionalSplitterMorphOrNil."
-
- ^ aProportionalSplitterMorphOrNil isNil
- ifTrue: [morphs]
- ifFalse: [morphs select: [ :which |
- aProportionalSplitterMorphOrNil bordersOn: which]]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- super drawOn: aCanvas.
-
- self showHandle ifTrue: [
- self splitsLeftAndRight ifTrue: [
- aCanvas
- fillRoundRect: (((self width - (self handleInset * 2) max: 1) @ (self height * 0.25 min: self class handleLength)) center: self center)
- radius: 3
- fillStyle: (SolidFillStyle color: self handleColor)].
- self splitsTopAndBottom ifTrue: [
- aCanvas
- fillRoundRect: (((self width * 0.25 min: self class handleLength) @ (self height - (self handleInset * 2) max: 1)) center: self center)
- radius: 3
- fillStyle: (SolidFillStyle color: self handleColor)] ].!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
-
- self beSplitsLeftAndRight.
-
- leftOrTop := OrderedCollection new.
- rightOrBottom := OrderedCollection new.
-
- self initializeMovements.!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>initializeMovements (in category 'smart splitters') -----
- initializeMovements
- movements := OrderedCollection new: 3 withAll: 0!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>leftBoundary (in category 'queries - geometry') -----
- leftBoundary
- "Answer the leftmost y position the receiver could be moved."
-
- | splitter morphs |
- splitter := self splitterLeft.
- morphs := self commonNeighbours: leftOrTop with: splitter.
- ^ (splitter
- ifNil: [owner isSystemWindow ifTrue: [owner panelRect left]
- ifFalse: [owner innerBounds left]]
- ifNotNil: [splitter right])
- + (self minimumWidthOf: morphs)!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>leftRightImbalance (in category 'smart splitters - queries') -----
- leftRightImbalance
- "First check if I find myself out of range due to user having reduced size of parent."
- ^ self left < self leftBoundary "too far left"
- ifTrue: [ self leftBoundary-self left ]
- ifFalse:
- [ self right > self rightBoundary "too far right"
- ifTrue: [ self rightBoundary-self right ]
- ifFalse: [ self occlusionDifference ] ]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>minimumHeightOf: (in category 'queries - geometry') -----
- minimumHeightOf: aCollection
- "Answer the minimum height needed to display any of the morphs in aCollection.
- See ProportionalLayout >> #minExtentOf:in:."
-
- ^ aCollection inject: 0 into: [ :height :morph |
- | minHeight |
- minHeight := morph minHeight.
- "morph layoutFrame ifNotNil: [:frame |
- minHeight := frame minHeightFrom: minHeight]."
- minHeight + self height max: height]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>minimumWidthOf: (in category 'queries - geometry') -----
- minimumWidthOf: aCollection
- "Answer the minimum width needed to display any of the morphs in aCollection.
- See ProportionalLayout >> #minExtentOf:in:."
-
- ^ aCollection inject: 0 into: [ :width :morph |
- | minWidth |
- minWidth := morph minWidth.
- "morph layoutFrame ifNotNil: [:frame |
- minWidth := frame minWidthFrom: minWidth]."
- minWidth + self width max: width]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>mouseDown: (in category 'events') -----
- mouseDown: anEvent
- "If the user manually drags me, don't override him with auto positioning."
-
- self setProperty: #fullDelta toValue: 0 at 0.
-
- anEvent redButtonChanged
- ifTrue: [ self withSiblingSplittersDo: [ : each | each stopStepping ] ]
- ifFalse:
- [ anEvent shiftPressed
- ifTrue: [ self startStepping ]
- ifFalse:
- [ self startStepping.
- self withSiblingSplittersDo: [ : each | each startStepping ] ] ].
-
- ^ super mouseDown: anEvent!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>mouseMove: (in category 'events') -----
- mouseMove: anEvent
- anEvent hand temporaryCursor
- ifNil: [^ self].
- self class fastSplitterResize
- ifFalse: [self updateFromEvent: anEvent]
- ifTrue: [traceMorph
- ifNil: [traceMorph := Morph newBounds: self bounds.
- traceMorph color: (Color gray alpha: 0.5).
- traceMorph borderWidth: 0.
- self owner addMorph: traceMorph].
- splitsTopAndBottom
- ifTrue: [traceMorph position: traceMorph position x @ (self normalizedY: anEvent cursorPoint y)]
- ifFalse: [traceMorph position: (self normalizedX: anEvent cursorPoint x) @ traceMorph position y]]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>mouseUp: (in category 'events') -----
- mouseUp: anEvent
- (self bounds containsPoint: anEvent cursorPoint) ifFalse: [ anEvent hand showTemporaryCursor: nil ].
- self class fastSplitterResize ifTrue: [ self updateFromEvent: anEvent ].
- traceMorph ifNotNil:
- [ traceMorph delete.
- traceMorph := nil ].
-
- "balanceOffsets currently disrupts Smart Splitter behavior."
- self isStepping ifTrue: [
- (ProportionalSplitterMorph smartVerticalSplitters
- or: [ ProportionalSplitterMorph smartHorizontalSplitters ])
- ifFalse: [ self balanceOffsets ] ].!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>movements (in category 'smart splitters') -----
- movements
- "Used to track my pattern of movement for the last 3 steps to fix the twitching."
- "Lazy-init for now for smooth transition -- want to convert this back to direct-var access after a few months."
- ^ movements ifNil: [ self initializeMovements. movements ]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>normalizedX: (in category 'queries - geometry') -----
- normalizedX: x
-
- ^ (x max: self leftBoundary) min: self rightBoundary!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>normalizedY: (in category 'queries - geometry') -----
- normalizedY: y
-
- ^ (y max: self topBoundary) min: self bottomBoundary!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>occlusionDifference (in category 'smart splitters - queries') -----
- occlusionDifference
- ^ (self charactersOccludedIn: leftOrTop) - (self charactersOccludedIn: rightOrBottom)!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>proposedCorrectionWouldCauseFocusChange: (in category 'smart splitters - queries') -----
- proposedCorrectionWouldCauseFocusChange: correction
- ^ Preferences mouseOverForKeyboardFocus and:
- [ | edge | splitsTopAndBottom
- ifTrue:
- [ edge := correction positive
- ifTrue: [ self bottom + 3 ]
- ifFalse: [ self top - 3 ].
- self activeHand position y
- inRangeOf: edge
- and: edge + correction ]
- ifFalse:
- [ edge := correction positive
- ifTrue: [ self right ]
- ifFalse: [ self left ].
- self activeHand position x
- inRangeOf: edge
- and: edge + correction ] ]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>reduceLeftRightImbalance (in category 'smart splitters') -----
- reduceLeftRightImbalance
- | correction |
- correction := self leftRightImbalance.
- correction abs > 1
- ifTrue:
- [ (self proposedCorrectionWouldCauseFocusChange: correction) ifFalse:
- [ self repositionBy:
- (correction abs > 4
- ifTrue: [ correction sign * 2 @ 0 ]
- ifFalse: [ correction sign @ 0 ]) ] ]
- ifFalse:
- [ self class smartVerticalSplitters ifFalse: [ self stopStepping ] ].
- ^ correction!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>reduceTopBottomImbalance (in category 'smart splitters') -----
- reduceTopBottomImbalance
- | correction |
- (correction := self topBottomCorrection) isZero
- ifTrue:
- [ self class smartHorizontalSplitters ifFalse: [ self stopStepping ] ]
- ifFalse:
- [ (self proposedCorrectionWouldCauseFocusChange: correction) ifFalse: [ self repositionBy: 0 @ correction ] ].
- ^ correction!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>repositionBy: (in category 'events') -----
- repositionBy: delta
- | selfTop selfBottom selfLeft selfRight |
-
- self setProperty: #fullDelta toValue: ((self valueOfProperty: #fullDelta) ifNil: [0 at 0]) + delta.
-
- leftOrTop do:
- [ : each | | firstRight firstBottom firstLeft firstTop |
- firstRight := each layoutFrame rightOffset.
- firstBottom := each layoutFrame bottomOffset.
- each layoutFrame rightOffset: firstRight + delta x.
- each layoutFrame bottomOffset: firstBottom + delta y.
- each layoutFrame hasFixedHeight ifTrue: [
- firstTop := each layoutFrame topOffset.
- each layoutFrame topOffset: firstTop + delta y ].
- each layoutFrame hasFixedWidth ifTrue: [
- firstLeft := each layoutFrame leftOffset.
- each layoutFrame leftOffset: firstLeft + delta x. ] ].
- rightOrBottom do:
- [ : each | | secondLeft secondTop secondRight secondBottom |
- secondLeft := each layoutFrame leftOffset.
- secondTop := each layoutFrame topOffset.
- each layoutFrame leftOffset: secondLeft + delta x.
- each layoutFrame topOffset: secondTop + delta y.
- each layoutFrame hasFixedHeight ifTrue: [
- secondBottom := each layoutFrame bottomOffset.
- each layoutFrame bottomOffset: secondBottom + delta y. ].
- each layoutFrame hasFixedWidth ifTrue: [
- secondRight := each layoutFrame rightOffset.
- each layoutFrame rightOffset: secondRight + delta x. ] ].
-
- selfTop := self layoutFrame topOffset.
- selfBottom := self layoutFrame bottomOffset.
- selfLeft := self layoutFrame leftOffset.
- selfRight := self layoutFrame rightOffset.
- self layoutFrame
- topOffset: selfTop + delta y ;
- bottomOffset: selfBottom + delta y ;
- leftOffset: selfLeft + delta x ;
- rightOffset: selfRight + delta x.
- self owner layoutChanged.
- self movements removeFirst; add: (splitsTopAndBottom ifTrue: [ delta y sign ] ifFalse: [ delta x sign ])!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>resizeCursor (in category 'accessing') -----
- resizeCursor
-
- ^ Cursor resizeForEdge: (splitsTopAndBottom
- ifTrue: [#top]
- ifFalse: [#left])
- !
Item was removed:
- ----- Method: ProportionalSplitterMorph>>rightBoundary (in category 'queries - geometry') -----
- rightBoundary
- "Answer the rightmost x position the receiver could be moved to."
-
- | splitter morphs |
- splitter := self splitterRight.
- morphs := self commonNeighbours: rightOrBottom with: splitter.
-
- ^ (splitter
- ifNil: [owner isSystemWindow ifTrue: [owner panelRect right]
- ifFalse: [owner innerBounds right]]
- ifNotNil: [splitter left])
- - (self minimumWidthOf: morphs)!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>showHandle (in category 'accessing') -----
- showHandle
-
- ^ showHandle ifNil: [self class showSplitterHandles]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>siblingSplittersDo: (in category 'queries - adjacent splitters') -----
- siblingSplittersDo: aBlock
- owner ifNotNil:
- [ owner submorphsDo:
- [ : each | ((each isKindOf: self class) and:
- [ self splitsTopAndBottom = each splitsTopAndBottom and: [ each ~= self ] ]) ifTrue: [ aBlock value: each ] ] ]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>splitsLeftAndRight (in category 'testing') -----
- splitsLeftAndRight
-
- ^ self splitsTopAndBottom not!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>splitsTopAndBottom (in category 'testing') -----
- splitsTopAndBottom
-
- ^ splitsTopAndBottom!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>splitterAbove (in category 'queries - adjacent splitters') -----
- splitterAbove
- | immediatelyAbove |
- immediatelyAbove := nil.
- self siblingSplittersDo:
- [ : each | "Splitter y's map 0 at the bottom."
- each y > self y ifTrue:
- [ immediatelyAbove
- ifNil: [ immediatelyAbove := each ]
- ifNotNil:
- [ each y < immediatelyAbove y ifTrue: [ immediatelyAbove := each ] ] ] ].
- ^ immediatelyAbove!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>splitterBelow (in category 'queries - adjacent splitters') -----
- splitterBelow
- | immediatelyBelow |
- immediatelyBelow := nil.
- self siblingSplittersDo:
- [ : each | each y < self y ifTrue:
- [ immediatelyBelow
- ifNil: [ immediatelyBelow := each ]
- ifNotNil:
- [ each y > immediatelyBelow y ifTrue: [ immediatelyBelow := each ] ] ] ].
- ^ immediatelyBelow!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>splitterLeft (in category 'queries - adjacent splitters') -----
- splitterLeft
- | immediateLeft |
- immediateLeft := nil.
- self siblingSplittersDo:
- [ : each | each x < self x ifTrue:
- [ immediateLeft
- ifNil: [ immediateLeft := each ]
- ifNotNil:
- [ each x > immediateLeft x ifTrue: [ immediateLeft := each ] ] ] ].
- ^ immediateLeft!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>splitterRight (in category 'queries - adjacent splitters') -----
- splitterRight
- | immediateRight |
- immediateRight := nil.
- self siblingSplittersDo:
- [ : each | each x > self x ifTrue:
- [ immediateRight
- ifNil: [ immediateRight := each ]
- ifNotNil:
- [ each x < immediateRight x ifTrue: [ immediateRight := each ] ] ] ].
- ^ immediateRight!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>splittersAboveDo: (in category 'queries - adjacent splitters') -----
- splittersAboveDo: aBlock
- self splitterAbove ifNotNil:
- [ : splitter | aBlock value: splitter.
- splitter splittersAboveDo: aBlock ]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>splittersBelowDo: (in category 'queries - adjacent splitters') -----
- splittersBelowDo: aBlock
- self splitterBelow ifNotNil:
- [ : splitter | aBlock value: splitter.
- splitter splittersBelowDo: aBlock ]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>splittersLeftDo: (in category 'queries - adjacent splitters') -----
- splittersLeftDo: aBlock
- self splitterLeft ifNotNil:
- [ : splitter | aBlock value: splitter.
- splitter splittersLeftDo: aBlock ]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>splittersRightDo: (in category 'queries - adjacent splitters') -----
- splittersRightDo: aBlock
- self splitterRight ifNotNil:
- [ : splitter | aBlock value: splitter.
- splitter splittersRightDo: aBlock ]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>step (in category 'smart splitters - stepping') -----
- step
- splitsTopAndBottom
- ifTrue: [ self reduceTopBottomImbalance ]
- ifFalse:
- [ self reduceLeftRightImbalance abs > 1 ifTrue:
- [ self splittersLeftDo:
- [ : splitter | splitter reduceLeftRightImbalance ].
- self splittersRightDo:
- [ : splitter | splitter reduceLeftRightImbalance ] ] ]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>stepTime (in category 'smart splitters - stepping') -----
- stepTime
- "When a splitter finds itself in the right place, let it rest for about 3 seconds to avoid performance impacts of constant, rapid stepping."
- | pause |
- pause := 3000. "Frozen image when atRandom failed due to lock on its Mutex."
- ^ ({#(1 -1 1 ). #(-1 1 -1 )} includes: self movements asArray)
- ifTrue: [ pause "don't twitch" ]
- ifFalse:
- [ splitsTopAndBottom
- ifTrue:
- [ self topBottomCorrection isZero
- ifTrue: [ pause ]
- ifFalse: [ 0 ] ]
- ifFalse:
- [ self leftRightImbalance abs > 1
- ifTrue: [ ">1 rather than 0 to discourage one-off twitching"
- 0 ]
- ifFalse: [ pause ] ] ]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>stopStepping (in category 'smart splitters - stepping') -----
- stopStepping
-
- self isStepping ifFalse: [^ self].
- super stopStepping.
- (self class smartVerticalSplitters or: [ self class smartHorizontalSplitters ]) ifFalse: [ self balanceOffsets ]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>topBottomCorrection (in category 'smart splitters - queries') -----
- topBottomCorrection
- ^ self top < self topBoundary
- ifTrue: [ self topBoundary - self top ]
- ifFalse:
- [ self bottom > (self bottomBoundary)
- ifTrue: [ self bottomBoundary - self bottom ]
- ifFalse:
- [ | wsAbove wsBelow |
- wsAbove := self canEncroachWhiteSpaceOf: leftOrTop.
- wsBelow := self canEncroachWhiteSpaceOf: rightOrBottom.
- wsAbove
- ifTrue:
- [ wsBelow
- ifTrue:
- [ self splitterBelow
- ifNil: [0]
- ifNotNil: [ : below | below reduceTopBottomImbalance min: 0 ] ]
- ifFalse: [ (self top > self topBoundary) ifTrue: [-2] ifFalse: [0] ] ]
- ifFalse:
- [ wsBelow
- ifTrue: [ (self bottom < self bottomBoundary) ifTrue: [2] ifFalse: [0] ]
- ifFalse:
- [ self splitterBelow
- ifNil: [0]
- ifNotNil: [ : below | below reduceTopBottomImbalance max: 0 ] ] ] ] ]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>topBoundary (in category 'queries - geometry') -----
- topBoundary
- "Answer the topmost x position the receiver could be moved to."
-
- | splitter morphs |
- splitter := self splitterAbove.
- morphs := self commonNeighbours: leftOrTop with: splitter.
- ^ (splitter
- ifNil: [owner isSystemWindow ifTrue: [owner panelRect top]
- ifFalse: [owner innerBounds top]]
- ifNotNil: [splitter bottom])
- + (self minimumHeightOf: morphs)!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>updateFromEvent: (in category 'events') -----
- updateFromEvent: anEvent
- | delta |
- lastMouse ifNil: [ lastMouse := anEvent position - self position ].
- delta := splitsTopAndBottom
- ifTrue: [ 0 @ ((self normalizedY: anEvent cursorPoint y) - (lastMouse y + self top)) ]
- ifFalse: [ (self normalizedX: anEvent cursorPoint x) - (lastMouse x + self left) @ 0 ].
- self repositionBy: delta!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>wantsSteps (in category 'smart splitters - stepping') -----
- wantsSteps
- ^ splitsTopAndBottom
- ifTrue: [ self class smartHorizontalSplitters ]
- ifFalse: [ self class smartVerticalSplitters ]!
Item was removed:
- ----- Method: ProportionalSplitterMorph>>withSiblingSplittersDo: (in category 'queries - adjacent splitters') -----
- withSiblingSplittersDo: aBlock
- aBlock value: self.
- self siblingSplittersDo: aBlock!
Item was removed:
- SimpleBorder subclass: #RaisedBorder
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Borders'!
-
- !RaisedBorder commentStamp: 'kfr 10/27/2003 09:32' prior: 0!
- see BorderedMorph!
Item was removed:
- ----- Method: RaisedBorder>>bottomRightColor (in category 'accessing') -----
- bottomRightColor
- ^ color mixed: 0.70 with: Color black!
Item was removed:
- ----- Method: RaisedBorder>>style (in category 'accessing') -----
- style
- ^#raised!
Item was removed:
- ----- Method: RaisedBorder>>topLeftColor (in category 'accessing') -----
- topLeftColor
- ^ color mixed: 0.65 with: Color white!
Item was removed:
- ----- Method: RaisedBorder>>trackColorFrom: (in category 'color tracking') -----
- trackColorFrom: aMorph
- baseColor isTransparent ifTrue:[self color: aMorph raisedColor].!
Item was removed:
- BorderedMorph subclass: #RectangleMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Basic'!
-
- !RectangleMorph commentStamp: 'kfr 10/27/2003 11:12' prior: 0!
- A subclass of BorderedMorph that supports different fillStyles.
-
- RectangleMorph diagonalPrototype openInWorld.
- RectangleMorph gradientPrototype openInWorld.!
Item was removed:
- ----- Method: RectangleMorph class>>descriptionForPartsBin (in category 'parts bin') -----
- descriptionForPartsBin
- ^ self partName: 'Rectangle' translatedNoop
- categories: {'Graphics' translatedNoop. 'Basic' translatedNoop}
- documentation: 'A rectangular shape, with border and fill style' translatedNoop!
Item was removed:
- ----- Method: RectangleMorph class>>diagonalPrototype (in category 'parts bin') -----
- diagonalPrototype
-
- | rr |
- rr := self authoringPrototype.
- rr useGradientFill; borderWidth: 0.
- rr fillStyle direction: rr extent.
- ^ rr!
Item was removed:
- ----- Method: RectangleMorph class>>gradientPrototype (in category 'parts bin') -----
- gradientPrototype
-
- | rr |
- rr := self authoringPrototype.
- rr useGradientFill; borderWidth: 0.
- ^ rr!
Item was removed:
- ----- Method: RectangleMorph class>>roundRectPrototype (in category 'parts bin') -----
- roundRectPrototype
- "Answer a prototypical RoundRect object for a parts bin."
-
- ^ self authoringPrototype useRoundedCorners
- color: (Color r: 1.0 g: 0.3 b: 0.6);
- borderWidth: 1;
- setNameTo: 'RoundRect'!
Item was removed:
- ----- Method: RectangleMorph>>canHaveFillStyles (in category 'visual properties') -----
- canHaveFillStyles
- "Return true if the receiver can have general fill styles; not just colors.
- This method is for gradually converting old morphs."
- ^self class == RectangleMorph "no subclasses"!
Item was removed:
- ----- Method: RectangleMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color
- r: 0.613
- g: 0.903
- b: 1.0!
Item was removed:
- ----- Method: RectangleMorph>>wantsToBeCachedByHand (in category 'accessing') -----
- wantsToBeCachedByHand
- "Return true if the receiver wants to be cached by the hand when it is dragged around."
- self hasTranslucentColor ifTrue:[^false].
- self bounds = self fullBounds ifTrue:[^true].
- self submorphsDo:[:m|
- (self bounds containsRect: m fullBounds) ifFalse:[
- m wantsToBeCachedByHand ifFalse:[^false].
- ].
- ].
- ^true!
Item was removed:
- BorderGripMorph subclass: #RightGripMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
Item was removed:
- ----- Method: RightGripMorph>>apply: (in category 'target resize') -----
- apply: delta
- | oldBounds |
- oldBounds := self target bounds.
- self target
- bounds: (oldBounds origin corner: oldBounds corner + (delta x @ 0))!
Item was removed:
- ----- Method: RightGripMorph>>defaultWidth (in category 'initialize') -----
- defaultWidth
-
- ^ self class gripThickness!
Item was removed:
- ----- Method: RightGripMorph>>gripLayoutFrame (in category 'accessing') -----
- gripLayoutFrame
- ^ LayoutFrame
- fractions: (1 @ 0 corner: 1 @ 1)
- offsets: (0 @ 0 corner: 0 @ 0)!
Item was removed:
- ----- Method: RightGripMorph>>initialize (in category 'initialize') -----
- initialize
- super initialize.
- self vResizing: #spaceFill.!
Item was removed:
- ----- Method: RightGripMorph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
- layoutProportionallyInBounds: layoutBounds positioning: cellPositioning
-
- super layoutProportionallyInBounds: layoutBounds positioning: cellPositioning.
-
- self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
- self right: owner right.
-
- self top: owner top.
- self height: owner height.!
Item was removed:
- ----- Method: RightGripMorph>>orientation (in category 'accessing') -----
- orientation
-
- ^ #vertical!
Item was removed:
- ----- Method: RightGripMorph>>ptName (in category 'accessing') -----
- ptName
- ^#right!
Item was removed:
- ----- Method: RightGripMorph>>resizeCursor (in category 'accessing') -----
- resizeCursor
-
- ^ Cursor resizeForEdge: #right!
Item was removed:
- Morph subclass: #SVColorSelectorMorph
- instanceVariableNames: 'selectedColor locationMorph'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !SVColorSelectorMorph commentStamp: 'gvc 8/8/2007 14:36' prior: 0!
- A colour selector that displays an area with saturation on the x axis and volume on the y axis. Provides interactive selection of colour by mouse. For the moment it is event rather than model based.
- Setting the color will specify the hue and setting the selectedColor will specify the saturation and volume (may have a different hue to that displayed if not in sync).!
Item was removed:
- ----- Method: SVColorSelectorMorph>>adoptPaneColor: (in category 'accessing') -----
- adoptPaneColor: paneColor
- "Pass on to the border too."
-
- super adoptPaneColor: paneColor.
- self borderStyle baseColor: paneColor twiceDarker!
Item was removed:
- ----- Method: SVColorSelectorMorph>>basicColor: (in category 'visual properties') -----
- basicColor: aColor
- "Set the gradient colors."
-
- super color: aColor asNontranslucentColor.
- self
- fillStyle: self gradient!
Item was removed:
- ----- Method: SVColorSelectorMorph>>blackGradient (in category 'private') -----
- blackGradient
- "Answer the black gradient. Top to bottom, transparent to black."
-
- ^(InterpolatedGradientFillStyle colors: {Color black alpha: 0. Color black})
- origin: self innerBounds topLeft;
- direction: 0 at self innerBounds height!
Item was removed:
- ----- Method: SVColorSelectorMorph>>blackGradientMorph (in category 'private') -----
- blackGradientMorph
- "Answer the black gradient morph."
-
- ^Morph new
- hResizing: #spaceFill;
- vResizing: #spaceFill;
- fillStyle: self blackGradient!
Item was removed:
- ----- Method: SVColorSelectorMorph>>borderWidth: (in category 'accessing') -----
- borderWidth: anInteger
- "Update the gradients after setting."
-
- super borderWidth: anInteger.
- self updateGradients!
Item was removed:
- ----- Method: SVColorSelectorMorph>>color: (in category 'accessing') -----
- color: aColor
- "Set the gradient colors."
-
- self
- basicColor: aColor;
- selectedColor: (Color h: aColor hue s: self selectedColor saturation v: self selectedColor brightness)!
Item was removed:
- ----- Method: SVColorSelectorMorph>>colorAt: (in category 'color selecting') -----
- colorAt: aPoint
- "Answer the color in the world at the given point."
-
- ^self isInWorld
- ifTrue: [(Display colorAt: aPoint) asNontranslucentColor ]
- ifFalse: [Color black]!
Item was removed:
- ----- Method: SVColorSelectorMorph>>extent: (in category 'geometry') -----
- extent: p
- "Update the gradient directions."
-
- super extent: p.
- self updateGradients!
Item was removed:
- ----- Method: SVColorSelectorMorph>>fillStyle: (in category 'visual properties') -----
- fillStyle: fillStyle
- "If it is a color then override with gradient."
-
- fillStyle isColor
- ifTrue: [self color: fillStyle]
- ifFalse: [super fillStyle: fillStyle]!
Item was removed:
- ----- Method: SVColorSelectorMorph>>gradient (in category 'visual properties') -----
- gradient
- "Answer the base gradient."
-
- |b|
- b := self innerBounds.
- ^(GradientFillStyle colors: {Color white. self color})
- origin: b topLeft;
- direction: (b width at 0)!
Item was removed:
- ----- Method: SVColorSelectorMorph>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: evt
- "Yes for down and move.."
-
- ^true!
Item was removed:
- ----- Method: SVColorSelectorMorph>>handlesMouseOverDragging: (in category 'event handling') -----
- handlesMouseOverDragging: evt
- "Yes, make the location morph visible when leaving."
-
- ^true!
Item was removed:
- ----- Method: SVColorSelectorMorph>>hideLocation (in category 'private') -----
- hideLocation
- "Hide the location morph and update the display."
-
- self locationMorph visible: false.
- self refreshWorld.!
Item was removed:
- ----- Method: SVColorSelectorMorph>>initialize (in category 'initialization') -----
- initialize
- "Initialize the receiver."
-
- super initialize.
- self locationMorph: self newLocationMorph.
- self
- clipSubmorphs: true;
- color: Color blue;
- borderStyle: (BorderStyle inset width: 1);
- addMorphBack: self locationMorph;
- addMorphBack: self blackGradientMorph!
Item was removed:
- ----- Method: SVColorSelectorMorph>>locationMorph (in category 'accessing') -----
- locationMorph
- "Answer the value of locationMorph"
-
- ^ locationMorph!
Item was removed:
- ----- Method: SVColorSelectorMorph>>locationMorph: (in category 'accessing') -----
- locationMorph: anObject
- "Set the value of locationMorph"
-
- locationMorph := anObject!
Item was removed:
- ----- Method: SVColorSelectorMorph>>mouseDown: (in category 'event handling') -----
- mouseDown: evt
- "Handle a mouse down event. Select the color at the mouse position."
-
- evt redButtonPressed
- ifFalse: [^super mouseDown: evt].
- evt hand showTemporaryCursor: (Cursor crossHair copy offset: -9 @ -9).
- self hideLocation.
- self selectColorAt: evt position.
- ^super mouseDown: evt!
Item was removed:
- ----- Method: SVColorSelectorMorph>>mouseEnterDragging: (in category 'event handling') -----
- mouseEnterDragging: evt
- "Make the location morph invisible when entering."
-
- self hideLocation.
- evt hand showTemporaryCursor: (Cursor crossHair copy offset: -9 @ -9).!
Item was removed:
- ----- Method: SVColorSelectorMorph>>mouseLeaveDragging: (in category 'event handling') -----
- mouseLeaveDragging: evt
- "Make the location morph visible when leaving."
-
- evt hand showTemporaryCursor: nil.
- self showLocation!
Item was removed:
- ----- Method: SVColorSelectorMorph>>mouseMove: (in category 'event handling') -----
- mouseMove: evt
- "Handle a mouse move event. Select the color at the mouse position."
-
- evt redButtonPressed
- ifFalse: [^super mouseMove: evt].
- self selectColorAt: evt position.
- ^super mouseMove: evt!
Item was removed:
- ----- Method: SVColorSelectorMorph>>mouseUp: (in category 'event handling') -----
- mouseUp: evt
- "Handle a up event. Show the location morph again."
-
- evt hand showTemporaryCursor: nil.
- self updateSelectedLocation.
- self locationMorph visible: true!
Item was removed:
- ----- Method: SVColorSelectorMorph>>newLocationMorph (in category 'private') -----
- newLocationMorph
- "Answer a new morph indicating the location of the selected color."
-
- ^ImageMorph new
- image: Cursor crossHair withMask asCursorForm!
Item was removed:
- ----- Method: SVColorSelectorMorph>>selectColorAt: (in category 'color selecting') -----
- selectColorAt: aPoint
- "Set the color at the given position."
-
- |b p|
- b := self innerBounds.
- p := (b containsPoint: aPoint)
- ifTrue: [aPoint]
- ifFalse: [b pointNearestTo: aPoint].
- p := p - b topLeft / b extent.
- self selectedColor: (Color
- h: self color hue
- s: p x
- v: 1.0 - p y)!
Item was removed:
- ----- Method: SVColorSelectorMorph>>selectedColor (in category 'accessing') -----
- selectedColor
- "Answer the value of selectedColor"
-
- ^selectedColor ifNil: [self color]!
Item was removed:
- ----- Method: SVColorSelectorMorph>>selectedColor: (in category 'accessing') -----
- selectedColor: aColor
- "Set the value of selectedColor."
-
- selectedColor := aColor.
- self locationMorph visible ifTrue: [self updateSelectedLocation].
- self triggerEvent: #colorSelected with: aColor!
Item was removed:
- ----- Method: SVColorSelectorMorph>>selectedLocation (in category 'color selecting') -----
- selectedLocation
- "Answer the location within the receiver of the selected colour
- relative to the receiver's top left."
-
- |b c x y|
- b := self innerBounds.
- c := self selectedColor.
- x := c saturation * (b width - 1).
- y := 1 - c brightness * (b height - 1).
- ^(x truncated @ y truncated) + b topLeft!
Item was removed:
- ----- Method: SVColorSelectorMorph>>showLocation (in category 'private') -----
- showLocation
- "Show the location morph and update the display."
-
- self locationMorph visible: true.
- self refreshWorld.!
Item was removed:
- ----- Method: SVColorSelectorMorph>>updateGradients (in category 'private') -----
- updateGradients
- "Update the gradient directions."
-
- |bgm b|
- b := self innerBounds.
- bgm := self submorphs last.
- bgm bounds: b.
- bgm fillStyle
- origin: b topLeft;
- direction: 0 at b height.
- self fillStyle
- origin: b topLeft;
- direction: (b width at 0).
- self updateSelectedLocation!
Item was removed:
- ----- Method: SVColorSelectorMorph>>updateSelectedLocation (in category 'private') -----
- updateSelectedLocation
- "Position the location morph to indicate the selected colour."
-
- self locationMorph
- position: (self selectedLocation - (self locationMorph extent // 2 + (self locationMorph extent \\ 2)))!
Item was removed:
- ----- Method: SampledSound>>sonogramMorph:from:to:nPoints: (in category '*Morphic-Sounds-sound tracks') -----
- sonogramMorph: height from: start to: stop nPoints: nPoints
- "FYI: It is very cool that we can do this, but for sound tracks on a movie,
- simple volume is easier to read, easier to scale, and way faster to compute.
- Code preserved here just in case it makes a useful example."
- "In an inspector of a samplesSound...
- self currentWorld addMorph: (self sonogramMorph: 32 from: 1 to: 50000 nPoints: 256)
- "
- | fft sonogramMorph width |
- fft := FFT new: nPoints.
- width := stop-start//nPoints.
- sonogramMorph := Sonogram new
- extent: width at height
- minVal: 0.0
- maxVal: 1.0
- scrollDelta: width.
- start to: stop-nPoints by: nPoints do:
- [:i | | data |
- data := fft transformDataFrom: samples startingAt: i.
- data := data collect: [:v | v sqrt]. "square root compresses dynamic range"
- data /= 200.0.
- sonogramMorph plotColumn: data].
- ^ sonogramMorph
-
- !
Item was removed:
- Slider subclass: #ScrollBar
- instanceVariableNames: 'menuButton upButton downButton pagingArea scrollDelta pageDelta interval menuSelector timeOfMouseDown timeOfLastScroll nextPageDirection currentScrollDelay'
- classVariableNames: 'ArrowImagesCache BoxesImagesCache GradientScrollBar RoundedScrollBarLook ScrollBarsWithoutArrowButtons ScrollBarsWithoutMenuButton UpArrow UpArrow8Bit'
- poolDictionaries: ''
- category: 'Morphic-Windows'!
-
- !ScrollBar commentStamp: '<historical>' prior: 0!
- Inspired by an oiginal design of Hans-Martin Mosner, this ScrollBar is intended to exercise the handling of input events in Morphic. With sufficient flexibility in this area, all particular behavior can be concentrated in this single class with no need to specialize any other morphs to achieve button, slider and menu-button behavior.
-
- Once we have this working, put in logic for horizontal operation as well.
-
- CachedImages was added to reduce the number of forms created and thrown away. This will be helpful for Nebraska and others as well.!
Item was removed:
- ----- Method: ScrollBar class>>alwaysShowFlatScrollbarForAlternativeLook (in category 'preferences') -----
- alwaysShowFlatScrollbarForAlternativeLook
- "Set this value to true, if you want to see the flat scrollbar look in flop-out mode as well as inboard. Otherwise the flop-out scrollbar will be rounded and inboard will be flat."
- ^ false!
Item was removed:
- ----- Method: ScrollBar class>>arrowOfDirection:size:color: (in category 'images') -----
- arrowOfDirection: aSymbol size: finalSizeInteger color: aColor
- "answer a form with an arrow based on the parameters"
- ^ ArrowImagesCache at: {aSymbol. finalSizeInteger max: 1. aColor}!
Item was removed:
- ----- Method: ScrollBar class>>arrowSamples (in category 'images - samples') -----
- arrowSamples
- "create a set of arrow with different sizes, colors and directions"
- "
- ScrollBar arrowSamples.
- "
- | column |
- column := AlignmentMorph newColumn vResizing: #shrinkWrap;
- hResizing: #shrinkWrap;
- layoutInset: 1;
- borderColor: Color black;
- borderWidth: 0;
- wrapCentering: #center;
- cellPositioning: #center;
- color: Color white;
- yourself.
-
- self sampleSizes
- do: [:size |
- | row |
- row := AlignmentMorph newRow color: Color transparent;
- vResizing: #shrinkWrap;
- cellGap: 2 @ 0;
- yourself.
-
- self sampleColors
- do: [:color |
- #(#top #right #bottom #left )
- do: [:direction |
- row addMorphBack: (ScrollBar
- arrowOfDirection: direction
- size: size
- color: color) asMorph]].
-
- column addMorphBack: row].
-
- column openInHand!
Item was removed:
- ----- Method: ScrollBar class>>boxOfSize:color: (in category 'images') -----
- boxOfSize: finalSizeInteger color: aColor
- "answer a form with an box based on the parameters"
- ^ BoxesImagesCache at: {finalSizeInteger. aColor}!
Item was removed:
- ----- Method: ScrollBar class>>boxSamples (in category 'images - samples') -----
- boxSamples
- "create a set of box with different sizes and colors"
- "
- ScrollBar boxSamples.
- "
- | column |
- column := AlignmentMorph newColumn vResizing: #shrinkWrap;
- hResizing: #shrinkWrap;
- layoutInset: 1;
- borderColor: Color black;
- borderWidth: 0;
- wrapCentering: #center;
- cellPositioning: #center;
- color: Color white;
- yourself.
- ""
- self sampleSizes
- do: [:size |
- | row |
- row := AlignmentMorph newRow color: Color transparent;
- vResizing: #shrinkWrap;
- cellGap: 2 @ 0;
- yourself.
- ""
- self sampleColors
- do: [:color |
- row addMorphBack: (ScrollBar boxOfSize: size color: color) asMorph].
- ""
- column addMorphBack: row].
- ""
- ""
- column openInHand!
Item was removed:
- ----- Method: ScrollBar class>>changesInPreferences (in category 'images') -----
- changesInPreferences
- "the related preferences changed"
- self initializeImagesCache
- " ScrollBar allInstances do: [:each | each removeAllMorphs; initializeSlider] "!
Item was removed:
- ----- Method: ScrollBar class>>cleanUp (in category 'class initialization') -----
- cleanUp
- "Re-initialize the image cache"
-
- self initializeImagesCache!
Item was removed:
- ----- Method: ScrollBar class>>createArrowImagesCache (in category 'class initialization') -----
- createArrowImagesCache
- "creates the cache to store the arrow forms"
- ^ LRUCache
- size: 40
- factory: [:key | ""
- self
- createArrowOfDirection: key first
- size: key second
- color: key third]!
Item was removed:
- ----- Method: ScrollBar class>>createArrowOfDirection:size:color: (in category 'images') -----
- createArrowOfDirection: aSymbolDirection size: size color: aColor
- "PRIVATE - create an arrow with aSymbolDirectionDirection, finalSizeInteger and aColor
- aSymbolDirectionDirection = #top, #bottom. #left or #right
- ScrollBar initializeImagesCache.
- Try with:
- (ScrollBar createArrowOfDirection: #right size: 14 color: Color lightGreen) asMorph openInHand."
-
- | form canvas vertices margin |
- form := Form extent: size asPoint depth: 32.
- canvas := form getCanvas.
- margin := size < 14 ifTrue: [2] ifFalse: [3].
- vertices := {
- size // 2 @ margin.
- size asPoint - margin asPoint.
- margin @ (size-margin).
- size // 2 @ margin}.
-
- "Preferences gradientScrollBars
- ifTrue: [
- fillStyle := GradientFillStyle ramp: {
- 0.0 -> (aColor adjustBrightness: 0.5).
- 0.1-> (aColor adjustBrightness: 0.05).
- 0.6 -> (aColor darker)}.
- fillStyle origin: size // 2 @ margin.
- fillStyle direction: 0 @ size]
- ifFalse: [
- fillStyle := SolidFillStyle color: aColor]. "
-
- canvas
- drawPolygon: vertices
- fillStyle: (SolidFillStyle color: aColor).
-
- ^ (form rotateBy: (aSymbolDirection caseOf: {
- [#top] -> [0].
- [#bottom] -> [180].
- [#left] -> [270].
- [#right] -> [90]})) clippedToSize: size asPoint!
Item was removed:
- ----- Method: ScrollBar class>>createBoxImagesCache (in category 'class initialization') -----
- createBoxImagesCache
- "creates the cache to store the arrow forms"
- ^ LRUCache
- size: 20
- factory: [:key | self createBoxOfSize: key first color: key second]!
Item was removed:
- ----- Method: ScrollBar class>>createBoxOfSize:color: (in category 'images') -----
- createBoxOfSize: anInteger color: aColor
- "PRIVATE - create a box with anInteger and aColor
-
- Try with:
- (ScrollBar createBoxOfSize: 32 color: Color gray) asMorph
- openInHand.
- "
-
- | form canvas margin |
- form := Form extent: anInteger asPoint depth: 32.
- canvas := form getCanvas.
- margin := anInteger < 14 ifTrue: [3] ifFalse: [4].
-
- "Preferences gradientScrollBars
- ifTrue: [
- fillStyle := GradientFillStyle ramp: {
- 0.0 -> (aColor adjustBrightness: 0.5).
- 0.1-> (aColor adjustBrightness: 0.05).
- 0.6 -> (aColor darker)}.
- fillStyle origin: margin asPoint.
- fillStyle direction: anInteger @ 0]
- ifFalse: [
- fillStyle := SolidFillStyle color: aColor]. "
-
- canvas
- fillRectangle: ((0 at 0 extent: anInteger asPoint) insetBy: margin)
- fillStyle: (SolidFillStyle color: aColor).
-
- ^ form!
Item was removed:
- ----- Method: ScrollBar class>>gradientScrollBar (in category 'preferences') -----
- gradientScrollBar
-
- <preference: 'gradientScrollBar'
- categoryList: #(windows scrolling)
- description: 'If true, scroll bars will have a gradient look.'
- type: #Boolean>
- ^ GradientScrollBar ifNil: [false]!
Item was removed:
- ----- Method: ScrollBar class>>gradientScrollBar: (in category 'preferences') -----
- gradientScrollBar: aBoolean
-
- GradientScrollBar = aBoolean ifTrue: [^ self].
- GradientScrollBar := aBoolean.
-
- ScrollBar allSubInstancesDo: [:ea | ea updateSliderColor].!
Item was removed:
- ----- Method: ScrollBar class>>initialize (in category 'class initialization') -----
- initialize
- "ScrollBar initialize"
- UpArrow := Form
- extent: 6 @ 3
- fromArray: #(805306368 2013265920 4227858432 )
- offset: 0 @ 0.
- ""
- self initializeImagesCache.
-
- "Adjustments for FaceLift"
- Preferences disable: #scrollBarsNarrow.
- SystemWindow allSubInstancesDo:[:w| w updatePaneColors].
- ScrollPane allSubInstancesDo:[:pane| pane hideOrShowScrollBars].
- !
Item was removed:
- ----- Method: ScrollBar class>>initializeImagesCache (in category 'class initialization') -----
- initializeImagesCache
- "initialize the receiver's ImagesCache.
-
- normally this method is not evaluated more than in the class
- initializazion. "
-
- "
- ScrollBar initializeImagesCache.
- "
-
- ArrowImagesCache := self createArrowImagesCache.
- BoxesImagesCache := self createBoxImagesCache!
Item was removed:
- ----- Method: ScrollBar class>>postRecompileAction (in category 'class initialization') -----
- postRecompileAction
- "The ArrowImagesCache and BoxesImagesCache are LRUCaches that reference blocks
- (including indirectly via their map which is a PluggableDictionary integerDictionary).
- Rebuild them to ensure blocks reference freshly recompiled methods."
-
- self initializeImagesCache!
Item was removed:
- ----- Method: ScrollBar class>>refreshAllScrollBars (in category 'class initialization') -----
- refreshAllScrollBars
-
- ScrollBar allSubInstances do: [:s |
- s updateSlider].!
Item was removed:
- ----- Method: ScrollBar class>>roundedScrollBarLook (in category 'preferences') -----
- roundedScrollBarLook
-
- <preference: 'roundedScrollBarLook'
- category: #scrolling
- description: 'If true, morphic scrollbars will look rounded.'
- type: #Boolean>
- ^ RoundedScrollBarLook ifNil: [false]!
Item was removed:
- ----- Method: ScrollBar class>>roundedScrollBarLook: (in category 'preferences') -----
- roundedScrollBarLook: aBoolean
-
- RoundedScrollBarLook = aBoolean ifTrue: [^ self].
- RoundedScrollBarLook := aBoolean.
-
- ScrollBar allSubInstancesDo: [:ea | ea updateSliderCornerStyle].!
Item was removed:
- ----- Method: ScrollBar class>>sampleColors (in category 'images - samples') -----
- sampleColors
- "private"
- ^ (Color lightCyan wheel: 5)!
Item was removed:
- ----- Method: ScrollBar class>>sampleSizes (in category 'images - samples') -----
- sampleSizes
-
- "private"
- ^ #(10 12 14 16 18 32 64 )!
Item was removed:
- ----- Method: ScrollBar class>>scrollBarsWithoutArrowButtons (in category 'preferences') -----
- scrollBarsWithoutArrowButtons
-
- <preference: 'scrollBarsWithoutArrowButtons'
- category: #scrolling
- description: 'If true, morphic scrollbars will not include arrow buttons but only the slider.'
- type: #Boolean>
- ^ ScrollBarsWithoutArrowButtons ifNil: [false]!
Item was removed:
- ----- Method: ScrollBar class>>scrollBarsWithoutArrowButtons: (in category 'preferences') -----
- scrollBarsWithoutArrowButtons: aBoolean
-
- ScrollBarsWithoutArrowButtons = aBoolean ifTrue: [^ self].
- ScrollBarsWithoutArrowButtons := aBoolean.
- self refreshAllScrollBars.!
Item was removed:
- ----- Method: ScrollBar class>>scrollBarsWithoutMenuButton (in category 'preferences') -----
- scrollBarsWithoutMenuButton
-
- <preference: 'scrollBarsWithoutMenuButton'
- category: #scrolling
- description: 'If true, morphic scrollbars will not include a menu button.'
- type: #Boolean>
- ^ ScrollBarsWithoutMenuButton ifNil: [false]!
Item was removed:
- ----- Method: ScrollBar class>>scrollBarsWithoutMenuButton: (in category 'preferences') -----
- scrollBarsWithoutMenuButton: aBoolean
-
- ScrollBarsWithoutMenuButton = aBoolean ifTrue: [^ self].
- ScrollBarsWithoutMenuButton := aBoolean.
- self refreshAllScrollBars.!
Item was removed:
- ----- Method: ScrollBar class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ super themeProperties, {
- { #pagingAreaColorModifier. 'Colors'. 'How to modify the paging area color when adopting a pane color.' }.
- { #thumbColorModifier. 'Colors'. 'How to modify the thumb color when adopting a pane color.' }.
- { #borderColorModifier. 'Colors'. 'How to modify the border color when adopting a pane color.' }.
- }!
Item was removed:
- ----- Method: ScrollBar>>adoptPaneColor: (in category 'updating') -----
- adoptPaneColor: aColor
- "Adopt the given pane color"
- aColor ifNil:[^self].
- self sliderColor: aColor.!
Item was removed:
- ----- Method: ScrollBar>>applyUserInterfaceTheme (in category 'updating') -----
- applyUserInterfaceTheme
-
- super applyUserInterfaceTheme.!
Item was removed:
- ----- Method: ScrollBar>>boundsForDownButton (in category 'geometry') -----
- boundsForDownButton
-
- ^ self innerBounds bottomRight - self buttonExtent
- extent: self buttonExtent!
Item was removed:
- ----- Method: ScrollBar>>boundsForMenuButton (in category 'geometry') -----
- boundsForMenuButton
-
- ^ self innerBounds topLeft extent: self buttonExtent!
Item was removed:
- ----- Method: ScrollBar>>boundsForUpButton (in category 'geometry') -----
- boundsForUpButton
-
- ^ (self menuButton visible
- ifFalse: [self innerBounds topLeft]
- ifTrue: [self orientation == #horizontal
- ifTrue: [self menuButton bounds topRight - (1 at 0)]
- ifFalse: [self menuButton bounds bottomLeft - (0 at 1)]])
- extent: self buttonExtent!
Item was removed:
- ----- Method: ScrollBar>>buttonExtent (in category 'geometry') -----
- buttonExtent
- ^ self orientation == #horizontal
- ifTrue: [self innerBounds height asPoint]
- ifFalse: [self innerBounds width asPoint]!
Item was removed:
- ----- Method: ScrollBar>>doScrollByPage (in category 'scrolling') -----
- doScrollByPage
- "Scroll automatically while mouse is down"
- (self waitForDelay1: 300 delay2: 100) ifFalse: [^ self].
- nextPageDirection
- ifTrue: [self setValue: value + pageDelta]
- ifFalse: [self setValue: value - pageDelta]
- !
Item was removed:
- ----- Method: ScrollBar>>doScrollDown (in category 'scrolling') -----
- doScrollDown
- "Scroll automatically while mouse is down"
- (self waitForDelay1: 200 delay2: 40) ifFalse: [^ self].
- self setValue: value + scrollDelta.!
Item was removed:
- ----- Method: ScrollBar>>doScrollUp (in category 'scrolling') -----
- doScrollUp
- "Scroll automatically while mouse is down"
- (self waitForDelay1: 200 delay2: 40) ifFalse: [^ self].
- self setValue: value - scrollDelta.!
Item was removed:
- ----- Method: ScrollBar>>downButton (in category 'accessing') -----
- downButton
- ^ downButton!
Item was removed:
- ----- Method: ScrollBar>>downImage (in category 'images') -----
- downImage
- "answer a form to be used in the down button"
- ^ self class
- arrowOfDirection: (self orientation == #horizontal
- ifTrue: [#right]
- ifFalse: [#bottom])
- size: (self buttonExtent x min: self buttonExtent y)
- color: self imageColor!
Item was removed:
- ----- Method: ScrollBar>>expandSlider (in category 'geometry') -----
- expandSlider
- "Compute the new size of the slider (use the old sliderThickness as a minimum)."
- | r |
- r := self totalSliderArea.
- slider extent: (self orientation == #horizontal
- ifTrue: [(((r width * self interval) asInteger max: self minThumbThickness) min: r width) @ slider height]
- ifFalse: [slider width @ (((r height * self interval) asInteger max: self minThumbThickness) min: r height)])!
Item was removed:
- ----- Method: ScrollBar>>extent: (in category 'geometry') -----
- extent: p
-
- (bounds extent closeTo: p) ifTrue: [^ self].
-
- p x > p y
- ifTrue: [super
- extent: (p max: 8 @ 4)]
- ifFalse: [super
- extent: (p max: 4 @ 8)].
-
- self updateSliderColor.
- !
Item was removed:
- ----- Method: ScrollBar>>finishedScrolling (in category 'scrolling') -----
- finishedScrolling
- self stopStepping.
- self scrollBarAction: nil.
- !
Item was removed:
- ----- Method: ScrollBar>>hasButtons (in category 'testing') -----
- hasButtons
-
- ^ (self menuButton visible or: [upButton visible]) or: [downButton visible]!
Item was removed:
- ----- Method: ScrollBar>>imageColor (in category 'accessing') -----
- imageColor
-
- ^ slider ifNil: [Color black] ifNotNil: [:s |
- (s color = s borderColor or: [s borderColor isTransparent])
- ifTrue: [s color adjustBrightness: (s color brightness < 0.5 ifTrue: [0.2] ifFalse: [-0.2])]
- ifFalse: [s borderColor]]!
Item was removed:
- ----- Method: ScrollBar>>initialize (in category 'initialize') -----
- initialize
-
- interval := 0.2.
- scrollDelta := 0.02.
- pageDelta := 0.2.
-
- super initialize.!
Item was removed:
- ----- Method: ScrollBar>>initializeDownButton (in category 'initialize') -----
- initializeDownButton
- "initialize the receiver's downButton"
-
- downButton := RectangleMorph newBounds: self boundsForDownButton.
- downButton
- on: #mouseDown
- send: #scrollDownInit
- to: self.
- downButton
- on: #mouseUp
- send: #finishedScrolling
- to: self.
- self updateDownButtonImage.
- self addMorphFront: downButton.
- downButton
- visible: self class scrollBarsWithoutArrowButtons not;
- disableLayout: downButton visible not.!
Item was removed:
- ----- Method: ScrollBar>>initializeMenuButton (in category 'initialize') -----
- initializeMenuButton
- "initialize the receiver's menuButton"
- "Preferences disable: #scrollBarsWithoutMenuButton"
- "Preferences enable: #scrollBarsWithoutMenuButton"
- menuButton := RectangleMorph newBounds: self boundsForMenuButton.
- menuButton
- on: #mouseEnter
- send: #menuButtonMouseEnter:
- to: self.
- menuButton
- on: #mouseDown
- send: #menuButtonMouseDown:
- to: self.
- menuButton
- on: #mouseLeave
- send: #menuButtonMouseLeave:
- to: self.
- "menuButton
- addMorphCentered: (RectangleMorph
- newBounds: (0 @ 0 extent: 4 @ 2)
- color: Color black)."
- self updateMenuButtonImage.
- self addMorphFront: menuButton.
- menuButton
- visible: (self class scrollBarsWithoutMenuButton or: [self orientation == #horizontal]) not;
- disableLayout: menuButton visible not.!
Item was removed:
- ----- Method: ScrollBar>>initializePagingArea (in category 'initialize') -----
- initializePagingArea
-
- "Appearance"
- pagingArea := RectangleMorph newBounds: self totalSliderArea.
- self addMorphBack: pagingArea.
-
- "Interactions"
- pagingArea
- on: #mouseDown
- send: #scrollPageInit:
- to: self.
- pagingArea
- on: #mouseUp
- send: #finishedScrolling
- to: self.
-
- !
Item was removed:
- ----- Method: ScrollBar>>initializeSlider (in category 'initialize') -----
- initializeSlider
-
- self
- initializeMenuButton;
- initializeUpButton;
- initializeDownButton;
- initializePagingArea.
-
- super initializeSlider.
-
- self expandSlider.!
Item was removed:
- ----- Method: ScrollBar>>initializeUpButton (in category 'initialize') -----
- initializeUpButton
- "initialize the receiver's upButton"
- upButton := RectangleMorph newBounds: self boundsForUpButton.
- upButton
- on: #mouseDown
- send: #scrollUpInit
- to: self.
- upButton
- on: #mouseUp
- send: #finishedScrolling
- to: self.
- self updateUpButtonImage.
- self addMorph: upButton.
- upButton
- visible: self class scrollBarsWithoutArrowButtons not;
- disableLayout: upButton visible not.!
Item was removed:
- ----- Method: ScrollBar>>interval (in category 'accessing') -----
- interval
-
- ^ interval ifNil: [interval := 0.2]!
Item was removed:
- ----- Method: ScrollBar>>interval: (in category 'accessing') -----
- interval: d
- "Supply an optional floating fraction so slider can expand to indicate range"
- interval := d min: 1.0.
- self expandSlider.
- self computeSlider.!
Item was removed:
- ----- Method: ScrollBar>>menuButton (in category 'accessing') -----
- menuButton
-
- ^ menuButton ifNil: [menuButton := RectangleMorph new]!
Item was removed:
- ----- Method: ScrollBar>>menuButtonMouseDown: (in category 'event handling') -----
- menuButtonMouseDown: event
- event hand showTemporaryCursor: nil.
- self use: menuSelector orMakeModelSelectorFor: 'MenuButtonPressed:'
- in: [:sel | menuSelector := sel. model perform: sel with: event]!
Item was removed:
- ----- Method: ScrollBar>>menuImage (in category 'images') -----
- menuImage
- "answer a form to be used in the menu button"
- ^ self class
- boxOfSize: (self buttonExtent x min: self buttonExtent y)
- color: self imageColor!
Item was removed:
- ----- Method: ScrollBar>>menuSelector (in category 'accessing') -----
- menuSelector
- ^ menuSelector!
Item was removed:
- ----- Method: ScrollBar>>menuSelector: (in category 'accessing') -----
- menuSelector: aSymbol
- menuSelector := aSymbol.!
Item was removed:
- ----- Method: ScrollBar>>minHeight (in category 'geometry') -----
- minHeight
- "The minimum extent is that of 2 or 3 buttons in a row or column,
- the 'up' and 'down' button and optionally the 'menu' button."
-
- | buttonCount refExtent refBorder |
- refExtent := upButton minExtent.
- refBorder := upButton borderWidth.
- buttonCount := {
- upButton visible.
- downButton visible.
- self menuButton visible. } count: [:ea | ea].
- ^ self orientation == #horizontal
- ifTrue: [super minHeight max: 5]
- ifFalse: [super minHeight max: ((buttonCount * refExtent y) - (buttonCount-1 * refBorder))]!
Item was removed:
- ----- Method: ScrollBar>>minThumbThickness (in category 'geometry') -----
- minThumbThickness
-
- ^ Preferences standardDefaultTextFont height!
Item was removed:
- ----- Method: ScrollBar>>minWidth (in category 'geometry') -----
- minWidth
- "The minimum extent is that of 2 or 3 buttons in a row or column,
- the 'up' and 'down' button and optionally the 'menu' button."
-
- | buttonCount refExtent refBorder |
- refExtent := upButton minExtent.
- refBorder := upButton borderWidth.
- buttonCount := {
- upButton visible.
- downButton visible.
- self menuButton visible. } count: [:ea | ea].
- ^ self orientation == #horizontal
- ifTrue: [super minWidth max: ((buttonCount * refExtent x) - (buttonCount-1 * refBorder))]
- ifFalse: [super minWidth max: 5]!
Item was removed:
- ----- Method: ScrollBar>>mouseDownInSlider: (in category 'event handling') -----
- mouseDownInSlider: event
-
- "make the entire scrollable area visible if a full scrollbar is clicked on"
- self interval = self maximumValue ifTrue: [
- self setValue: 0.
- self model hideOrShowScrollBars].
-
- self showSliderShadow.!
Item was removed:
- ----- Method: ScrollBar>>pagingArea (in category 'accessing') -----
- pagingArea
- ^pagingArea!
Item was removed:
- ----- Method: ScrollBar>>resetTimer (in category 'scroll timing') -----
- resetTimer
- timeOfMouseDown := Time millisecondClockValue.
- timeOfLastScroll := timeOfMouseDown - 1000 max: 0.
- nextPageDirection := nil.
- currentScrollDelay := nil!
Item was removed:
- ----- Method: ScrollBar>>scrollBarAction (in category 'scrolling') -----
- scrollBarAction
- ^self valueOfProperty: #scrollBarAction!
Item was removed:
- ----- Method: ScrollBar>>scrollBarAction: (in category 'scrolling') -----
- scrollBarAction: aSymbol
- self setProperty: #scrollBarAction toValue: aSymbol!
Item was removed:
- ----- Method: ScrollBar>>scrollDelta (in category 'accessing') -----
- scrollDelta
- ^ scrollDelta!
Item was removed:
- ----- Method: ScrollBar>>scrollDelta:pageDelta: (in category 'accessing') -----
- scrollDelta: d1 pageDelta: d2
- "Supply optional increments for better scrolling of, eg, text"
- scrollDelta := d1.
- pageDelta := d2.!
Item was removed:
- ----- Method: ScrollBar>>scrollDown: (in category 'scrolling') -----
- scrollDown: count
- self setValue: value + (scrollDelta * count).!
Item was removed:
- ----- Method: ScrollBar>>scrollDownInit (in category 'scrolling') -----
- scrollDownInit
- self resetTimer.
- self scrollBarAction: #doScrollDown.
- self startStepping.!
Item was removed:
- ----- Method: ScrollBar>>scrollPageInit: (in category 'scrolling') -----
- scrollPageInit: evt
-
- evt redButtonPressed ifFalse: [^ self].
-
- self resetTimer.
- self setNextDirectionFromEvent: evt.
- self scrollBarAction: #doScrollByPage.
- self startStepping.!
Item was removed:
- ----- Method: ScrollBar>>scrollUp: (in category 'scrolling') -----
- scrollUp: count
- self setValue: value - (scrollDelta * count).!
Item was removed:
- ----- Method: ScrollBar>>scrollUpInit (in category 'scrolling') -----
- scrollUpInit
- self resetTimer.
- self scrollBarAction: #doScrollUp.
- self startStepping.!
Item was removed:
- ----- Method: ScrollBar>>setDefaultParameters (in category 'initialize') -----
- setDefaultParameters
-
- "Compared to generic sliders, I am not my own paging area. Thus, make me transparent."
- self
- color: Color transparent;
- borderWidth: 0.
-
- pagingArea
- color: (self userInterfaceTheme color ifNil: [Color veryVeryLightGray darker alpha: 0.35]);
- borderWidth: 0. "no border for the paging area"
-
- slider
- color: (self userInterfaceTheme thumbColor ifNil: [Color veryVeryLightGray]);
- borderColor: (self userInterfaceTheme thumbBorderColor ifNil: [Color gray: 0.6]);
- borderWidth: ((self userInterfaceTheme thumbBorderWidth ifNil: [1]) * RealEstateAgent scaleFactor) truncated.
-
- self updateSliderCornerStyle.
-
- sliderShadow
- cornerStyle: slider cornerStyle;
- borderWidth: slider borderWidth;
- borderColor: Color transparent.
-
- sliderColor := slider color.
- self updateSliderColor: slider color.!
Item was removed:
- ----- Method: ScrollBar>>setNextDirectionFromEvent: (in category 'scrolling') -----
- setNextDirectionFromEvent: event
-
- nextPageDirection := self orientation == #horizontal
- ifTrue: [event cursorPoint x >= slider center x]
- ifFalse: [event cursorPoint y >= slider center y].
- !
Item was removed:
- ----- Method: ScrollBar>>sliderColor: (in category 'accessing') -----
- sliderColor: aColor
- "Change the color of the scrollbar to go with aColor."
-
- super sliderColor: aColor.
- self updateSliderColor: aColor.!
Item was removed:
- ----- Method: ScrollBar>>sliderExtent (in category 'geometry') -----
- sliderExtent
- "The sliderExtent is now stored in the slider itself, not hardcoded as it is in the superclass."
- ^slider extent!
Item was removed:
- ----- Method: ScrollBar>>sliderThickness (in category 'geometry') -----
- sliderThickness
- ^ self orientation == #horizontal
- ifTrue: [self height]
- ifFalse: [self width]!
Item was removed:
- ----- Method: ScrollBar>>step (in category 'stepping and presenter') -----
- step
- | action |
- action := self scrollBarAction.
- action ifNotNil:[self perform: action].!
Item was removed:
- ----- Method: ScrollBar>>stepTime (in category 'stepping and presenter') -----
- stepTime
- ^ currentScrollDelay ifNil: [300]!
Item was removed:
- ----- Method: ScrollBar>>totalSliderArea (in category 'geometry') -----
- totalSliderArea
- | upperReferenceBounds lowerReferenceBounds |
- upperReferenceBounds := (upButton visible ifFalse: [self menuButton visible ifTrue: [self menuButton] ifFalse: [nil]] ifTrue: [upButton])
- ifNil: [self topLeft corner: (self orientation == #horizontal ifTrue: [self bottomLeft + (1 at 0)] ifFalse: [self topRight + (0 at 1)])]
- ifNotNil: [:button | button bounds].
- lowerReferenceBounds := downButton visible
- ifFalse: [(self orientation == #horizontal ifTrue: [self topRight - (1 at 0)] ifFalse: [self bottomLeft - (0 at 1)]) corner: self bottomRight]
- ifTrue: [downButton bounds].
- ^ self orientation == #horizontal
- ifTrue: [upperReferenceBounds topRight - (1 at 0) corner: lowerReferenceBounds bottomLeft + (1 at 0)]
- ifFalse:[upperReferenceBounds bottomLeft - (0 at 1) corner: lowerReferenceBounds topRight + (0 at 1)].
- !
Item was removed:
- ----- Method: ScrollBar>>upArrow8Bit (in category 'images') -----
- upArrow8Bit
-
- "convert to 8-bit and convert white to transparent to avoid gratuitous conversion every time we put one in an ImageMorph"
-
- ^UpArrow8Bit ifNil: [
- UpArrow8Bit := (ColorForm mappingWhiteToTransparentFrom: UpArrow) asFormOfDepth: 8
- ]!
Item was removed:
- ----- Method: ScrollBar>>upButton (in category 'accessing') -----
- upButton
- ^ upButton!
Item was removed:
- ----- Method: ScrollBar>>upImage (in category 'images') -----
- upImage
- "answer a form to be used in the up button"
- ^ self class
- arrowOfDirection: (self orientation == #horizontal
- ifTrue: [#left]
- ifFalse: [#top])
- size: (self buttonExtent x min: self buttonExtent y)
- color: self imageColor!
Item was removed:
- ----- Method: ScrollBar>>updateDownButtonImage (in category 'updating') -----
- updateDownButtonImage
- "update the receiver's downButton. put a new image inside"
- downButton removeAllMorphs.
- downButton addMorphCentered: (ImageMorph new image: self downImage).!
Item was removed:
- ----- Method: ScrollBar>>updateMenuButtonImage (in category 'updating') -----
- updateMenuButtonImage
- "update the receiver's menuButton. put a new image inside"
-
- self menuButton removeAllMorphs.
- self menuButton addMorphCentered: (ImageMorph new image: self menuImage).!
Item was removed:
- ----- Method: ScrollBar>>updateSlider (in category 'updating') -----
- updateSlider
-
- | imagesNeedUpdate |
- imagesNeedUpdate := upButton width ~= (self orientation == #horizontal ifTrue: [self height] ifFalse: [self width]).
-
- self menuButton
- visible: (self orientation == #horizontal or: [self class scrollBarsWithoutMenuButton]) not;
- disableLayout: self menuButton visible not;
- bounds: self boundsForMenuButton.
- self upButton
- visible: self class scrollBarsWithoutArrowButtons not;
- disableLayout: self upButton visible not;
- bounds: self boundsForUpButton.
- self downButton
- visible: self class scrollBarsWithoutArrowButtons not;
- disableLayout: self downButton visible not;
- bounds: self boundsForDownButton.
-
- super updateSlider.
-
- pagingArea bounds: self totalSliderArea.
- self expandSlider.
-
- imagesNeedUpdate ifTrue: [
- self menuButton visible ifTrue: [self updateMenuButtonImage].
- self upButton visible ifTrue: [self updateUpButtonImage].
- self downButton visible ifTrue: [self updateDownButtonImage]].!
Item was removed:
- ----- Method: ScrollBar>>updateSliderColor (in category 'updating') -----
- updateSliderColor
-
- self updateSliderColor: self sliderColor.!
Item was removed:
- ----- Method: ScrollBar>>updateSliderColor: (in category 'updating') -----
- updateSliderColor: aColor
-
- self class gradientScrollBar
- ifFalse: [self updateSliderColorSolid: aColor]
- ifTrue: [self updateSliderColorGradient: aColor].
-
- self flag: #performance. "mt: This is slow..."
- self updateMenuButtonImage.
- self updateUpButtonImage.
- self updateDownButtonImage.!
Item was removed:
- ----- Method: ScrollBar>>updateSliderColorGradient: (in category 'updating') -----
- updateSliderColorGradient: aColor
-
- | gradient cc |
- pagingArea color: ((self userInterfaceTheme pagingAreaColorModifier
- ifNil: [ [:c | c darker alpha: 0.35] ]) value: aColor).
- slider borderColor: ((self userInterfaceTheme borderColorModifier
- ifNil: [ [:c | c adjustBrightness: -0.3] ]) value: aColor).
-
- cc := ((self userInterfaceTheme thumbColorModifier
- ifNil: [ [:c | c] ]) value: aColor).
-
- gradient := GradientFillStyle ramp: {
- 0.0 -> Color white.
- 0.1-> (cc adjustBrightness: 0.05).
- 0.6 -> (cc darker)}.
-
- "Fill the thumb"
- gradient origin: slider topLeft.
- gradient direction: (self orientation == #horizontal
- ifTrue:[0 at slider height]
- ifFalse:[slider width at 0]).
- slider fillStyle: gradient.
-
- "Fill the buttons"
- {self menuButton. self upButton. self downButton} do: [:ea |
- gradient := gradient copy.
- gradient origin: ea topLeft.
- gradient direction: (self orientation == #horizontal
- ifTrue:[0 at ea height]
- ifFalse:[ea width at 0]).
- ea
- fillStyle: gradient;
- borderWidth: slider borderWidth;
- borderColor: slider borderColor].!
Item was removed:
- ----- Method: ScrollBar>>updateSliderColorSolid: (in category 'updating') -----
- updateSliderColorSolid: aColor
-
- sliderShadow color: self sliderShadowColor.
-
- slider color: ((self userInterfaceTheme thumbColorModifier
- ifNil: [ [:c | c] ]) value: aColor).
-
- slider borderColor: ((self userInterfaceTheme borderColorModifier
- ifNil: [ [:c | c adjustBrightness: -0.3] ]) value: aColor).
-
- pagingArea color: ((self userInterfaceTheme pagingAreaColorModifier
- ifNil: [ [:c | c darker alpha: 0.35] ]) value: aColor).
-
- {self menuButton. self upButton. self downButton} do: [:ea |
- ea
- color: slider color;
- borderWidth: slider borderWidth;
- borderColor: slider borderColor].!
Item was removed:
- ----- Method: ScrollBar>>updateSliderCornerStyle (in category 'updating') -----
- updateSliderCornerStyle
- "Right now, only the slider's corner style is affected. Buttons and paging area remain square. Looks better somehow... :-)"
-
- slider cornerStyle: (self class roundedScrollBarLook ifTrue: [#rounded] ifFalse: [#square]).!
Item was removed:
- ----- Method: ScrollBar>>updateUpButtonImage (in category 'updating') -----
- updateUpButtonImage
- "update the receiver's upButton. put a new image inside"
- upButton removeAllMorphs.
- upButton addMorphCentered: (ImageMorph new image: self upImage).!
Item was removed:
- ----- Method: ScrollBar>>waitForDelay1:delay2: (in category 'scroll timing') -----
- waitForDelay1: delay1 delay2: delay2
- "Return true if an appropriate delay has passed since the last scroll operation.
- The delay decreases exponentially from delay1 to delay2."
-
- | now scrollDelay |
- timeOfLastScroll ifNil: [self resetTimer]. "Only needed for old instances"
- now := Time millisecondClockValue.
- (scrollDelay := currentScrollDelay) isNil
- ifTrue: [scrollDelay := delay1 "initial delay"].
- currentScrollDelay := scrollDelay * 9 // 10 max: delay2. "decrease the delay"
- timeOfLastScroll := now.
- ^true!
Item was removed:
- ----- Method: ScrollBar>>wantsSteps (in category 'stepping and presenter') -----
- wantsSteps
- ^self scrollBarAction notNil!
Item was removed:
- MorphicModel subclass: #ScrollPane
- instanceVariableNames: 'scrollBar scroller retractableScrollBar scrollBarOnLeft getMenuSelector getMenuTitleSelector hasFocus hScrollBar hScrollBarPolicy vScrollBarPolicy scrollBarThickness'
- classVariableNames: 'HorizontalScrollDeltaPerMouseWheelNotch UseRetractableScrollBars VerticalScrollDeltaPerMouseWheelNotch'
- poolDictionaries: ''
- category: 'Morphic-Windows'!
-
- !ScrollPane commentStamp: 'mk 8/9/2005 10:34' prior: 0!
- The scroller (a transform) of a scrollPane is driven by the scrollBar. The scroll values vary from 0.0, meaning zero offset to 1.0 meaning sufficient offset such that the bottom of the scrollable material appears 3/4 of the way down the pane. The total distance to achieve this range is called the totalScrollRange.
-
- Basic clue about utilization of the ScrollPane class is given in:
- ScrollPane example1.
- ScrollPane example2.!
Item was removed:
- ----- Method: ScrollPane class>>example1 (in category 'examples') -----
- example1
- | window scrollPane pasteUpMorph |
- window := SystemWindow new.
- scrollPane := ScrollPane new.
- pasteUpMorph := PasteUpMorph new.
- pasteUpMorph extent: 1000 at 1000.
- scrollPane scroller addMorph: pasteUpMorph.
- window addMorph: scrollPane frame: (0 at 0 corner: 1 at 1).
- window openInWorld.!
Item was removed:
- ----- Method: ScrollPane class>>example2 (in category 'examples') -----
- example2
- | window scrollPane pasteUpMorph point textMorph |
- window := SystemWindow new.
- scrollPane := ScrollPane new.
- pasteUpMorph := PasteUpMorph new.
- pasteUpMorph extent: 1000 at 1000.
- scrollPane scroller addMorph: pasteUpMorph.
- window addMorph: scrollPane frame: (0 at 0 corner: 1 at 1).
- 0 to: 1000 by: 100 do:
- [:x | 0 to: 1000 by: 100 do:
- [:y |
- point := x at y.
- textMorph := TextMorph new contents: point asString.
- textMorph position: point.
- pasteUpMorph addMorph: textMorph
- ]
- ].
- window openInWorld.!
Item was removed:
- ----- Method: ScrollPane class>>horizontalScrollDeltaPerMouseWheelNotch (in category 'preferences') -----
- horizontalScrollDeltaPerMouseWheelNotch
-
- <preference: 'horizontal scroll increment per single mouse wheel'
- category: #scrolling
- description: 'How many horizontal scroll increments should be caused in response to a single mouse wheel notch.
- Typically, the scroll panes increment are about 1 character width for list and text panes (see #scrollDeltaWidth).
- The default setting is 3 so as to match the most widely used convention.'
- type: #Number>
- ^ HorizontalScrollDeltaPerMouseWheelNotch ifNil: [3]!
Item was removed:
- ----- Method: ScrollPane class>>horizontalScrollDeltaPerMouseWheelNotch: (in category 'preferences') -----
- horizontalScrollDeltaPerMouseWheelNotch: anIntegerOrNil
-
- HorizontalScrollDeltaPerMouseWheelNotch := anIntegerOrNil!
Item was removed:
- ----- Method: ScrollPane class>>includeInNewMorphMenu (in category 'new-morph participation') -----
- includeInNewMorphMenu
- "OK to instantiate"
- ^ true!
Item was removed:
- ----- Method: ScrollPane class>>scrollBarThickness (in category 'defaults') -----
- scrollBarThickness
-
- ^ ((Preferences scrollBarsNarrow ifTrue: [10] ifFalse: [14])
- * RealEstateAgent scaleFactor) truncated!
Item was removed:
- ----- Method: ScrollPane class>>themePriority (in category 'preferences') -----
- themePriority
-
- ^ 40!
Item was removed:
- ----- Method: ScrollPane class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ super themeProperties, {
- { #borderColor. 'Colors'. 'Color of the pane''s border.' }.
- { #borderWidth. 'Borders'. 'Width of the pane''s border.' }.
- { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }.
- { #color. 'Colors'. 'Background color of the pane.' }.
- }!
Item was removed:
- ----- Method: ScrollPane class>>useRetractableScrollBars (in category 'preferences') -----
- useRetractableScrollBars
-
- <preference: 'Use retractable scrollbars'
- category: #scrolling
- description: 'When enabled, scrollbars are hidden when scroll pane is not focused.'
- type: #Boolean>
- ^ UseRetractableScrollBars ifNil: [false]!
Item was removed:
- ----- Method: ScrollPane class>>useRetractableScrollBars: (in category 'preferences') -----
- useRetractableScrollBars: aBooleanOrNil
-
- UseRetractableScrollBars = aBooleanOrNil ifTrue: [^ self].
- UseRetractableScrollBars := aBooleanOrNil.
- ScrollPane allSubInstances do: [:pane |
- pane retractable: self useRetractableScrollBars].!
Item was removed:
- ----- Method: ScrollPane class>>verticalScrollDeltaPerMouseWheelNotch (in category 'preferences') -----
- verticalScrollDeltaPerMouseWheelNotch
-
- <preference: 'vertical scroll increment per single mouse wheel'
- category: #scrolling
- description: 'How many vertical scroll increments should be caused in response to a single mouse wheel notch.
- Typically, the scroll panes increment are one line height for list and text panes (see #scrollDeltaHeight).
- The default setting is 3 so as to match the most widely used convention.'
- type: #Number>
- ^ VerticalScrollDeltaPerMouseWheelNotch ifNil: [3]!
Item was removed:
- ----- Method: ScrollPane class>>verticalScrollDeltaPerMouseWheelNotch: (in category 'preferences') -----
- verticalScrollDeltaPerMouseWheelNotch: anIntegerOrNil
-
- VerticalScrollDeltaPerMouseWheelNotch := anIntegerOrNil!
Item was removed:
- ----- Method: ScrollPane>>addCustomMenuItems:hand: (in category 'menu') -----
- addCustomMenuItems: aCustomMenu hand: aHandMorph
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- retractableScrollBar
- ifTrue: [aCustomMenu add: 'make scrollbar inboard' translated action: #retractableOrNot]
- ifFalse: [aCustomMenu add: 'make scrollbar retractable' translated action: #retractableOrNot].
- scrollBarOnLeft
- ifTrue: [aCustomMenu add: 'scroll bar on right' translated action: #leftOrRight]
- ifFalse: [aCustomMenu add: 'scroll bar on left' translated action: #leftOrRight]!
Item was removed:
- ----- Method: ScrollPane>>adjustOffset (in category 'scrolling') -----
- adjustOffset
- "Layout specific. If our scroller is large enough, avoid hiding contents due to bad offset."
-
- | sbox adjustedOffset |
- sbox := scroller submorphBoundsForShrinkWrap.
- adjustedOffset := (sbox width <= scroller width ifTrue: [0] ifFalse: [scroller offset x]) @
- (sbox height <= scroller height ifTrue: [0] ifFalse: [scroller offset y]).
- scroller offset: adjustedOffset.!
Item was removed:
- ----- Method: ScrollPane>>adoptPaneColor: (in category 'accessing') -----
- adoptPaneColor: paneColor
- super adoptPaneColor: paneColor.
-
- "May not be in the hierarchy at the moment."
- scrollBar adoptPaneColor: paneColor.
- hScrollBar adoptPaneColor: paneColor.
-
- paneColor ifNotNil: [:pc | self borderColor: ((self userInterfaceTheme borderColorModifier ifNil: [ [:c | c adjustBrightness: -0.3] ]) value: pc)].!
Item was removed:
- ----- Method: ScrollPane>>alwaysShowHScrollBar (in category 'accessing options') -----
- alwaysShowHScrollBar
-
- self hScrollBarPolicy: #always.
- !
Item was removed:
- ----- Method: ScrollPane>>alwaysShowScrollBars (in category 'accessing options') -----
- alwaysShowScrollBars
-
- self
- alwaysShowHScrollBar;
- alwaysShowVScrollBar.
- !
Item was removed:
- ----- Method: ScrollPane>>alwaysShowVScrollBar (in category 'accessing options') -----
- alwaysShowVScrollBar
-
- self vScrollBarPolicy: #always.
- !
Item was removed:
- ----- Method: ScrollPane>>applyUserInterfaceTheme (in category 'updating') -----
- applyUserInterfaceTheme
-
- super applyUserInterfaceTheme.
- self setDefaultParameters.!
Item was removed:
- ----- Method: ScrollPane>>canBeEncroached (in category 'support') -----
- canBeEncroached
- "For support of the smartHorizontalSplitters preference."
- ^ scrollBar isInWorld not!
Item was removed:
- ----- Method: ScrollPane>>checkScrollBarPolicy: (in category 'layout') -----
- checkScrollBarPolicy: aSymbol
-
- aSymbol == #never ifTrue: [^ self].
- aSymbol == #whenNeeded ifTrue: [^ self].
- aSymbol == #always ifTrue: [^ self].
-
- Error signal: 'Invalid value for scrollbar policy. Use #never, #whenNeeded, or #always.'.!
Item was removed:
- ----- Method: ScrollPane>>containsPoint: (in category 'geometry testing') -----
- containsPoint: aPoint
-
- (super containsPoint: aPoint) ifTrue: [^ true].
-
- "Also include v scrollbar when it is extended..."
- ((retractableScrollBar and: [self vIsScrollbarShowing]) and:
- [scrollBar containsPoint: aPoint])
- ifTrue:[ ^true ].
-
- "Also include hScrollbar when it is extended..."
- ((retractableScrollBar and: [self hIsScrollbarShowing]) and:
- [hScrollBar containsPoint: aPoint])
- ifTrue: [ ^true ].
-
- ^ false
- !
Item was removed:
- ----- Method: ScrollPane>>convertToCurrentVersion:refStream: (in category 'objects from disk') -----
- convertToCurrentVersion: varDict refStream: smartRefStrm
- scrollBarThickness
- ifNil: [scrollBarThickness := self class scrollBarThickness].
- hScrollBarPolicy
- ifNil: [hScrollBarPolicy := #whenNeeded].
- vScrollBarPolicy
- ifNil: [vScrollBarPolicy := #whenNeeded].
- hScrollBar
- ifNil: [(hScrollBar := ScrollBar on: self getValue: nil setValue: #hScrollBarValue:)
- menuSelector: #hScrollBarMenuButtonPressed:;
- orientation: #horizontal;
- extent: 1 @ 1].
- ^ super convertToCurrentVersion: varDict refStream: smartRefStrm!
Item was removed:
- ----- Method: ScrollPane>>defaultExtent (in category 'initialization') -----
- defaultExtent
- ^150 at 120
- !
Item was removed:
- ----- Method: ScrollPane>>displayScaleChangedBy: (in category 'display scale') -----
- displayScaleChangedBy: factor
- "Overwritten because the receiver's layout dictates some properties to its submorphs."
-
- super displayScaleChangedBy: factor.
- self scrollBarThickness: (self scrollBarThickness * factor) rounded.!
Item was removed:
- ----- Method: ScrollPane>>doLayoutIn: (in category 'layout') -----
- doLayoutIn: layoutBounds
- "Manually layout my submorphs. Maybe we can find a proper layout policy in the future."
-
- | priorBounds |
- priorBounds := bounds.
-
- self updateLayout.
- super doLayoutIn: layoutBounds.
-
- "Do one additional run if required."
- (priorBounds ~= bounds or: [self hasProperty: #doLayoutAgainHere]) ifTrue: [
- self updateLayout.
- super doLayoutIn: layoutBounds.
- "self assert: (self hasProperty: #doLayoutAgainHere) not. --- Not working yet."].!
Item was removed:
- ----- Method: ScrollPane>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- self wantsRoundedCorners
- ifTrue: [aCanvas fillRoundRect: self bounds radius: self cornerRadius fillStyle: self fillStyle]
- ifFalse: [aCanvas fillRectangle: self bounds fillStyle: self fillStyle].!
Item was removed:
- ----- Method: ScrollPane>>drawOverlayOn: (in category 'drawing') -----
- drawOverlayOn: aCanvas
- "Draw my border OVER my submorphs because the scrollbars overlap."
-
- self wantsRoundedCorners
- ifTrue: [aCanvas frameRoundRect: self bounds radius: self cornerRadius borderStyle: self borderStyle]
- ifFalse: [aCanvas frameRectangle: self bounds borderStyle: self borderStyle].
-
- super drawOverlayOn: aCanvas.!
Item was removed:
- ----- Method: ScrollPane>>extentToFit (in category 'geometry') -----
- extentToFit
- "Resize scroll pane to exactly fit its contents."
-
- | offset |
- offset := 0 at 0.
- (retractableScrollBar not and: [self vScrollBarPolicy == #always])
- ifTrue: [offset := (self scrollBarThickness - self borderWidth) @ offset y].
- (retractableScrollBar not and: [self hScrollBarPolicy == #always])
- ifTrue: [offset := offset x @ (self scrollBarThickness - self borderWidth)].
-
- ^ scroller submorphBounds extent + offset + (2* (self borderWidth @ self borderWidth))!
Item was removed:
- ----- Method: ScrollPane>>filterEvent:for: (in category 'event filtering') -----
- filterEvent: aKeyboardEvent for: morphOrNil
- "See #initialize. This filter should be installed as keyboard event filter during the capture phase."
-
- (aKeyboardEvent isKeystroke
- and: [self scrollByKeyboard: aKeyboardEvent])
- ifTrue: [aKeyboardEvent ignore].
-
- ^ aKeyboardEvent!
Item was removed:
- ----- Method: ScrollPane>>fit (in category 'geometry') -----
- fit
- "Resize scroll pane to exactly fit its contents."
-
- self extent: self extentToFit.!
Item was removed:
- ----- Method: ScrollPane>>flatColoredScrollBarLook (in category 'accessing') -----
- flatColoredScrollBarLook
- "Currently only show the flat (not rounded) + colored-to-match-window scrollbar look when inboard."
- ^ retractableScrollBar not or: [ScrollBar alwaysShowFlatScrollbarForAlternativeLook]
- !
Item was removed:
- ----- Method: ScrollPane>>getMenu: (in category 'menu') -----
- getMenu: shiftKeyState
- "Answer the menu for this text view, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key."
- | menu aMenu aTitle |
- getMenuSelector == nil ifTrue: [^ nil].
- menu := MenuMorph new defaultTarget: model.
- aTitle := getMenuTitleSelector ifNotNil: [model perform: getMenuTitleSelector].
- getMenuSelector numArgs = 1 ifTrue:
- [aMenu := model perform: getMenuSelector with: menu.
- aTitle ifNotNil: [aMenu addTitle: aTitle].
- ^ aMenu].
- getMenuSelector numArgs = 2 ifTrue:
- [aMenu := model perform: getMenuSelector with: menu with: shiftKeyState.
- aTitle ifNotNil: [aMenu addTitle: aTitle].
- ^ aMenu].
- ^ self error: 'The getMenuSelector must be a 1- or 2-keyword symbol'!
Item was removed:
- ----- Method: ScrollPane>>hExtraScrollRange (in category 'geometry ranges') -----
- hExtraScrollRange
- "Return the amount of extra blank space to include below the bottom of the scroll content."
- ^ 0
- !
Item was removed:
- ----- Method: ScrollPane>>hHideOrShowScrollBar (in category 'layout - visibility') -----
- hHideOrShowScrollBar
- "Hide or show the scrollbar depending on if the pane is scrolled/scrollable."
-
- self hIsScrollbarNeeded
- ifTrue:[ self hShowScrollBar ]
- ifFalse: [ self hHideScrollBar ].
- !
Item was removed:
- ----- Method: ScrollPane>>hHideScrollBar (in category 'layout - visibility') -----
- hHideScrollBar
-
- self hIsScrollbarShowing ifFalse: [^self].
- self removeMorph: hScrollBar.
- retractableScrollBar ifFalse: [self setProperty: #doLayoutAgainHere toValue: true].!
Item was removed:
- ----- Method: ScrollPane>>hIsScrollable (in category 'geometry testing') -----
- hIsScrollable
- "If the contents of the pane are too small to scroll, return false."
-
- ^ self hLeftoverScrollRange > 0
- !
Item was removed:
- ----- Method: ScrollPane>>hIsScrollbarNeeded (in category 'geometry testing') -----
- hIsScrollbarNeeded
- "Return whether the horz scrollbar is needed"
-
- "Don't do anything with the retractable scrollbar unless we have focus"
- retractableScrollBar & self hasFocus not ifTrue: [^false].
-
- "Don't show it if we were told not to."
- self hScrollBarPolicy == #never ifTrue: [^false].
-
- "Always show it if we were told to"
- self hScrollBarPolicy == #always ifTrue: [^true].
-
- ^self hIsScrollable
- !
Item was removed:
- ----- Method: ScrollPane>>hIsScrollbarShowing (in category 'geometry testing') -----
- hIsScrollbarShowing
- "Return true if a horz scroll bar is currently showing"
-
- ^ hScrollBar owner notNil!
Item was removed:
- ----- Method: ScrollPane>>hIsScrolled (in category 'geometry testing') -----
- hIsScrolled
- "If the scroller is not set to x = 0, then the pane has been h-scrolled."
- ^scroller offset x > 0
- !
Item was removed:
- ----- Method: ScrollPane>>hLeftoverScrollRange (in category 'geometry ranges') -----
- hLeftoverScrollRange
- "Return the entire scrolling range minus the currently viewed area."
-
- ^ scroller hasSubmorphs
- ifFalse: [0]
- ifTrue: [self hTotalScrollRange - scroller width max: 0]
- !
Item was removed:
- ----- Method: ScrollPane>>hMargin (in category 'accessing') -----
- hMargin
- "pixels of whitespace at to the left of the scroller when the hScrollBar offset is 0"
- ^0
- !
Item was removed:
- ----- Method: ScrollPane>>hResizeScrollBar (in category 'layout - resizing') -----
- hResizeScrollBar
-
- | topLeft h border offset |
- self hScrollBarPolicy == #never ifTrue: [^self].
-
- h := self scrollBarThickness.
- border := self borderWidth.
- offset := (scrollBarOnLeft and: [self vIsScrollbarShowing and: [retractableScrollBar not]])
- ifTrue: [h]
- ifFalse: [0].
-
- topLeft := retractableScrollBar
- ifTrue: [bounds bottomLeft + (offset @ border negated)]
- ifFalse: [bounds bottomLeft + (offset @ h negated)].
-
- hScrollBar bounds: (topLeft extent: self hScrollBarWidth@ h)!
Item was removed:
- ----- Method: ScrollPane>>hResizing: (in category 'layout') -----
- hResizing: aSymbol
- "Pass #shrinkWrap property to scroller to make this scroll pane's layout work. See #doLayoutIn:."
-
- super hResizing: aSymbol.
-
- scroller hResizing: (aSymbol == #shrinkWrap
- ifTrue: [#shrinkWrap]
- ifFalse: [#spaceFill]).!
Item was removed:
- ----- Method: ScrollPane>>hScrollBar (in category 'accessing') -----
- hScrollBar
- ^ hScrollBar!
Item was removed:
- ----- Method: ScrollPane>>hScrollBarMenuButtonPressed: (in category 'scroll bar events') -----
- hScrollBarMenuButtonPressed: event
- ^ self scrollBarMenuButtonPressed: event
- !
Item was removed:
- ----- Method: ScrollPane>>hScrollBarPolicy (in category 'accessing') -----
- hScrollBarPolicy
-
- ^ hScrollBarPolicy!
Item was removed:
- ----- Method: ScrollPane>>hScrollBarPolicy: (in category 'accessing') -----
- hScrollBarPolicy: aSymbol
- "#always, #never, #whenNeeded"
-
- hScrollBarPolicy = aSymbol ifTrue: [^ self].
- self checkScrollBarPolicy: aSymbol.
-
- hScrollBarPolicy := aSymbol.
- self layoutChanged.!
Item was removed:
- ----- Method: ScrollPane>>hScrollBarValue: (in category 'scrolling') -----
- hScrollBarValue: scrollValue
-
- scroller hasSubmorphs ifFalse: [^ self].
- scroller offset: (scrollValue max: 0) @ scroller offset y.!
Item was removed:
- ----- Method: ScrollPane>>hScrollBarWidth (in category 'geometry') -----
- hScrollBarWidth
- "Return the width of the horizontal scrollbar"
-
-
- | w |
-
- w := bounds width "- (2 * borderWidth)".
-
- (retractableScrollBar not and: [self vIsScrollbarNeeded])
- ifTrue: [w := w - self scrollBarThickness ].
-
- ^w
- !
Item was removed:
- ----- Method: ScrollPane>>hSetScrollDelta (in category 'layout - scrolling') -----
- hSetScrollDelta
- "Set the ScrollBar deltas, value and interval, based on the current scroll pane size, offset and range."
-
- | delta |
- delta := self scrollDeltaWidth.
-
- hScrollBar
- truncate: true;
- scrollDelta: delta
- pageDelta: 10*delta;
- maximumValue: self hLeftoverScrollRange;
- interval: (self hTotalScrollRange = 0
- ifTrue: [1.0]
- ifFalse: [scroller width / self hTotalScrollRange]);
- setValue: scroller offset x.!
Item was removed:
- ----- Method: ScrollPane>>hShowScrollBar (in category 'layout - visibility') -----
- hShowScrollBar
-
- self hIsScrollbarShowing ifTrue: [^self].
- self hResizeScrollBar.
- self privateAddMorph: hScrollBar atIndex: 1.
- retractableScrollBar
- ifTrue: [self comeToFront]
- ifFalse: [self setProperty: #doLayoutAgainHere toValue: true].!
Item was removed:
- ----- Method: ScrollPane>>hTotalScrollRange (in category 'geometry ranges') -----
- hTotalScrollRange
- "Return the entire scrolling range."
- ^ self hUnadjustedScrollRange + self hExtraScrollRange + self hMargin
- !
Item was removed:
- ----- Method: ScrollPane>>hUnadjustedScrollRange (in category 'geometry ranges') -----
- hUnadjustedScrollRange
- "Return the width extent of the receiver's submorphs."
-
- ^ scroller localSubmorphBounds width!
Item was removed:
- ----- Method: ScrollPane>>handlesKeyboard: (in category 'event handling') -----
- handlesKeyboard: evt
- ^ true!
Item was removed:
- ----- Method: ScrollPane>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: evt
- ^ true
- !
Item was removed:
- ----- Method: ScrollPane>>handlesMouseOver: (in category 'event handling') -----
- handlesMouseOver: evt
- "Could just ^ true, but this ensures that scroll bars won't flop out
- if you mouse-over appendages such as connecting pins."
- self flag: #arNote. "I have no idea how the code below could've ever worked. If the receiver does not handle mouse over events then it should not receive any #mouseLeave if the mouse leaves the receiver for real. This is because 'evt cursorPoint' describes the *end* point of the movement and considering that the code would return false if the move ends outside the receiver the scroll bars should never pop back in again. Which is exactly what happens with the new event logic if you don't just ^true. I'm leaving the code in for reference - perhaps somebody can make sense from it; I sure cannot."
- ^true
- "
- | cp |
- cp := evt cursorPoint.
- (bounds containsPoint: cp)
- ifTrue: [^ true]
- ifFalse: [self submorphsDo:
- [:m | (m containsPoint: cp) ifTrue:
- [m == scrollBar
- ifTrue: [^ true]
- ifFalse: [^ false]]].
- ^ false]
- "!
Item was removed:
- ----- Method: ScrollPane>>handlesMouseWheel: (in category 'event handling') -----
- handlesMouseWheel: evt
- ^ true!
Item was removed:
- ----- Method: ScrollPane>>hasFocus (in category 'accessing') -----
- hasFocus
- "hasFocus is currently set by mouse enter/leave events.
- This inst var should probably be moved up to a higher superclass."
-
- ^ hasFocus ifNil: [false]!
Item was removed:
- ----- Method: ScrollPane>>hideHScrollBarIndefinitely (in category 'accessing options') -----
- hideHScrollBarIndefinitely
- "Get rid of scroll bar for short panes that don't want it shown."
-
- self hScrollBarPolicy: #never.
- self hHideOrShowScrollBar.
- !
Item was removed:
- ----- Method: ScrollPane>>hideOrShowScrollBars (in category 'layout - visibility') -----
- hideOrShowScrollBars
-
- self removeProperty: #doLayoutAgainHere. "Detect change."
-
- "There is the one edge case where no scroll bar would be needed if both scroll bars would just disappear."
- (((((self vScrollBarPolicy = #whenNeeded and: [self hScrollBarPolicy = #whenNeeded])
- and: [self retractableScrollBar not])
- and: [self vIsScrollbarShowing and: [self hIsScrollbarShowing]])
- and: [self hLeftoverScrollRange <= self vScrollBar width])
- and: [self vLeftoverScrollRange <= self hScrollBar height])
- ifTrue: [^ self vHideScrollBar; hHideScrollBar].
-
- self
- vHideOrShowScrollBar;
- hHideOrShowScrollBar.!
Item was removed:
- ----- Method: ScrollPane>>hideScrollBars (in category 'layout - visibility') -----
- hideScrollBars
- self
- vHideScrollBar;
- hHideScrollBar
- !
Item was removed:
- ----- Method: ScrollPane>>hideScrollBarsIndefinitely (in category 'accessing options') -----
- hideScrollBarsIndefinitely
-
- self
- hideVScrollBarIndefinitely;
- hideHScrollBarIndefinitely.!
Item was removed:
- ----- Method: ScrollPane>>hideVScrollBarIndefinitely (in category 'accessing options') -----
- hideVScrollBarIndefinitely
- "Get rid of scroll bar for short panes that don't want it shown."
-
- self vScrollBarPolicy: #never.
- self vHideOrShowScrollBar.
- !
Item was removed:
- ----- Method: ScrollPane>>initialize (in category 'initialization') -----
- initialize
-
- "initialize the state of the receiver"
- super initialize.
- ""
- self initializePreferences.
- hasFocus := false.
- self initializeScrollBars.
- ""
-
- self extent: self defaultExtent.
- self updateMinimumExtent.
-
- self setDefaultParameters.
- self addKeyboardCaptureFilter: self.!
Item was removed:
- ----- Method: ScrollPane>>initializePreferences (in category 'initialization') -----
- initializePreferences
- "initialize the receiver's Preferences"
-
- retractableScrollBar := self class useRetractableScrollBars.
- scrollBarOnLeft := (Preferences valueOfFlag: #scrollBarsOnRight) not.
- scrollBarThickness := self class scrollBarThickness.
-
- Preferences alwaysShowVScrollbar
- ifTrue: [ self vScrollBarPolicy: #always ]
- ifFalse: [ self vScrollBarPolicy: #whenNeeded ].
-
- Preferences alwaysHideHScrollbar
- ifTrue:[ self hScrollBarPolicy: #never ]
- ifFalse: [ Preferences alwaysShowHScrollbar
- ifTrue: [ self hScrollBarPolicy: #always ]
- ifFalse: [ self hScrollBarPolicy: #whenNeeded ]].!
Item was removed:
- ----- Method: ScrollPane>>initializeScrollBars (in category 'initialization') -----
- initializeScrollBars
- "Initialize vertical and horizontal scroll bars."
-
- (scrollBar := ScrollBar on: self getValue: nil setValue: #vScrollBarValue:)
- menuSelector: #vScrollBarMenuButtonPressed:;
- orientation: #vertical;
- extent: 1 at 1.
- (hScrollBar := ScrollBar on: self getValue: nil setValue: #hScrollBarValue:)
- menuSelector: #hScrollBarMenuButtonPressed:;
- orientation: #horizontal;
- extent: 1 at 1.
-
- ""
- scroller := TransformMorph new
- color: Color transparent;
- hResizing: #spaceFill;
- vResizing: #spaceFill.
- scroller offset: 0 @ 0.
- self addMorph: scroller.
- ""
- retractableScrollBar ifFalse:
- [self
- addMorph: scrollBar;
- addMorph: hScrollBar].
- self updateMinimumExtent.!
Item was removed:
- ----- Method: ScrollPane>>innerBounds (in category 'geometry') -----
- innerBounds
-
- | inner bottomOffset leftOffset rightOffset |
- (retractableScrollBar or: [self vIsScrollbarShowing not])
- ifTrue: [leftOffset := rightOffset := 0]
- ifFalse: [
- scrollBarOnLeft
- ifTrue: [
- leftOffset := self scrollBarThickness - self borderWidth.
- rightOffset := 0.]
- ifFalse: [
- leftOffset := 0.
- rightOffset := self scrollBarThickness - self borderWidth]].
-
- (retractableScrollBar or: [self hIsScrollbarShowing not])
- ifTrue: [bottomOffset := 0]
- ifFalse: [bottomOffset := self scrollBarThickness - self borderWidth].
-
- inner := super innerBounds.
- ^ (inner left + leftOffset) @ (inner top "+ topOffset")
- corner: (inner right - rightOffset) @ (inner bottom - bottomOffset)!
Item was removed:
- ----- Method: ScrollPane>>insetColor (in category 'accessing') -----
- insetColor
-
- ^ self containingWindow
- ifNil: [super insetColor]
- ifNotNil: [:window | window colorForInsets]!
Item was removed:
- ----- Method: ScrollPane>>isAnyScrollbarShowing (in category 'geometry testing') -----
- isAnyScrollbarShowing
-
- ^ self hIsScrollbarShowing or: [self vIsScrollbarShowing]
- !
Item was removed:
- ----- Method: ScrollPane>>isAutoFit (in category 'accessing') -----
- isAutoFit
- "Does this scroll pane modifies the extent of its scrollable content when it resizes itself to avoid, for example, a horizontal or vertical scrollbar?"
-
- ^ false!
Item was removed:
- ----- Method: ScrollPane>>isScrolledFromTop (in category 'support') -----
- isScrolledFromTop
- "Have the contents of the pane been scrolled, so that the top of the contents are not visible?"
- ^ self vIsScrolled
- !
Item was removed:
- ----- Method: ScrollPane>>keyStroke: (in category 'event handling') -----
- keyStroke: evt
- "If pane is not empty, pass the event to the last submorph,
- assuming it is the most appropriate recipient (!!)"
-
- scroller hasSubmorphs ifTrue:
- [scroller lastSubmorph keyStroke: evt].!
Item was removed:
- ----- Method: ScrollPane>>leftOrRight (in category 'menu') -----
- leftOrRight "Change scroll bar location"
- scrollBarOnLeft := scrollBarOnLeft not.
- self extent: self extent!
Item was removed:
- ----- Method: ScrollPane>>menuTitleSelector: (in category 'menu') -----
- menuTitleSelector: aSelector
- getMenuTitleSelector := aSelector!
Item was removed:
- ----- Method: ScrollPane>>minScrollbarHeight (in category 'layout') -----
- minScrollbarHeight
- "Answer the minimum extent occupied by the receiver..
- It is assumed the if the receiver is sized to its minimum both scrollbars will be used (and visible) unless they have been turned off explicitly.
- This makes the behaviour also more predictable."
-
- ^ (self vScrollBarPolicy == #never
- ifTrue: [0]
- ifFalse: [scrollBar minHeight])
- + (((self hScrollBarPolicy == #never or: [retractableScrollBar]) or: [self isAutoFit])
- ifTrue: [0]
- ifFalse: [self scrollBarThickness])!
Item was removed:
- ----- Method: ScrollPane>>minScrollbarWidth (in category 'layout') -----
- minScrollbarWidth
- "Answer the minimum extent occupied by the receiver..
- It is assumed the if the receiver is sized to its minimum both scrollbars will be used (and visible) unless they have been turned off explicitly.
- This makes the behaviour also more predictable."
-
- ^ ((self hScrollBarPolicy == #never or: [self isAutoFit])
- ifTrue: [0]
- ifFalse: [hScrollBar minWidth])
- + ((retractableScrollBar or: [self vScrollBarPolicy == #never])
- ifTrue: [0]
- ifFalse: [self scrollBarThickness])!
Item was removed:
- ----- Method: ScrollPane>>mouseDown: (in category 'event handling') -----
- mouseDown: evt
- evt yellowButtonPressed "First check for option (menu) click"
- ifTrue: [^ self yellowButtonActivity: evt shiftPressed].
- "If pane is not empty, pass the event to the last submorph,
- assuming it is the most appropriate recipient (!!)"
- scroller hasSubmorphs ifTrue:
- [scroller submorphs last mouseDown: (evt transformedBy: (scroller transformFrom: self))]!
Item was removed:
- ----- Method: ScrollPane>>mouseEnter: (in category 'event handling') -----
- mouseEnter: event
- hasFocus := true.
- owner isSystemWindow ifTrue: [owner paneTransition: event].
- retractableScrollBar ifTrue: [self hideOrShowScrollBars].!
Item was removed:
- ----- Method: ScrollPane>>mouseLeave: (in category 'event handling') -----
- mouseLeave: event
- hasFocus := false.
- retractableScrollBar ifTrue: [self hideScrollBars].
- owner isSystemWindow ifTrue: [owner paneTransition: event].!
Item was removed:
- ----- Method: ScrollPane>>mouseMove: (in category 'event handling') -----
- mouseMove: evt
- "If pane is not empty, pass the event to the last submorph,
- assuming it is the most appropriate recipient (!!)."
- scroller hasSubmorphs ifTrue:
- [scroller submorphs last mouseMove: (evt transformedBy: (scroller transformFrom: self))]!
Item was removed:
- ----- Method: ScrollPane>>mouseUp: (in category 'event handling') -----
- mouseUp: evt
- "If pane is not empty, pass the event to the last submorph,
- assuming it is the most appropriate recipient (!!)"
- scroller hasSubmorphs ifTrue:
- [scroller submorphs last mouseUp: (evt transformedBy: (scroller transformFrom: self))]!
Item was removed:
- ----- Method: ScrollPane>>mouseWheel: (in category 'event handling') -----
- mouseWheel: evt
-
- evt isWheelUp ifTrue: [scrollBar scrollUp: (evt verticalScrollDelta: self class verticalScrollDeltaPerMouseWheelNotch)].
- evt isWheelDown ifTrue: [scrollBar scrollDown: (evt verticalScrollDelta: self class verticalScrollDeltaPerMouseWheelNotch)].
- evt isWheelLeft ifTrue: [hScrollBar scrollUp: (evt horizontalScrollDelta: self class horizontalScrollDeltaPerMouseWheelNotch)].
- evt isWheelRight ifTrue: [hScrollBar scrollDown: (evt horizontalScrollDelta: self class horizontalScrollDeltaPerMouseWheelNotch)].!
Item was removed:
- ----- Method: ScrollPane>>numSelectionsInView (in category 'accessing') -----
- numSelectionsInView
- "Answer the scroller's height based on the average number of submorphs."
-
- ^scroller numberOfItemsPotentiallyInView!
Item was removed:
- ----- Method: ScrollPane>>offsetToShow: (in category 'scrolling') -----
- offsetToShow: aRectangle
- "Calculate the offset necessary to show the rectangle."
-
- | offset scrollRange target |
- self fullBounds. "We need updated bounds."
- offset := scroller offset.
- scrollRange := self hTotalScrollRange @ self vTotalScrollRange.
-
- "Normalize the incoming rectangle."
- target :=
- (scroller width < aRectangle width
- ifTrue: [offset x < aRectangle left "Coming from left?"
- ifTrue: [aRectangle right - scroller width]
- ifFalse: [aRectangle left]]
- ifFalse: [aRectangle left])
- @
- (scroller height < aRectangle height
- ifTrue: [offset y < aRectangle top "Coming from top?"
- ifTrue: [aRectangle bottom - scroller height]
- ifFalse: [aRectangle top]]
- ifFalse: [aRectangle top])
- corner:
- (scroller width < aRectangle width
- ifTrue: [offset x + scroller width > aRectangle right "Coming from right?"
- ifTrue: [aRectangle left + scroller width]
- ifFalse: [aRectangle right]]
- ifFalse: [aRectangle right])
- @
- (scroller height < aRectangle height
- ifTrue: [offset y + scroller height > aRectangle bottom "Coming from bottom?"
- ifTrue: [aRectangle top + scroller height]
- ifFalse: [aRectangle bottom]]
- ifFalse: [aRectangle bottom]).
-
- "Vertical Scrolling"
- target top < offset y
- ifTrue: [offset := offset x @ target top].
- target bottom > (offset y + scroller height)
- ifTrue: [offset := offset x @ (target bottom - scroller height)].
-
- "Horizontal Scrolling"
- target left < offset x
- ifTrue: [offset := target left @ offset y].
- target right > (offset x + scroller width)
- ifTrue: [offset := (target right - scroller width) @ offset y].
-
- ^ (offset min: scrollRange - scroller extent) max: 0 at 0!
Item was removed:
- ----- Method: ScrollPane>>raisedColor (in category 'accessing') -----
- raisedColor
-
- ^ self containingWindow
- ifNil: [super raisedColor]
- ifNotNil: [:window | window raisedColor]!
Item was removed:
- ----- Method: ScrollPane>>resetExtent (in category 'geometry') -----
- resetExtent
- "Reset the extent. (may be overridden by subclasses which need to do more than this)"
-
- self flag: #deprecate. "mt: Remove all uses in Etoys."
- self resizeScroller!
Item was removed:
- ----- Method: ScrollPane>>resizeScrollBars (in category 'layout - resizing') -----
- resizeScrollBars
- self vResizeScrollBar; hResizeScrollBar
- !
Item was removed:
- ----- Method: ScrollPane>>resizeScroller (in category 'layout - resizing') -----
- resizeScroller
-
- scroller
- bounds: self layoutBounds;
- fullBounds. "To make #shrinkWrap work."!
Item was removed:
- ----- Method: ScrollPane>>retractable: (in category 'accessing retractable') -----
- retractable: aBoolean
- retractableScrollBar == aBoolean ifFalse: [self retractableOrNot "toggles it"]!
Item was removed:
- ----- Method: ScrollPane>>retractableOrNot (in category 'accessing retractable') -----
- retractableOrNot
- "Change scroll bar operation"
-
- retractableScrollBar := retractableScrollBar not.
- retractableScrollBar
- ifTrue: [
- self removeMorph: scrollBar; removeMorph: hScrollBar]
- ifFalse: [(submorphs includes: scrollBar)
- ifFalse:
- [self privateAddMorph: scrollBar atIndex: 1.
- self privateAddMorph: hScrollBar atIndex: 1]].
- self updateMinimumExtent.!
Item was removed:
- ----- Method: ScrollPane>>retractableScrollBar (in category 'accessing retractable') -----
- retractableScrollBar
- ^ retractableScrollBar!
Item was removed:
- ----- Method: ScrollPane>>scrollBarFills: (in category 'support') -----
- scrollBarFills: aRectangle
- "Return true if a flop-out scrollbar fills the rectangle"
-
- retractableScrollBar ifFalse:[^false].
-
- ((submorphs includes: scrollBar) and: [scrollBar bounds containsRect: aRectangle])
- ifTrue:[ ^true ].
- ^((submorphs includes: hScrollBar) and: [hScrollBar bounds containsRect: aRectangle])
- !
Item was removed:
- ----- Method: ScrollPane>>scrollBarMenuButtonPressed: (in category 'scroll bar events') -----
- scrollBarMenuButtonPressed: event
- ^ self yellowButtonActivity: event shiftPressed!
Item was removed:
- ----- Method: ScrollPane>>scrollBarOnLeft (in category 'accessing') -----
- scrollBarOnLeft
- ^ scrollBarOnLeft!
Item was removed:
- ----- Method: ScrollPane>>scrollBarOnLeft: (in category 'accessing') -----
- scrollBarOnLeft: aBoolean
-
- scrollBarOnLeft := aBoolean.
- self layoutChanged.!
Item was removed:
- ----- Method: ScrollPane>>scrollBarThickness (in category 'accessing') -----
- scrollBarThickness
- "Includes border"
-
- ^ scrollBarThickness!
Item was removed:
- ----- Method: ScrollPane>>scrollBarThickness: (in category 'accessing') -----
- scrollBarThickness: anInteger
-
- scrollBarThickness := anInteger.
-
- self updateMinimumExtent.
- self layoutChanged.!
Item was removed:
- ----- Method: ScrollPane>>scrollBy: (in category 'scrolling') -----
- scrollBy: delta
- "Move the contents in the direction delta."
-
- self flag: #negated. "mt: Who uses this and why is does the expected behavor negate the delta?"
- self vScrollBar scrollBy: delta y negated.
- self hScrollBar scrollBy: delta x negated.!
Item was removed:
- ----- Method: ScrollPane>>scrollByKeyboard: (in category 'event handling') -----
- scrollByKeyboard: event
- "If event is ctrl+up/down then scroll and answer true. Backwards compatibility."
-
- (event controlKeyPressed or:[event commandKeyPressed "??? key decode table in event sensor does not change CTRL+up/down !!!!!!"]) ifFalse: [^ false].
- event keyCharacter = Character arrowUp
- ifTrue:
- [scrollBar scrollUp: 3.
- ^ true].
- event keyCharacter = Character arrowDown
- ifTrue:
- [scrollBar scrollDown: 3.
- ^ true].
- "event keyCharacter = Character arrowRight
- ifTrue:
- [hScrollBar scrollDown: 3.
- ^ true].
- event keyCharacter = Character arrowLeft
- ifTrue:
- [hScrollBar scrollUp: 3.
- ^ true]."
- ^ false!
Item was removed:
- ----- Method: ScrollPane>>scrollDeltaHeight (in category 'geometry') -----
- scrollDeltaHeight
- "Return the increment in pixels which this pane should be scrolled (normally a subclass responsibility)."
- ^ 10
- !
Item was removed:
- ----- Method: ScrollPane>>scrollDeltaWidth (in category 'geometry') -----
- scrollDeltaWidth
- "Return the increment in pixels which this pane should be scrolled (normally a subclass responsibility)."
-
- ^10
- !
Item was removed:
- ----- Method: ScrollPane>>scrollToBottom (in category 'scrolling') -----
- scrollToBottom
-
- self vScrollBar scrollToMaximum..!
Item was removed:
- ----- Method: ScrollPane>>scrollToLeft (in category 'scrolling') -----
- scrollToLeft
-
- self hScrollBar scrollToMinimum..!
Item was removed:
- ----- Method: ScrollPane>>scrollToRight (in category 'scrolling') -----
- scrollToRight
-
- self hScrollBar scrollToMaximum.!
Item was removed:
- ----- Method: ScrollPane>>scrollToShow: (in category 'scrolling') -----
- scrollToShow: aRectangle
-
- | newOffset |
- newOffset := self offsetToShow: aRectangle.
- self hScrollBar setValue: newOffset x.
- self vScrollBar setValue: newOffset y.!
Item was removed:
- ----- Method: ScrollPane>>scrollToTop (in category 'scrolling') -----
- scrollToTop
-
- self vScrollBar scrollToMinimum.!
Item was removed:
- ----- Method: ScrollPane>>scroller (in category 'accessing') -----
- scroller
- ^ scroller!
Item was removed:
- ----- Method: ScrollPane>>scroller: (in category 'accessing') -----
- scroller: aTransformMorph
- scroller ifNotNil:[scroller delete].
- scroller := aTransformMorph.
- self addMorph: scroller.!
Item was removed:
- ----- Method: ScrollPane>>setDefaultParameters (in category 'initialization') -----
- setDefaultParameters
- "change the receiver's appareance parameters"
-
- self
- color: (self userInterfaceTheme color ifNil: [Color white]);
- borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle simple]) copy;
- borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray: 0.6]);
- borderWidth: ((self userInterfaceTheme borderWidth ifNil: [1]) * RealEstateAgent scaleFactor) truncated.
-
- self removeProperty: #keyboardFocusWidth.
- self removeProperty: #keyboardFocusColor.!
Item was removed:
- ----- Method: ScrollPane>>setScrollDeltas (in category 'layout - scrolling') -----
- setScrollDeltas
- "Set the ScrollBar deltas, value and interval, based on the current scroll pane size, offset and range."
-
- scroller ifNil: [^ self].
-
- self hideOrShowScrollBars.
- self vSetScrollDelta.
- self hSetScrollDelta.!
Item was removed:
- ----- Method: ScrollPane>>shiftedTextPaneMenuRequest (in category 'scroll bar events') -----
- shiftedTextPaneMenuRequest
- "The more... button was hit from the text-pane menu"
-
- ^ self yellowButtonActivity: true!
Item was removed:
- ----- Method: ScrollPane>>shiftedYellowButtonActivity (in category 'scroll bar events') -----
- shiftedYellowButtonActivity
- ^ self yellowButtonActivity: true!
Item was removed:
- ----- Method: ScrollPane>>showHScrollBarOnlyWhenNeeded (in category 'accessing options') -----
- showHScrollBarOnlyWhenNeeded
-
- self hScrollBarPolicy: #whenNeeded.
- self hHideOrShowScrollBar.
- !
Item was removed:
- ----- Method: ScrollPane>>showScrollBars (in category 'layout - visibility') -----
- showScrollBars
- self vShowScrollBar; hShowScrollBar
- !
Item was removed:
- ----- Method: ScrollPane>>showScrollBarsOnlyWhenNeeded (in category 'accessing options') -----
- showScrollBarsOnlyWhenNeeded
-
- self
- showHScrollBarOnlyWhenNeeded;
- showVScrollBarOnlyWhenNeeded.
- !
Item was removed:
- ----- Method: ScrollPane>>showVScrollBarOnlyWhenNeeded (in category 'accessing options') -----
- showVScrollBarOnlyWhenNeeded
- "Get rid of scroll bar for short panes that don't want it shown."
-
- self vScrollBarPolicy: #whenNeeded.
- self vHideOrShowScrollBar.
- !
Item was removed:
- ----- Method: ScrollPane>>submorphBoundsForShrinkWrap (in category 'layout') -----
- submorphBoundsForShrinkWrap
- "No need to consider scrollbars because those are placed outside the #innerBounds like a border. See #resizeScroller."
-
- ^ scroller bounds!
Item was removed:
- ----- Method: ScrollPane>>unshiftedYellowButtonActivity (in category 'scroll bar events') -----
- unshiftedYellowButtonActivity
- ^ self yellowButtonActivity: false!
Item was removed:
- ----- Method: ScrollPane>>updateLayout (in category 'layout') -----
- updateLayout
- "Manually layout my submorphs. Maybe we can find a proper layout policy in the future."
-
- self scroller hasSubmorphs ifTrue: [
- self scroller firstSubmorph changesHeightForWidth
- ifTrue: [self vHideScrollBar; resizeScroller; vHideOrShowScrollBar; resizeScroller]
- ifFalse: [self scroller firstSubmorph changesWidthForHeight
- ifTrue: [self hHideScrollBar; resizeScroller; hHideOrShowScrollBar; resizeScroller]
- ifFalse: [self resizeScroller]]].
-
- self
- resizeScrollBars;
- adjustOffset;
- setScrollDeltas.
- !
Item was removed:
- ----- Method: ScrollPane>>updateMinimumExtent (in category 'layout') -----
- updateMinimumExtent
- "This grows only. For shrinking scroll bars, this might have to be changed."
-
- self minimumWidth: (self minimumWidth max: self minScrollbarWidth).
- self minimumHeight: (self minimumHeight max: self minScrollbarHeight).!
Item was removed:
- ----- Method: ScrollPane>>vExtraScrollRange (in category 'geometry ranges') -----
- vExtraScrollRange
- "Return the amount of extra blank space to include below the bottom of the scroll content."
- ^ 0
- !
Item was removed:
- ----- Method: ScrollPane>>vHideOrShowScrollBar (in category 'layout - visibility') -----
- vHideOrShowScrollBar
-
- self vIsScrollbarNeeded
- ifTrue:[ self vShowScrollBar ]
- ifFalse:[ self vHideScrollBar ].
- !
Item was removed:
- ----- Method: ScrollPane>>vHideScrollBar (in category 'layout - visibility') -----
- vHideScrollBar
-
- self vIsScrollbarShowing ifFalse: [^self].
- self removeMorph: scrollBar.
- retractableScrollBar ifFalse: [self setProperty: #doLayoutAgainHere toValue: true].!
Item was removed:
- ----- Method: ScrollPane>>vIsScrollable (in category 'geometry testing') -----
- vIsScrollable
- "Return whether the verticle scrollbar is scrollable. If the contents of the pane are too small to scroll, return false."
-
- ^ self vLeftoverScrollRange > 0!
Item was removed:
- ----- Method: ScrollPane>>vIsScrollbarNeeded (in category 'geometry testing') -----
- vIsScrollbarNeeded
- "Return whether the verticle scrollbar is needed"
-
- "Don't do anything with the retractable scrollbar unless we have focus"
- retractableScrollBar & self hasFocus not ifTrue: [^false].
-
- "Don't show it if we were told not to."
- self vScrollBarPolicy == #never ifTrue: [^false].
-
- "Always show it if we were told to"
- self vScrollBarPolicy == #always ifTrue: [^true].
-
- ^self vIsScrollable
- !
Item was removed:
- ----- Method: ScrollPane>>vIsScrollbarShowing (in category 'geometry testing') -----
- vIsScrollbarShowing
- "Return true if a retractable scroll bar is currently showing"
-
- ^ scrollBar owner notNil
- !
Item was removed:
- ----- Method: ScrollPane>>vIsScrolled (in category 'geometry testing') -----
- vIsScrolled
- "If the scroller is not set to y = 0, then the pane has been scrolled."
- ^scroller offset y > 0
- !
Item was removed:
- ----- Method: ScrollPane>>vLeftoverScrollRange (in category 'geometry ranges') -----
- vLeftoverScrollRange
- "Return the entire scrolling range minus the currently viewed area."
-
- ^ scroller hasSubmorphs
- ifFalse: [0]
- ifTrue: [self vTotalScrollRange - scroller height max: 0]
- !
Item was removed:
- ----- Method: ScrollPane>>vResizeScrollBar (in category 'layout - resizing') -----
- vResizeScrollBar
-
- | w topLeft border |
- self vScrollBarPolicy == #never ifTrue: [^self].
-
- w := self scrollBarThickness.
- border := self borderWidth.
- topLeft := scrollBarOnLeft
- ifTrue: [retractableScrollBar
- ifTrue: [bounds topLeft - ((w - border) @ 0)]
- ifFalse: [bounds topLeft]]
- ifFalse: [retractableScrollBar
- ifTrue: [bounds topRight - (border @ 0)]
- ifFalse: [bounds topRight - (w @ 0)]].
-
- scrollBar bounds: (topLeft extent: w @ self vScrollBarHeight)
-
- !
Item was removed:
- ----- Method: ScrollPane>>vResizing: (in category 'layout') -----
- vResizing: aSymbol
- "Pass #shrinkWrap property to scroller to make this scroll pane's layout work. See #doLayoutIn:."
-
- super vResizing: aSymbol.
-
- scroller vResizing: (aSymbol == #shrinkWrap
- ifTrue: [#shrinkWrap]
- ifFalse: [#spaceFill]).!
Item was removed:
- ----- Method: ScrollPane>>vScrollBar (in category 'accessing') -----
- vScrollBar
- ^ scrollBar!
Item was removed:
- ----- Method: ScrollPane>>vScrollBarHeight (in category 'geometry') -----
- vScrollBarHeight
- | h |
-
- h := bounds height "- (2 * borderWidth)".
- (retractableScrollBar not and: [self hIsScrollbarNeeded])
- ifTrue:[ h := h - self scrollBarThickness. ].
-
- ^h
- !
Item was removed:
- ----- Method: ScrollPane>>vScrollBarMenuButtonPressed: (in category 'scroll bar events') -----
- vScrollBarMenuButtonPressed: event
- ^ self scrollBarMenuButtonPressed: event
- !
Item was removed:
- ----- Method: ScrollPane>>vScrollBarPolicy (in category 'accessing') -----
- vScrollBarPolicy
-
- ^ vScrollBarPolicy!
Item was removed:
- ----- Method: ScrollPane>>vScrollBarPolicy: (in category 'accessing') -----
- vScrollBarPolicy: aSymbol
- "#always, #never, #whenNeeded"
-
- vScrollBarPolicy = aSymbol ifTrue: [^ self].
- self checkScrollBarPolicy: aSymbol.
-
- vScrollBarPolicy := aSymbol.
- self layoutChanged.!
Item was removed:
- ----- Method: ScrollPane>>vScrollBarValue: (in category 'scrolling') -----
- vScrollBarValue: scrollValue
-
- scroller hasSubmorphs ifFalse: [^ self].
- scroller offset: scroller offset x @ (scrollValue max: 0).!
Item was removed:
- ----- Method: ScrollPane>>vSetScrollDelta (in category 'layout - scrolling') -----
- vSetScrollDelta
- "Set the ScrollBar deltas, value and interval, based on the current scroll pane size, offset and range."
-
- | delta |
- delta := self scrollDeltaHeight.
-
- scrollBar
- truncate: true;
- scrollDelta: delta
- pageDelta: 10*delta;
- maximumValue: self vLeftoverScrollRange;
- interval: (self vTotalScrollRange = 0
- ifTrue: [1.0]
- ifFalse: [scroller height / self vTotalScrollRange]);
- setValue: scroller offset y.!
Item was removed:
- ----- Method: ScrollPane>>vShowScrollBar (in category 'layout - visibility') -----
- vShowScrollBar
-
- self vIsScrollbarShowing ifTrue: [^ self].
- self vResizeScrollBar.
- self privateAddMorph: scrollBar atIndex: 1.
- retractableScrollBar
- ifTrue: [self comeToFront]
- ifFalse:[self setProperty: #doLayoutAgainHere toValue: true].!
Item was removed:
- ----- Method: ScrollPane>>vTotalScrollRange (in category 'geometry ranges') -----
- vTotalScrollRange
- "Return the entire scrolling range."
- ^ self vUnadjustedScrollRange + self vExtraScrollRange
- !
Item was removed:
- ----- Method: ScrollPane>>vUnadjustedScrollRange (in category 'geometry ranges') -----
- vUnadjustedScrollRange
- "Return the height extent of the receiver's submorphs."
-
- ^ scroller localSubmorphBounds height!
Item was removed:
- ----- Method: ScrollPane>>wantsKeyboardFocus (in category 'event handling') -----
- wantsKeyboardFocus
-
- ^ true!
Item was removed:
- ----- Method: ScrollPane>>wantsSlot (in category 'accessing') -----
- wantsSlot
- "For now do it the old way, until we sort this out"
- ^ true!
Item was removed:
- ----- Method: ScrollPane>>wantsYellowButtonMenu (in category 'menu') -----
- wantsYellowButtonMenu
- "Answer true if the receiver wants a yellow button menu"
- ^ getMenuSelector notNil!
Item was removed:
- ----- Method: ScrollPane>>yellowButtonActivity: (in category 'scroll bar events') -----
- yellowButtonActivity: shiftKeyState
- | menu |
- (menu := self getMenu: shiftKeyState) ifNotNil:
- [menu setInvokingView: self.
- menu popUpEvent: self activeHand lastEvent in: self world]!
Item was removed:
- Model subclass: #SearchBar
- instanceVariableNames: 'originatingWidget searchTerm selection resultsWidget workspace scratchPad'
- classVariableNames: 'UseScratchPad UseSmartSearch'
- poolDictionaries: ''
- category: 'Morphic-Menus-DockingBar'!
Item was removed:
- ----- Method: SearchBar class>>build (in category 'building') -----
- build
-
- ^ ToolBuilder build: self new!
Item was removed:
- ----- Method: SearchBar class>>useScratchPad (in category 'preferences') -----
- useScratchPad
- <preference: 'Ctrl+0 invokes the scratch pad'
- category: 'docking bars'
- description: 'When enabled, pressing Ctrl+0 will go straight to the Search Bar''s scratch pad instead of the Search Bar, where pressing ESCape will return keyboard focus to the originating window.'
- type: #Boolean>
- ^ UseScratchPad ifNil: [ false ]!
Item was removed:
- ----- Method: SearchBar class>>useScratchPad: (in category 'preferences') -----
- useScratchPad: aBoolean
- UseScratchPad := aBoolean!
Item was removed:
- ----- Method: SearchBar class>>useSmartSearch (in category 'preferences') -----
- useSmartSearch
- <preference: 'Smart search'
- category: 'docking bars'
- description: 'When enabled, the docking bar search tries to find globals or full class names first, then tries to browse implementors, then tries to find class names if the search term starts uppercase, and finally invoke the regular message names search. When disabled, do only the last.'
- type: #Boolean>
- ^ UseSmartSearch ifNil: [ true ]!
Item was removed:
- ----- Method: SearchBar class>>useSmartSearch: (in category 'preferences') -----
- useSmartSearch: aBoolean
- UseSmartSearch := aBoolean.!
Item was removed:
- ----- Method: SearchBar>>activate:in: (in category 'accessing') -----
- activate: event in: morph
- self class useScratchPad
- ifTrue:
- [ event hand keyboardFocus = self scratchPad ifFalse: [ originatingWidget := event hand keyboardFocus ].
- self scratchPad selectAll; openInWorld.
- self layoutScratchPad.
- event hand newKeyboardFocus: self scratchPad ]
- ifFalse:
- [ self selection: (1 to: self searchTerm size).
- event hand newKeyboardFocus: morph textMorph ]!
Item was removed:
- ----- Method: SearchBar>>bindingOf: (in category 'accessing') -----
- bindingOf: x
-
- ^ self workspace bindingOf: x!
Item was removed:
- ----- Method: SearchBar>>buildWith: (in category 'toolbuilder') -----
- buildWith: builder
-
- ^ (builder build: (builder pluggableInputFieldSpec new
- model: self;
- plainTextOnly: true;
- getText: #searchTerm;
- setText: #smartSearch:in:;
- editText: #searchTermSilently:;
- menu: #menu:shifted:;
- selection: #selection;
- indicateUnacceptedChanges: false;
- help: 'Search or evaluate...' translated))
- name: #searchBar;
- wantsFrameAdornments: false;
- yourself!
Item was removed:
- ----- Method: SearchBar>>handleScratchPadKey: (in category 'private') -----
- handleScratchPadKey: aKeyboardEvent
- (aKeyboardEvent keyValue = Character escape asciiValue and: [ originatingWidget notNil ]) ifTrue:
- [ aKeyboardEvent hand newKeyboardFocus: originatingWidget.
- self removeScratchPad ]!
Item was removed:
- ----- Method: SearchBar>>layoutScratchPad (in category 'private') -----
- layoutScratchPad
- | world pos width |
- world := Project current world.
- world mainDockingBars do:
- [ : each | each searchBarMorph ifNotNil:
- [ : searchBar | pos := searchBar bottomLeft.
- width := searchBar width ] ].
- width ifNil: [ width := 250. pos := world topRight - (width @ 5) ].
- scratchPad
- width: width ;
- position: pos ;
- startStepping: #deleteUnlessHasFocus at: Time millisecondClockValue arguments: nil stepTime: 3000!
Item was removed:
- ----- Method: SearchBar>>menu:shifted: (in category 'accessing') -----
- menu: aMenu shifted: aBoolean
-
- ^ StringHolder codePaneMenu: aMenu shifted: aBoolean!
Item was removed:
- ----- Method: SearchBar>>okToRevertChanges: (in category 'user edits') -----
- okToRevertChanges: aspect
- "Clear caches since we use #textEdited: callback from view."
-
- aspect = #searchTermSilently: ifTrue: [searchTerm := ''].
- ^ true!
Item was removed:
- ----- Method: SearchBar>>printIt:result: (in category 'do-its') -----
- printIt: code result: object
-
- | focusedWidget |
- focusedWidget := self currentHand keyboardFocus.
-
- self removeResultsWidget.
-
- ToolBuilder default in: [:builder |
- resultsWidget := (builder build: (StringHolder new
- contents: object asString;
- buildCodePaneWith: builder)).
- "This might cause the widget disappear to early. Especially if the textMorph is to small but the container needs to maintain a larger size because of its scroll bars."
- resultsWidget textMorph
- on: #mouseLeave send: #delete to: resultsWidget.
- resultsWidget
- extent: 1000 at 1000; fullBounds; "give text a chance to layout good"
- width: 250; fullBounds;
- height: (resultsWidget extentToFit y min: 300);
- position: (focusedWidget
- ifNotNil: [:w | w owner boundsInWorld bottomLeft]
- ifNil: [self currentHand position]);
- color: (BalloonMorph balloonColor alpha: 1.0).
-
- Preferences menuAppearance3d
- ifTrue: [resultsWidget addDropShadow].
-
- resultsWidget openInWorld].!
Item was removed:
- ----- Method: SearchBar>>removeResultsWidget (in category 'accessing') -----
- removeResultsWidget
-
- resultsWidget ifNotNil: [:w | w delete].
- resultsWidget := nil.!
Item was removed:
- ----- Method: SearchBar>>removeScratchPad (in category 'accessing') -----
- removeScratchPad
- scratchPad ifNotNil: [ scratchPad delete ]!
Item was removed:
- ----- Method: SearchBar>>scratchPad (in category 'accessing') -----
- scratchPad
- ^ scratchPad ifNil:
- [ scratchPad := TextMorphForEditView new. "we should be able to use TextMorph here; fix later"
- scratchPad
- " on: #keyboardFocusChange send: #removeScratchPad to: self ;"
- on: #mouseLeave send: #removeScratchPad to: self ;
- on: #keyStroke send: #handleScratchPadKey: to: self ;
- margins: (5 at 0 corner: 5 at 0);
- backgroundColor: ((UserInterfaceTheme current get: #color for: #NewBalloonMorph) ifNil: [ BalloonMorph balloonColor ]) ;
- setEditView: PluggableTextMorph new ; "dummy"
- autoFit: true ;
- wrapFlag: true ;
- newContents: '--scratch area--' ;
- font: ((UserInterfaceTheme current get: #font for: #PluggableTextMorph) ifNil: [TextStyle defaultFont]);
- textColor: ((UserInterfaceTheme current get: #textColor for: #PluggableTextMorph) ifNil: [Color black]);
- caretColor: ((UserInterfaceTheme current get: #caretColor for: #PluggableTextMorph) ifNil: [Color red]);
- selectionColor: ((UserInterfaceTheme current get: #selectionColor for: #PluggableTextMorph) ifNil: [Color blue muchDarker] ifNotNil: [ : col | col twiceLighter ]);
- yourself.
- self layoutScratchPad.
- Preferences menuAppearance3d ifTrue: [ scratchPad addDropShadow ].
- scratchPad ]!
Item was removed:
- ----- Method: SearchBar>>searchTerm (in category 'accessing') -----
- searchTerm
-
- ^ searchTerm ifNil: ['']!
Item was removed:
- ----- Method: SearchBar>>searchTerm: (in category 'accessing') -----
- searchTerm: aString
-
- searchTerm := aString.
- self changed: #searchTerm.!
Item was removed:
- ----- Method: SearchBar>>searchTermSilently: (in category 'accessing') -----
- searchTermSilently: aString.
- "Do not signal it to the model."
-
- searchTerm := aString.!
Item was removed:
- ----- Method: SearchBar>>selection (in category 'accessing') -----
- selection
-
- ^ selection ifNil: [1 to: 0]!
Item was removed:
- ----- Method: SearchBar>>selection: (in category 'accessing') -----
- selection: anInterval
-
- selection := anInterval.
- self changed: #selection.!
Item was removed:
- ----- Method: SearchBar>>smartSearch:in: (in category 'searching') -----
- smartSearch: text in: morph
- "Take the user input and perform an appropriate search"
- | input newContents |
- self removeResultsWidget.
- input := text asString ifEmpty:[^self].
- self class useSmartSearch ifFalse: [^ ToolSet default browseMessageNames: input].
-
- (Symbol lookup: input) ifNotNil:
- [:symbol| input := symbol].
- "If it is a global or a full class name, browse that class."
- (Smalltalk bindingOf: input) ifNotNil:
- [:assoc| | class |
- class := (assoc value isBehavior ifTrue:[assoc value] ifFalse:[assoc value class]) theNonMetaClass.
- ^ToolSet browseClass: class].
-
- "If it is a symbol and there are implementors of it, browse those implementors."
- input isSymbol ifTrue:
- [(SystemNavigation new allImplementorsOf: input) ifNotEmpty:
- [:list|
- ^SystemNavigation new
- browseMessageList: list
- name: 'Implementors of ' , input]].
-
- "If it starts uppercase, browse classes if any. Otherwise, just search for messages."
- input first isUppercase ifTrue:
- [(UIManager default classFromPattern: input withCaption: '') ifNotNil:
- [:aClass| ^ToolSet browse: aClass selector: nil].
- newContents := input, ' -- not found.'.
- self searchTerm: newContents.
- self selection: (input size+1 to: newContents size).
- self currentHand newKeyboardFocus: morph textMorph.
- ^ self].
-
- "Default to browse message names..."
- ToolSet default browseMessageNames: input!
Item was removed:
- ----- Method: SearchBar>>workspace (in category 'accessing') -----
- workspace
-
- ^ workspace ifNil: [workspace := Workspace new]!
Item was removed:
- ImageMorph subclass: #SelectedObjectThumbnail
- instanceVariableNames: 'noSelectedThumbnail noSelectedBalloonText'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
Item was removed:
- ----- Method: SelectedObjectThumbnail class>>extent:noSelectedThumbnail:noSelectedBalloonText: (in category 'instance creation') -----
- extent: aPoint noSelectedThumbnail: aForm noSelectedBalloonText: aString
- ^ self new
- initializeExtent: aPoint
- noSelectedThumbnail: aForm
- noSelectedBalloonText: aString !
Item was removed:
- ----- Method: SelectedObjectThumbnail>>initialize (in category 'initialization') -----
- initialize
- "Initialize the receiver"
- super initialize.
- ""
- self
- image: (Form extent:32 at 32).
- self color: Color transparent!
Item was removed:
- ----- Method: SelectedObjectThumbnail>>initializeExtent:noSelectedThumbnail:noSelectedBalloonText: (in category 'initialization') -----
- initializeExtent: aPoint noSelectedThumbnail: aForm noSelectedBalloonText: aString
- self
- image: (Form extent: aPoint).
- ""
- noSelectedThumbnail := aForm.
- noSelectedBalloonText := aString!
Item was removed:
- ----- Method: SelectedObjectThumbnail>>makeEmptyThumbnail (in category 'private') -----
- makeEmptyThumbnail
-
- ^ self makeThumbnailOfColor: Color veryLightGray.
- !
Item was removed:
- ----- Method: SelectedObjectThumbnail>>makeErrorThumbnail (in category 'private') -----
- makeErrorThumbnail
- ^ self makeThumbnailOfColor: Color red!
Item was removed:
- ----- Method: SelectedObjectThumbnail>>makeThumbnailFrom: (in category 'private') -----
- makeThumbnailFrom: aMorphOrNil
- | thumbnail |
- thumbnail := aMorphOrNil isNil
- ifTrue: [noSelectedThumbnail
- ifNil: [self makeEmptyThumbnail]]
- ifFalse: [aMorphOrNil iconOrThumbnail].
- ""
- self
- image: (thumbnail scaledIntoFormOfSize: self extent)!
Item was removed:
- ----- Method: SelectedObjectThumbnail>>makeThumbnailOfColor: (in category 'private') -----
- makeThumbnailOfColor: aColor
- | form |
- form := Form extent: self extent depth: 32.
- form getCanvas fillColor: aColor.
- self image: form!
Item was removed:
- ----- Method: SelectedObjectThumbnail>>noSelectedBalloonText: (in category 'accessing') -----
- noSelectedBalloonText: aString
- "Set the balloon text to be used when no object is selected"
- noSelectedBalloonText := aString!
Item was removed:
- ----- Method: SelectedObjectThumbnail>>noSelectedThumbnail: (in category 'accessing') -----
- noSelectedThumbnail: aForm
- "Set the form to be used when no object is selected"
- noSelectedThumbnail := aForm!
Item was removed:
- ----- Method: SelectedObjectThumbnail>>step (in category 'stepping and presenter') -----
- step
- | current |
- current := self selectedObject.
-
- self setBalloonText: (current isNil
- ifTrue: [noSelectedBalloonText]
- ifFalse: [current externalName]).
- ""
- self makeThumbnailFrom: current!
Item was removed:
- ----- Method: SelectedObjectThumbnail>>stepTime (in category 'stepping and presenter') -----
- stepTime
- ^ 125!
Item was removed:
- BorderedMorph subclass: #SelectionMorph
- instanceVariableNames: 'selectedItems slippage dupLoc dupDelta itemsAlreadySelected otherSelection undoProperties'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Support'!
-
- !SelectionMorph commentStamp: '<historical>' prior: 0!
- A selectionMorph supports the selection of multiple objects in a morphic world or pasteUp.
-
- Structure:
- selectedItems an OrderedCollection of Morphs
- These are the morphs that have been selected
- slippage a Point
- Keeps track of actual movement between the
- steps of gridded movement
- dupLoc a Point
- Notes the position when first duplicate request occurs from halo
- dupDelta a Point
- Holds the final delta of the first duplicate plus subsequent moves.
- !
Item was removed:
- ----- Method: SelectionMorph class>>defaultNameStemForInstances (in category 'scripting') -----
- defaultNameStemForInstances
- ^ 'Selection' translatedNoop!
Item was removed:
- ----- Method: SelectionMorph>>addCustomMenuItems:hand: (in category 'halo commands') -----
- addCustomMenuItems: aMenu hand: aHandMorph
- "Add custom menu items to the menu"
-
- super addCustomMenuItems: aMenu hand: aHandMorph.
- aMenu addList: {
- #-.
- {'place into a row' translated. #organizeIntoRow}.
- {'place into a column' translated. #organizeIntoColumn}.
- #-.
- {'align left edges' translated. #alignLeftEdges}.
- {'align top edges' translated. #alignTopEdges}.
- {'align right edges' translated. #alignRightEdges}.
- {'align bottom edges' translated. #alignBottomEdges}.
- #-.
- {'align centers vertically' translated. #alignCentersVertically}.
- {'align centers horizontally' translated. #alignCentersHorizontally}.
- #-.
- {'distribute vertically' translated. #distributeVertically}.
- {'distribute horizontally' translated. #distributeHorizontally}.
- }
-
-
- !
Item was removed:
- ----- Method: SelectionMorph>>addHandlesTo:box: (in category 'halos and balloon help') -----
- addHandlesTo: aHaloMorph box: box
- | onlyThese |
- aHaloMorph haloBox: box.
- onlyThese := #(addDismissHandle: addMenuHandle: addGrabHandle: addDragHandle: addDupHandle: addHelpHandle: addGrowHandle: addFontSizeHandle: addFontStyleHandle: addFontEmphHandle: addRecolorHandle:).
- Preferences haloSpecifications do:
- [:aSpec | (onlyThese includes: aSpec addHandleSelector) ifTrue:
- [aHaloMorph perform: aSpec addHandleSelector with: aSpec]].
- aHaloMorph innerTarget addOptionalHandlesTo: aHaloMorph box: box!
Item was removed:
- ----- Method: SelectionMorph>>addOptionalHandlesTo:box: (in category 'halos and balloon help') -----
- addOptionalHandlesTo: aHalo box: box
- aHalo addHandleAt: box leftCenter color: Color blue icon: nil
- on: #mouseUp send: #addOrRemoveItems: to: self.!
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: SelectionMorph>>alignBottomEdges (in category 'halo commands') -----
- alignBottomEdges
- "Make the bottom coordinate of all my elements be the same"
-
- | maxBottom |
- maxBottom := (selectedItems collect: [:itm | itm bottom]) max.
- selectedItems do:
- [:itm | itm bottom: maxBottom].
-
- self changed
- !
Item was removed:
- ----- Method: SelectionMorph>>alignCentersHorizontally (in category 'halo commands') -----
- alignCentersHorizontally
- "Make every morph in the selection have the same vertical center as the topmost item."
-
- | minLeft leftMost |
- selectedItems size > 1 ifFalse: [^ self].
- minLeft := (selectedItems collect: [:itm | itm left]) min.
- leftMost := selectedItems detect: [:m | m left = minLeft].
- selectedItems do:
- [:itm | itm center: (itm center x @ leftMost center y)].
-
- self changed
- !
Item was removed:
- ----- Method: SelectionMorph>>alignCentersVertically (in category 'halo commands') -----
- alignCentersVertically
- "Make every morph in the selection have the same horizontal center as the topmost item."
-
- | minTop topMost |
- selectedItems size > 1 ifFalse: [^ self].
- minTop := (selectedItems collect: [:itm | itm top]) min.
- topMost := selectedItems detect: [:m | m top = minTop].
- selectedItems do:
- [:itm | itm center: (topMost center x @ itm center y)].
-
- self changed
- !
Item was removed:
- ----- Method: SelectionMorph>>alignLeftEdges (in category 'halo commands') -----
- alignLeftEdges
- "Make the left coordinate of all my elements be the same"
-
- | minLeft |
- minLeft := (selectedItems collect: [:itm | itm left]) min.
- selectedItems do:
- [:itm | itm left: minLeft].
-
- self changed
- !
Item was removed:
- ----- Method: SelectionMorph>>alignRightEdges (in category 'halo commands') -----
- alignRightEdges
- "Make the right coordinate of all my elements be the same"
-
- | maxRight |
- maxRight := (selectedItems collect: [:itm | itm right]) max.
- selectedItems do:
- [:itm | itm right: maxRight].
-
- self changed
- !
Item was removed:
- ----- Method: SelectionMorph>>alignTopEdges (in category 'halo commands') -----
- alignTopEdges
- "Make the top coordinate of all my elements be the same"
-
- | minTop |
- minTop := (selectedItems collect: [:itm | itm top]) min.
- selectedItems do:
- [:itm | itm top: minTop].
-
- self changed
- !
Item was removed:
- ----- Method: SelectionMorph>>balloonHelpTextForHandle: (in category 'halos and balloon help') -----
- balloonHelpTextForHandle: aHandle
- aHandle eventHandler firstMouseSelector == #addOrRemoveItems:
- ifTrue: [^'Add items to, or remove them from, this selection.'].
- ^ super balloonHelpTextForHandle: aHandle!
Item was removed:
- ----- Method: SelectionMorph>>borderColor: (in category 'accessing') -----
- borderColor: aColor
-
- | bordered |
- bordered := selectedItems.
- undoProperties ifNil: [undoProperties := bordered collect: [:m | m borderColor]].
- bordered do: [:m | m borderColor: aColor]!
Item was removed:
- ----- Method: SelectionMorph>>borderColorForItems: (in category 'undo') -----
- borderColorForItems: colorCollection
-
- (selectedItems select: [:m | m isKindOf: BorderedMorph])
- with: colorCollection
- do: [:m :c | m borderColor: c]!
Item was removed:
- ----- Method: SelectionMorph>>borderWidth: (in category 'accessing') -----
- borderWidth: aWidth
-
- | bordered |
- bordered := selectedItems select: [:m | m isKindOf: BorderedMorph].
- undoProperties ifNil: [undoProperties := bordered collect: [:m | m borderWidth]].
- bordered do: [:m | m borderWidth: aWidth]!
Item was removed:
- ----- Method: SelectionMorph>>borderWidthForItems: (in category 'undo') -----
- borderWidthForItems: widthCollection
-
- (selectedItems select: [:m | m isKindOf: BorderedMorph])
- with: widthCollection
- do: [:m :c | m borderWidth: c]!
Item was removed:
- ----- Method: SelectionMorph>>bounds: (in category 'geometry') -----
- bounds: newBounds
- "Make sure position: gets called before extent:; Andreas' optimization for growing/shrinking in ChangeSet 3119 screwed up selection of morphs from underlying pasteup."
-
- selectedItems := OrderedCollection new. "Avoid repostioning items during super position:"
- self position: newBounds topLeft; extent: newBounds extent
- !
Item was removed:
- ----- Method: SelectionMorph>>couldMakeSibling (in category 'testing') -----
- couldMakeSibling
- "Answer whether it is appropriate to ask the receiver to make a sibling"
-
- ^ false!
Item was removed:
- ----- Method: SelectionMorph>>defaultBorderColor (in category 'initialization') -----
- defaultBorderColor
- "answer the default border color/fill style for the receiver"
- ^ self userInterfaceTheme borderColor ifNil: [Color blue twiceDarker alpha: 0.75]!
Item was removed:
- ----- Method: SelectionMorph>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- "answer the default border width for the receiver"
- ^ 2!
Item was removed:
- ----- Method: SelectionMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ self userInterfaceTheme color ifNil: [Color blue alpha: 0.08]
- !
Item was removed:
- ----- Method: SelectionMorph>>delete (in category 'submorphs - add/remove') -----
- delete
- self setProperty: #deleting toValue: true.
- super delete.
- !
Item was removed:
- ----- Method: SelectionMorph>>dismissViaHalo (in category 'submorphs - add/remove') -----
- dismissViaHalo
- selectedItems do: [:m | m dismissViaHalo].
- super dismissViaHalo.
- !
Item was removed:
- ----- Method: SelectionMorph>>distributeHorizontally (in category 'halo commands') -----
- distributeHorizontally
- "Distribute the empty vertical space in a democratic way."
- | minLeft maxRight totalWidth currentLeft space |
-
- self selectedItems size > 2
- ifFalse: [^ self].
-
- minLeft := self selectedItems anyOne left.
- maxRight := self selectedItems anyOne right.
- totalWidth := 0.
- self selectedItems
- do: [:each |
- minLeft := minLeft min: each left.
- maxRight := maxRight max: each right.
- totalWidth := totalWidth + each width].
-
- currentLeft := minLeft.
- space := (maxRight - minLeft - totalWidth / (self selectedItems size - 1)) rounded.
- (self selectedItems
- sorted: [:x :y | x left <= y left])
- do: [:each |
- each left: currentLeft.
- currentLeft := currentLeft + each width + space].
-
- self changed
- !
Item was removed:
- ----- Method: SelectionMorph>>distributeVertically (in category 'halo commands') -----
- distributeVertically
- "Distribute the empty vertical space in a democratic way."
- | minTop maxBottom totalHeight currentTop space |
- self selectedItems size > 2
- ifFalse: [^ self].
-
- minTop := self selectedItems anyOne top.
- maxBottom := self selectedItems anyOne bottom.
- totalHeight := 0.
- self selectedItems
- do: [:each |
- minTop := minTop min: each top.
- maxBottom := maxBottom max: each bottom.
- totalHeight := totalHeight + each height].
-
- currentTop := minTop.
- space := (maxBottom - minTop - totalHeight / (self selectedItems size - 1)) rounded.
- (self selectedItems sorted:[:x :y | x top <= y top])
- do: [:each |
- each top: currentTop.
- currentTop := currentTop + each height + space].
-
- self changed
- !
Item was removed:
- ----- Method: SelectionMorph>>doDup:fromHalo:handle: (in category 'halo commands') -----
- doDup: evt fromHalo: halo handle: dupHandle
-
- selectedItems := self duplicateMorphCollection: selectedItems.
- selectedItems do: [:m | self owner addMorph: m].
- dupDelta isNil
- ifTrue: ["First duplicate operation -- note starting location"
- dupLoc := self position.
- evt hand grabMorph: self.
- halo removeAllHandlesBut: dupHandle]
- ifFalse: ["Subsequent duplicate does not grab, but only moves me and my morphs"
- dupLoc := nil.
- self position: self position + dupDelta]
- !
Item was removed:
- ----- Method: SelectionMorph>>doneExtending (in category 'private') -----
- doneExtending
-
- otherSelection ifNotNil:
- [selectedItems := otherSelection selectedItems , selectedItems.
- otherSelection delete.
- self setOtherSelection: nil].
- self changed.
- self layoutChanged.
- super privateBounds:
- ((Rectangle merging: (selectedItems collect: [:m | m fullBounds]))
- expandBy: 8).
- self changed.
- self addHalo.!
Item was removed:
- ----- Method: SelectionMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- | canvas form1 form2 box |
- super drawOn: aCanvas.
- box := self bounds copy.
- selectedItems do: [:m | box swallow: m fullBounds].
- box := box expandBy: 1.
- canvas := Display defaultCanvasClass extent: box extent depth: 8.
- canvas translateBy: box topLeft negated
- during: [:tempCanvas | selectedItems do: [:m | tempCanvas fullDrawMorph: m]].
- form1 := (Form extent: box extent) copyBits: (0 at 0 extent: box extent) from: canvas form at: 0 at 0 colorMap: (Color maskingMap: 8).
- form2 := Form extent: box extent.
- (0 at 0) fourNeighbors do: [:d | form1 displayOn: form2 at: d rule: Form under].
- form1 displayOn: form2 at: 0 at 0 rule: Form erase.
- aCanvas stencil: form2
- at: box topLeft
- sourceRect: form2 boundingBox
- color: self borderColor
- !
Item was removed:
- ----- Method: SelectionMorph>>duplicate (in category 'halo commands') -----
- duplicate
- "Make a duplicate of the receiver and havbe the hand grab it"
-
- selectedItems := self duplicateMorphCollection: selectedItems.
- selectedItems reverseDo: [:m | (owner ifNil: [self currentWorld]) addMorph: m].
- dupLoc := self position.
- self currentHand grabMorph: self.
- self currentWorld presenter flushPlayerListCache.!
Item was removed:
- ----- Method: SelectionMorph>>extendByHand: (in category 'initialization') -----
- extendByHand: aHand
- "Assumes selection has just been created and added to some pasteUp or world"
- | startPoint handle |
-
- startPoint := self position.
-
- handle := NewHandleMorph new followHand: aHand
- forEachPointDo: [:newPoint |
- | localPt |
- localPt := (self transformFrom: self world) globalPointToLocal: newPoint.
- self bounds: (startPoint rect: localPt)
- ]
- lastPointDo: [:newPoint |
- selectedItems isEmpty
- ifTrue: [self delete]
- ifFalse: [
- selectedItems size = 1
- ifTrue:[self delete. selectedItems anyOne addHalo]
- ifFalse:[self doneExtending]
- ]
- ].
-
- aHand attachMorph: handle.
- handle startStepping.!
Item was removed:
- ----- Method: SelectionMorph>>extent: (in category 'geometry') -----
- extent: newExtent
- "Set the receiver's extent Extend or contract the receiver's selection to encompass morphs within the new extent."
-
- super extent: newExtent.
- self selectSubmorphsOf: (self world ifNil: [^ self])!
Item was removed:
- ----- Method: SelectionMorph>>externalName (in category 'viewer') -----
- externalName
- ^ 'Selected {1} objects' translated format:{self selectedItems size}!
Item was removed:
- ----- Method: SelectionMorph>>fillStyle: (in category 'visual properties') -----
- fillStyle: aColor
- undoProperties ifNil: [undoProperties := selectedItems collect: [:m | m fillStyle]].
- selectedItems do: [:m | m fillStyle: aColor]!
Item was removed:
- ----- Method: SelectionMorph>>fillStyleForItems: (in category 'undo') -----
- fillStyleForItems: fillStyleCollection
-
- selectedItems with: fillStyleCollection do: [:m :c | m fillStyle: c]!
Item was removed:
- ----- Method: SelectionMorph>>hasHalo: (in category 'halos and balloon help') -----
- hasHalo: aBool
- super hasHalo: aBool.
- aBool
- ifFalse: [ (self hasProperty: #deleting) ifFalse: [self delete] ]
- !
Item was removed:
- ----- Method: SelectionMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
- self disableLayout: true.
- self morphicLayerNumber: self class haloLayer + 1.
- selectedItems := OrderedCollection new.
- itemsAlreadySelected := OrderedCollection new.!
Item was removed:
- ----- Method: SelectionMorph>>intoWorld: (in category 'initialization') -----
- intoWorld: aWorld
-
- selectedItems ifNotEmpty: [
- "Restore selected items for #reintroduceIntoWorld:"
- self flag: #ct. "Introduce separate hook for this - #reintroducedIntoWorld:?"
- selectedItems do: [:morph |
- aWorld reintroduceIntoWorld: morph].
- ^ self delete].
- super intoWorld: aWorld.!
Item was removed:
- ----- Method: SelectionMorph>>isSelectionMorph (in category 'testing') -----
- isSelectionMorph
- ^true!
Item was removed:
- ----- Method: SelectionMorph>>justDroppedInto:event: (in category 'dropping/grabbing') -----
- justDroppedInto: newOwner event: evt
- "This message is sent to a dropped morph after it has been dropped on -- and been accepted by -- a drop-sensitive morph"
-
- selectedItems isEmpty ifTrue:
- ["Hand just clicked down to draw out a new selection"
- ^ self extendByHand: evt hand].
- dupLoc ifNotNil: [dupDelta := self position - dupLoc].
- selectedItems reverseDo: [:m |
- WorldState addDeferredUIMessage:
- [m referencePosition: (newOwner localPointToGlobal: m referencePosition).
- newOwner handleDropMorph:
- (DropEvent new setPosition: evt cursorPoint contents: m hand: evt hand)]].
- selectedItems := nil.
- self removeHalo.
- self halo ifNotNil: [ :halo | halo visible: false ].
- self delete.
- evt wasHandled: true!
Item was removed:
- ----- Method: SelectionMorph>>maybeAddCollapseItemTo: (in category 'menus') -----
- maybeAddCollapseItemTo: aMenu
- "... don't "!
Item was removed:
- ----- Method: SelectionMorph>>organizeIntoColumn (in category 'halo commands') -----
- organizeIntoColumn
- "Place my objects in a column-enforcing container"
-
- ((AlignmentMorph inAColumn: (selectedItems sorted: [:x :y | x top < y top])) setNameTo: 'Column'; color: Color orange muchLighter; enableDragNDrop: true; yourself) openInHand
- !
Item was removed:
- ----- Method: SelectionMorph>>organizeIntoRow (in category 'halo commands') -----
- organizeIntoRow
- "Place my objects in a row-enforcing container"
-
- ((AlignmentMorph inARow: (selectedItems sorted: [:x :y | x left < y left])) setNameTo: 'Row'; color: Color orange muchLighter; enableDragNDrop: true; yourself) openInHand
- !
Item was removed:
- ----- Method: SelectionMorph>>preferredDuplicationHandleSelector (in category 'testing') -----
- preferredDuplicationHandleSelector
- "Answer the selector, to be offered as the default in a halo open on me"
-
- ^ #addDupHandle:!
Item was removed:
- ----- Method: SelectionMorph>>privateFullMoveBy: (in category 'private') -----
- privateFullMoveBy: delta
- "Overridden to also move the currently encompassed morphs like they would be my submorphs."
-
- super privateFullMoveBy: delta.
- selectedItems do: [:m | m position: m position + delta].
- !
Item was removed:
- ----- Method: SelectionMorph>>refineUndoTarget:selector:arguments:in: (in category 'undo') -----
- refineUndoTarget: target selector: selector arguments: arguments in: refineBlock
- "Any morph can override this method to refine its undo specification"
- selector == #fillStyle: ifTrue:
- [refineBlock value: target value: #fillStyleForItems: value: {undoProperties}.
- ^ undoProperties := nil].
- selector == #borderColor: ifTrue:
- [refineBlock value: target value: #borderColorForItems: value: {undoProperties}.
- ^ undoProperties := nil].
- selector == #borderWidth: ifTrue:
- [refineBlock value: target value: #borderWidthForItems: value: {undoProperties}.
- ^ undoProperties := nil].
- selector == #undoMove:redo:owner:bounds:predecessor: ifTrue:
- ["This is the biggy. Need to gather parameters for all selected items"
- refineBlock value: target
- value: #undoMove:redo:owner:bounds:predecessor:
- value: {arguments first.
- arguments second.
- selectedItems collect: [:m | m owner].
- selectedItems collect: [:m | m bounds].
- selectedItems collect: [:m | m owner morphPreceding: m]}].
- refineBlock value: target value: selector value: arguments!
Item was removed:
- ----- Method: SelectionMorph>>selectSubmorphsOf: (in category 'private') -----
- selectSubmorphsOf: aMorph
- "Given the receiver's current bounds, select submorphs of the indicated pasteup morph that fall entirely within those bounds. If nobody is within the bounds, delete the receiver."
-
- | newItems removals |
- newItems := aMorph submorphs select:
- [:m | (bounds containsRect: m fullBounds)
- and: [m~~self
- and: [(m isKindOf: HaloMorph) not]]].
- otherSelection ifNil: [^ selectedItems := newItems].
-
- removals := newItems intersection: itemsAlreadySelected.
- otherSelection setSelectedItems: (itemsAlreadySelected copyWithoutAll: removals).
- selectedItems := (newItems copyWithoutAll: removals).
- selectedItems ifEmpty: [self delete]
- !
Item was removed:
- ----- Method: SelectionMorph>>selectedItems (in category 'private') -----
- selectedItems
-
- ^ selectedItems!
Item was removed:
- ----- Method: SelectionMorph>>setOtherSelection: (in category 'private') -----
- setOtherSelection: otherOrNil
- otherSelection := otherOrNil.
- otherOrNil isNil
- ifTrue: [super borderColor: Color blue]
- ifFalse:
- [itemsAlreadySelected := otherSelection selectedItems.
- super borderColor: Color green]!
Item was removed:
- ----- Method: SelectionMorph>>setSelectedItems: (in category 'private') -----
- setSelectedItems: items
-
- selectedItems := items.
- self changed!
Item was removed:
- ----- Method: SelectionMorph>>slideToTrash: (in category 'dropping/grabbing') -----
- slideToTrash: evt
- self delete.
- "selectedItems do: [:m | m slideToTrash: evt]"!
Item was removed:
- ----- Method: SelectionMorph>>undoMove:redo:owner:bounds:predecessor: (in category 'undo') -----
- undoMove: cmd redo: redo owner: oldOwners bounds: oldBoundses predecessor: oldPredecessors
- "Handle undo and redo of move commands in morphic"
-
- | item |
- redo
- ifFalse:
- ["undo sets up the redo state first"
-
- cmd
- redoTarget: self
- selector: #undoMove:redo:owner:bounds:predecessor:
- arguments: {
- cmd.
- true.
- selectedItems collect: [:m | m owner].
- selectedItems collect: [:m | m bounds].
- selectedItems collect: [:m | m owner morphPreceding: m]}].
- 1 to: selectedItems size do:
- [:i |
- item := selectedItems at: i.
- (oldOwners at: i) ifNotNil:
- [(oldPredecessors at: i) ifNil: [(oldOwners at: i) addMorphFront: item]
- ifNotNil: [(oldOwners at: i) addMorph: item after: (oldPredecessors at: i)]].
- item bounds: (oldBoundses at: i).
- item isSystemWindow ifTrue: [item beKeyWindow]]!
Item was removed:
- ----- Method: SelectionMorph>>wantsToBeTopmost (in category 'accessing') -----
- wantsToBeTopmost
- "Answer if the receiver want to be one of the topmost objects in
- its owner"
- ^ true!
Item was removed:
- ----- Method: SequenceableCollection>>asCubic (in category '*Morphic-NewCurves-cubic support') -----
- asCubic
- "Convert this point array to a Cubic object"
- self
- assert: [self size = 4].
- self
- assert: [self
- allSatisfy: [:each | each isPoint]].
- ^ Cubic withAll: self!
Item was removed:
- ----- Method: SequenceableCollection>>assertSlopesWith:from:to: (in category '*Morphic-NewCurves-cubic support') -----
- assertSlopesWith: knots from: start to: end
- "
- We trust everything has been checked.
- The following assertions should hold at this point: "
-
- self assert: [ self size = knots size ] .
- "Sizes must be consistent."
- self assert: [ end > start].
- "There must be at least one slope to clamp."
- self assert: [ 0 < start and: [start <= knots size] ].
- "The clamped slope may be the last one."
- self assert: [ end <= knots size + start ] .
- "We can wrap. There may be only one known slope."
- "xxx self assert: [ end = knots size + start ifTrue: [ (self at: start) notNil ] ] . xxx"
- "xxx If we overlap slope must be known. xxx"
- { start . end }
- do: [ :index |
- | slope |
- slope := (self at: index ).
- self assert: [ slope isNil
- or: [ slope isNumber
- or: [ slope isPoint ] ] ] ] .
- "And a known and reasonalble value or nil."
- ^true
- !
Item was removed:
- ----- Method: SequenceableCollection>>changeInSlopes: (in category '*Morphic-NewCurves-cubic support') -----
- changeInSlopes: slopes
- "A message to knots of a spline. Returns an array with the 3rd cubic coeff."
- "The last nth item is correct iff this is a closed cubic.
- Presumably that is the only time we care.
- We always return the same sized array as self."
- | n slopeChanges |
- n := self size.
- n = slopes size
- ifFalse: [^ self error: 'vertices and slopes differ in number'].
- slopeChanges := Array new: n.
- (1 to: n)
- do: [:i | slopeChanges at: i put: (self atWrap: i + 1)
- - (self at: i) * 3 - ((slopes at: i)
- * 2)
- - (slopes atWrap: i + 1)].
-
- ^ slopeChanges!
Item was removed:
- ----- Method: SequenceableCollection>>changeOfChangesInSlopes: (in category '*Morphic-NewCurves-cubic support') -----
- changeOfChangesInSlopes: slopes
- "A message to knots of a spline. Returns an array with the 4rd
- cubic coeff."
- "The last nth item is correct iff this is a closed cubic.
- Presumably that is the only time we care.
- We always return the same sized array as self."
- | n changes |
- n := self size.
- n = slopes size
- ifFalse: [^ self error: 'vertices and slopes differ in number'].
- changes := Array new: n.
- 1 to: n do: [ :i |
- changes at: i put: (self at: i)
- - (self atWrap: i + 1) * 2
- + (slopes at: i)
- + (slopes atWrap: i + 1) ].
- ^ changes!
Item was removed:
- ----- Method: SequenceableCollection>>closedCubicSlopes (in category '*Morphic-NewCurves-cubic support') -----
- closedCubicSlopes
- "Sent to knots returns the slopes of a closed cubic spline.
- From the same set of java sources as naturalCubic. This is a squeak
- transliteration of the java code."
- "from java code NatCubicClosed extends NatCubic
- solves for the set of equations for all knots:
- b1+4*b2+b3=3*(a3-a1)
- where a1 is (knots atWrap: index + 1) etc.
- and the b's are the slopes .
-
- by decomposing the matrix into upper triangular and lower matrices
- and then back sustitution. See Spath 'Spline Algorithms for Curves
- and Surfaces' pp 19--21. The D[i] are the derivatives at the knots.
- "
-
- | v w x y z n1 D F G H |
- n1 := self size.
- n1 < 3
- ifTrue: [self error: 'Less than 3 points makes a poor curve'].
- v := Array new: n1.
- w := Array new: n1.
- y := Array new: n1.
-
- D := Array new: n1.
- x := self.
- z := 1.0 / 4.0.
- v at: 2 put: z.
- w at: 2 put: z.
- y at: 1 put: z * 3.0 * ((x at: 2)
- - (x at: n1)).
- H := 4.0.
- F := 3 * ((x at: 1)
- - (x at: n1 - 1)).
- G := 1.
- 2 to: n1 - 1
- do: [:k |
- z := 1.0 / (4.0
- - (v at: k)).
- v at: k + 1 put: z.
- w at: k + 1 put: z negated
- * (w at: k).
- y at: k put: z * (3.0 * ((x at: k + 1)
- - (x at: k - 1))
- - (y at: k - 1)).
- H := H - (G
- * (w at: k)).
- F := F - (G
- * (y at: k - 1)).
- G := (v at: k) negated * G].
- H := H - (G + 1 * ((v at: n1)
- + (w at: n1))).
- y at: n1 put: F - (G + 1
- * (y at: n1 - 1)).
- D at: n1 put: (y at: n1)
- / H.
- D at: n1 - 1 put: (y at: n1 - 1)
- - ((v at: n1)
- + (w at: n1)
- * (D at: n1)).
- n1 - 2 to: 1 by: -1 do: [ :k |
- D at: k put:
- (y at: k)
- - ((v at: k + 1)
- * (D at: k + 1)) - ((w at: k + 1)
- * (D at: n1))].
- ^ D .!
Item was removed:
- ----- Method: SequenceableCollection>>closedCubicSlopes: (in category '*Morphic-NewCurves-cubic support') -----
- closedCubicSlopes: clampedSlopes
- "Sent to knots returns a copy of clampedSlopes with the values of the undefined (nil) slopes filled in.
- "
- " clampedSlopes must be the same size as knots)"
-
- "/* Between known slopes we solve the equation for knots with end conditions:
- 4*b1+b2 = 3(a2 - a0) - b0
- bN2+4*bN1 = 3*(aN-aN2) - bN
- and inbetween:
- b2+4*b3+b4=3*(a4-a2)
- where a2 is (knots atWrap: index + 1) etc.
- and the b's are the slopes .
- N is the last index (knots size)
- N1 is N-1.
-
- by using row operations to convert the matrix to upper
- triangular and then back substitution.
- "
- | slopes tripleKnots list |
- (list := clampedSlopes closedFillinList) = { 0 to: self size } ifTrue: [ ^ self closedCubicSlopes ] .
- "Special case all unknown."
-
- tripleKnots := self * 3.0 .
- " Premultiply and convert numbers or point coords to Floats "
- slopes := clampedSlopes copy. "slopes contents will be modified."
-
- list do: [ :r | slopes slopesWith: tripleKnots from: r first to: r last ] .
-
- ^ slopes!
Item was removed:
- ----- Method: SequenceableCollection>>closedFillinList (in category '*Morphic-NewCurves-cubic support') -----
- closedFillinList
- "Answers a list of ranges between which values are undertermined.
- Reciever is a list that combines known values and nil entries for
- undetermined values.
- Answer a list of ranges. Each range starts and ends with a known
- value.
- The range inbetween the known values are nil. The ranges start and
- ends may overlap.
- Each nil element in the list appears in exactly one range.
- If the list starts or ends with nil the last range will wrap around to the
- next known value. There may be only one known value in the list but
- there must be atleast one know value.
-
- (self allsatisfy: [ :e | e isNil ] ) ifTrue: [ self error: 'list must contain at
- least one known value' ]
- "
- | changes n |
- changes := self nilTransitions .
- changes isEmpty ifTrue: [ ^ { 0 to: self size } "Special case. All unknowns." ] .
-
- changes = #(1) ifTrue: [ ^ #() "Special case. no unknowns." ] .
- changes = { n := self size } ifTrue: [ ^ { n to: n + n } ] .
- "Special case. Only last element known."
-
- changes size even ifTrue:
- [changes add: self size
- + (changes at: 1)]
- ifFalse: [
- changes first = 1 ifFalse: [ changes add: self size + 1;
- add: self size + changes first ]
-
- ].
- ^ changes allButFirst pairsCollect: [ :s :e | ( s - 1 to: e ) ] .
-
- !
Item was removed:
- ----- Method: SequenceableCollection>>cubicPointPolynomialAt: (in category '*Morphic-NewCurves-cubic support') -----
- cubicPointPolynomialAt: vIndex
- "From curve information assemble a 4-array of points representing the coefficents for curve segment between to points. Beginning point is first point in array endpoint is the pointSum of the array. Meant to be sent to newcurves idea of curve coefficents."
-
- | result |
- result := Cubic new: 4.
- 1 to: 4 do: [ :i |
- result at: i put: ((self at: i) at: vIndex) @ ((self at: 4 + i) at: vIndex) ].
- ^result!
Item was removed:
- ----- Method: SequenceableCollection>>explorerContents (in category '*Morphic-Explorer') -----
- explorerContents
-
- ^Array new: self size streamContents: [ :stream |
- 1 to: self size do: [ :index |
- stream nextPut: (
- ObjectExplorerWrapper
- with: (self at: index)
- name: index printString
- model: self) ] ]!
Item was removed:
- ----- Method: SequenceableCollection>>flipRotated: (in category '*Morphic-fliprotate') -----
- flipRotated: flipIndex
- "Answer a copy of the receiver with element order indicated by
- flipIndex."
- "Examples:"
- "'frog' flipRotated: 1"
- "[ :c | (1 to: c size * 2) collect:
- [ :i | c flipRotated: i ]
- ] value: 'frog'."
- "Lsb of flipIndex indicates whether list is reversed"
- "The flipIndex // 2 gives how much to rotate by after reversing"
- "A good way to think of this is a piece of pie in a pie plate being flip
- over its leading edge successively."
- "flipIndex > 2 * n are allowed to make it possible to store an array of
- indexes in an integer."
- | n result src twist |
- n := self size.
- flipIndex \\ (n * 2) = 0
- ifTrue: [^ self].
- "allow for doing nothing"
- result := self species new: n.
- twist := flipIndex // 2 \\ n.
- src := 0.
- (flipIndex even
- ifTrue: [1 + twist to: n + twist]
- ifFalse: [n - 1 - twist to: twist negated by: -1])
- do: [:i | result
- at: (src := src + 1)
- put: (self atWrap: i)].
- ^ result!
Item was removed:
- ----- Method: SequenceableCollection>>naturalCubicSlopes (in category '*Morphic-NewCurves-cubic support') -----
- naturalCubicSlopes
- "Sent to knots returns the slopes of a natural cubic curve fit.
- This is a direct squeak
- transliteration of the java code."
- " public class NatCubic extends ControlCurve
-
- /* We solve the equation for knots with end conditions:
- 2*b1+b2 = 3(a1 - a0)
- bN1+2*bN = 3*(aN-aN1)
- and inbetween:
- b2+4*b3+b4=3*(a4-a2)
- where a2 is (knots atWrap: index + 1) etc.
- and the b's are the slopes .
- N is the last index (knots size)
- N1 is N-1.
-
- by using row operations to convert the matrix to upper
- triangular
- and then back sustitution. The D[i] are the derivatives at the
- knots.
- "
- | x gamma delta D n1 |
- n1 := self size.
- n1 < 3
- ifTrue: [self error: 'Less than 3 points makes a poor curve'].
- x := self.
- gamma := Array new: n1.
- delta := Array new: n1.
-
- D := Array new: n1.
- gamma at: 1 put: 1.0 / 2.0.
- (2 to: n1 - 1)
- do: [:i | gamma at: i put: 1.0 / (4.0
- - (gamma at: i - 1))].
- gamma at: n1 put: 1.0 / (2.0
- - (gamma at: n1 - 1)).
- delta at: 1 put: 3.0 * ((x at: 2)
- - (x at: 1))
- * (gamma at: 1).
- (2 to: n1 - 1)
- do: [:i | delta at: i put: 3.0 * ((x at: i + 1)
- - (x at: i - 1))
- - (delta at: i - 1)
- * (gamma at: i)].
- delta at: n1 put: 3.0 * ((x at: n1)
- - (x at: n1 - 1))
- - (delta at: n1 - 1)
- * (gamma at: n1).
- D
- at: n1
- put: (delta at: n1).
- (1 to: n1 - 1)
- reverseDo: [:i | D at: i put: (delta at: i)
- - ((gamma at: i)
- * (D at: i + 1))].
- ^ D!
Item was removed:
- ----- Method: SequenceableCollection>>naturalCubicSlopes: (in category '*Morphic-NewCurves-cubic support') -----
- naturalCubicSlopes: clampedSlopes
- "Sent to knots returns a copy of clampedSlopes with the values of the undefined (nil) slopes filled in.
- "
- " clampedSlopes must be the same size as knots)"
-
- "/* Between known slopes we solve the equation for knots with end conditions:
- 4*b1+b2 = 3(a2 - a0) - b0
- bN2+4*bN1 = 3*(aN-aN2) - bN
- and inbetween:
- b2+4*b3+b4=3*(a4-a2)
- where a2 is (knots atWrap: index + 1) etc.
- and the b's are the slopes .
- N is the last index (knots size)
- N1 is N-1.
-
- by using row operations to convert the matrix to upper
- triangular and then back substitution.
- "
- | slopes tripleKnots |
- tripleKnots := self * 3.0 .
- " Premultiply and convert numbers or point coords to Floats "
- slopes := clampedSlopes copy. "slopes will be modified."
- clampedSlopes naturalFillinList do: [ :r | slopes slopesWith: tripleKnots from: r first to: r last ] .
-
- ^ slopes!
Item was removed:
- ----- Method: SequenceableCollection>>naturalFillinList (in category '*Morphic-NewCurves-cubic support') -----
- naturalFillinList
- "Return a list of fillin ranges to be used to calculate natural or clamped slopes.
- Note that this list is slightly different in mission from the closedFillinList"
- "Answers a list of ranges between which value are undertermined.
- Reciever is a list that combines known values and nil entries for
- undetermined values.
- Answer a list of ranges. Each range starts and ends with a known value.
- With the exception of the first and last slopes on the list which may be unknown.
- If no slopes are known then the only range is the whole list.
- If all slopes are known then the fillin list is empty.
- The range inbetween the known values are nil. The ranges start and
- ends may overlap if the slope at the overlap is known.
- Each nil element in the list appears in exactly one range.
- "
- | changes |
- changes := self nilTransitions .
- changes isEmpty ifTrue: [ ^ { 1 to: self size } "Special case all unknown." ] .
-
- changes = #(1) ifTrue: [ ^ #() "Special case. no unknowns." ] .
-
- changes size even
- ifTrue: [changes add: self size ] . "Last slope is unknown"
- changes first = 1
- ifTrue: [ ^ changes allButFirst pairsCollect: [ :s :e | ( s - 1 to: e ) ] ] .
-
- "Otherwise first slope is unknown."
-
-
- ^ { 1 to: changes first } ,
- (changes allButFirst pairsCollect: [ :s :e | ( ( s - 1) to: e ) ])
-
- !
Item was removed:
- ----- Method: SequenceableCollection>>nilTransitions (in category '*Morphic-NewCurves-cubic support') -----
- nilTransitions
- "Return an OrderedCollection of transition indexes.
- Indexes represent where the list elements transitions
- from nil to nonNil
- or from nonNil to nil.
- 1 is an index in the list iff the first element is nonNil. "
-
- | changes nilSkip |
-
- changes := OrderedCollection new.
- nilSkip := true .
-
- 1 to: self size
- do: [:i | (self atWrap: i) isNil == nilSkip
- ifFalse: [changes add: i.
- nilSkip := nilSkip not]].
-
- ^ changes !
Item was removed:
- ----- Method: SequenceableCollection>>segmentedSlopes (in category '*Morphic-NewCurves-cubic support') -----
- segmentedSlopes
- "For a collection of floats. Returns the slopes for straight
- segments between vertices."
- "last slope closes the polygon. Always return same size as
- self. "
- ^ self
- withIndexCollect: [:x :i | (self atWrap: i + 1)
- - x]!
Item was removed:
- ----- Method: SequenceableCollection>>slopesWith:from:to: (in category '*Morphic-NewCurves-cubic support') -----
- slopesWith: tripleKnots from: start to: end
- "Sent to modifiable list of slopes. Fills in the slope values between start
- and end. Start and end slopes can be either clamped or nil.
- If nil the natural slope for that value will be filled in.
- We expect that the parameters meets the assertions in
- self assertSlopesWith: knots from: start to: end."
- "
-
- /* We solve the equation for knots with end conditions either known or unknown:
- 4*b1+b2 = 3*(a2 - a0) - b0 b0 known
- Or
- 2*b0+b1 = 3*(a1 - a0) . b0 == nil
-
- bN2+4*bN1 = 3*(aN-aN2)-bN bN known
- Or
- bN1+2*bN = 3*(aN-aN1) bN == nil
- .
- b0, bN are starting and ending slopes.
-
- We now handle the special closed cubic case where a0 == aN ( i.e. N = knots size )
- and b0 == bN == nil .
-
-
-
-
- and inbetween:
- b2+4*b3+b4=3*(a4-a2)
- where a2 is (knots atWrap: index + 1) etc.
- and the b's are the slopes .
- by using row operations to convert the matrix to upper
- triangular and then back substitution.
- "
- | gamma delta n range isOpenRange |
- n := self size.
- gamma := Array new: n.
- delta := Array new: n.
- isOpenRange := end < (start + self size) .
- (self at: start)
- ifNotNil: [
- gamma at: start put: 0.0.
- delta
- at: start
- put: (self at: start).
- range := ( start + 1 to: end - 1 ) .
- ] " clamped initial conditions"
- ifNil: [
- isOpenRange
- ifTrue:
- [gamma at: start put: 2.0 reciprocal.
- delta
- at: start
- put: ((tripleKnots atWrap: start + 1)
- - tripleKnots at: start ) * (gamma at: start) .
- range := ( start to: end - 1 ) . ] "natural initial conditions "
- ifFalse:
- [ gamma at: start put: 4.0 reciprocal.
- delta
- at: start
- put: ((tripleKnots atWrap: start + 1)
- - tripleKnots atWrap: start - 1 ) * (gamma at: start) .
- range := ( start + 1 to: end - 1 ) .
- ] "closed initial conditions "
- ] .
- (start + 1 to: end - 1)
- do: [:i | gamma atWrap: i put: 1.0 / (4.0
- - (gamma atWrap: i - 1))].
- (start + 1 to: end - 1)
- do: [:i | delta atWrap: i put: ((tripleKnots atWrap: i + 1)
- - (tripleKnots atWrap: i - 1))
- - (delta atWrap: i - 1)
- * (gamma atWrap: i)].
- (self atWrap: end)
- ifNil: [ isOpenRange
- ifTrue: [
- gamma atWrap: end put: 1.0 / (2.0
- - (gamma atWrap: end - 1 )).
- delta
- atWrap: end
- put: ((tripleKnots atWrap: end )
- - tripleKnots atWrap: end - 1 )
- - (delta at: end - 1 ) * (gamma atWrap: end)] "natural end conditions"
- ifFalse: [
- gamma atWrap: end put: 1.0 / (4.0
- - (gamma atWrap: end - 1 )).
- delta
- atWrap: end
- put: ((tripleKnots atWrap: end + 1 )
- - tripleKnots atWrap: end - 1 )
- - (delta at: end - 1 ) * (gamma atWrap: end)] "closed end conditions"
- .
- self atWrap: end put: (delta atWrap: end ) .
- ]
- ifNotNil: [
- gamma atWrap: end put: 0.0 .
- delta
- atWrap: end
- put: (self atWrap: end) .
-
- ] "clamped end conditions" .
-
- range
- reverseDo: [:i | self atWrap: i put:
- (delta atWrap: i)
- - ((gamma atWrap: i)
- * (self atWrap: i + 1)) ] .
- " reciever now contains the filled in slopes."
- ^ self !
Item was removed:
- ----- Method: SequenceableCollection>>transitions (in category '*Morphic-NewCurves-cubic support') -----
- transitions
- "Sent to a list of boolean values.
- Return an OrderedCollection of transition indexes.
- Indexes represent where the list elements transitions
- from true to false
- or from false to true.
- 1 is an index in the list iff the first element is false. "
-
- | changes boolSkip |
-
- changes := OrderedCollection new.
- boolSkip := true .
-
- self
- withIndexDo: [:truth :i | truth == boolSkip
- ifFalse: [changes add: i.
- boolSkip := boolSkip not]].
-
- ^ changes !
Item was removed:
- ----- Method: SequenceableCollection>>transitions: (in category '*Morphic-NewCurves-cubic support') -----
- transitions: aSelectBlock
- "Sent to a list. Select block returns a boolean
- Return an OrderedCollection of transition indexes.
- Indexes represent where the list elements transitions
- from true to false
- or from false to true.
- 1 is an index in the list iff the first element tests false. "
-
- | changes boolSkip |
-
- changes := OrderedCollection new.
- boolSkip := true .
-
- self withIndexDo:
- [:e :i | (aSelectBlock value: e ) == boolSkip
- ifFalse: [changes add: i.
- boolSkip := boolSkip not]].
-
- ^ changes !
Item was removed:
- ----- Method: Set>>explorerContents (in category '*Morphic-Explorer') -----
- explorerContents
-
- ^Array new: self size streamContents: [ :stream |
- self do: [ :each |
- stream nextPut: (
- ObjectExplorerWrapper
- with: each
- name: (stream position + 1) printString
- model: self) ] ]!
Item was removed:
- ----- Method: Set>>hasContentsInExplorer (in category '*Morphic-Explorer') -----
- hasContentsInExplorer
-
- ^self notEmpty!
Item was removed:
- ColorMappingCanvas subclass: #ShadowDrawingCanvas
- instanceVariableNames: 'shadowColor'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Support'!
Item was removed:
- ----- Method: ShadowDrawingCanvas>>image:at:sourceRect:rule: (in category 'private') -----
- image: aForm at: aPoint sourceRect: sourceRect rule: rule
- "Draw the given form. For the 'paint' combination rule use stenciling otherwise simply fill the source rectangle."
- rule = Form paint ifTrue:[
- ^myCanvas
- stencil: aForm
- at: aPoint
- sourceRect: sourceRect
- color: shadowColor
- ] ifFalse:[
- ^myCanvas
- fillRectangle: (sourceRect translateBy: aPoint)
- color: shadowColor
- ].!
Item was removed:
- ----- Method: ShadowDrawingCanvas>>isShadowDrawing (in category 'testing') -----
- isShadowDrawing
- ^true!
Item was removed:
- ----- Method: ShadowDrawingCanvas>>mapColor: (in category 'private') -----
- mapColor: aColor
- aColor isColor ifFalse:[^aColor]. "Should not happen but who knows..."
- ^aColor isTransparent
- ifTrue:[aColor]
- ifFalse:[shadowColor]!
Item was removed:
- ----- Method: ShadowDrawingCanvas>>on: (in category 'initialization') -----
- on: aCanvas
- myCanvas := aCanvas.
- shadowColor := Color black.!
Item was removed:
- ----- Method: ShadowDrawingCanvas>>shadowColor (in category 'accessing') -----
- shadowColor
- ^shadowColor!
Item was removed:
- ----- Method: ShadowDrawingCanvas>>shadowColor: (in category 'accessing') -----
- shadowColor: aColor
- shadowColor := aColor!
Item was removed:
- BorderStyle subclass: #SimpleBorder
- instanceVariableNames: 'baseColor color width'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Borders'!
-
- !SimpleBorder commentStamp: 'kfr 10/27/2003 10:17' prior: 0!
- see BorderedMorph!
Item was removed:
- ----- Method: SimpleBorder>>baseColor (in category 'accessing') -----
- baseColor
-
- ^baseColor!
Item was removed:
- ----- Method: SimpleBorder>>baseColor: (in category 'accessing') -----
- baseColor: aColor
-
- baseColor = aColor ifTrue:[^self].
- baseColor := aColor ifNil: [Color transparent].
- self color: baseColor "#color: will do #releaseCachedState"!
Item was removed:
- ----- Method: SimpleBorder>>bottomRightColor (in category 'accessing') -----
- bottomRightColor
- ^color!
Item was removed:
- ----- Method: SimpleBorder>>color (in category 'accessing') -----
- color
-
- ^color!
Item was removed:
- ----- Method: SimpleBorder>>color: (in category 'accessing') -----
- color: aColor
- color = aColor ifTrue:[^self].
- color := aColor.
- self releaseCachedState.!
Item was removed:
- ----- Method: SimpleBorder>>drawLineFrom:to:on: (in category 'drawing') -----
- drawLineFrom: startPoint to: stopPoint on: aCanvas
- | lineColor |
- lineColor := (stopPoint truncated quadrantOf: startPoint truncated) > 2
- ifTrue: [self topLeftColor]
- ifFalse: [self bottomRightColor].
- aCanvas
- line: startPoint
- to: stopPoint
- width: self width
- color: lineColor!
Item was removed:
- ----- Method: SimpleBorder>>frameRectangle:on: (in category 'drawing') -----
- frameRectangle: aRectangle on: aCanvas
- aCanvas frameAndFillRectangle: aRectangle
- fillColor: Color transparent
- borderWidth: self width
- topLeftColor: self topLeftColor
- bottomRightColor: self bottomRightColor.!
Item was removed:
- ----- Method: SimpleBorder>>initialize (in category 'initialize-release') -----
- initialize
-
- super initialize.
-
- width := 0.
- baseColor := color := Color transparent!
Item was removed:
- ----- Method: SimpleBorder>>style (in category 'accessing') -----
- style
- ^#simple!
Item was removed:
- ----- Method: SimpleBorder>>topLeftColor (in category 'accessing') -----
- topLeftColor
- ^color!
Item was removed:
- ----- Method: SimpleBorder>>width (in category 'accessing') -----
- width
-
- ^width!
Item was removed:
- ----- Method: SimpleBorder>>width: (in category 'accessing') -----
- width: aNumber
- width = aNumber ifTrue:[^self].
- width := aNumber truncated max: (width isPoint ifTrue:[0 at 0] ifFalse:[0]).
- self releaseCachedState.!
Item was removed:
- SimpleButtonMorph subclass: #SimpleButtonDelayedMenuMorph
- instanceVariableNames: 'didMenu'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
Item was removed:
- ----- Method: SimpleButtonDelayedMenuMorph>>handlesMouseStillDown: (in category 'event handling') -----
- handlesMouseStillDown: evt
-
- ^true!
Item was removed:
- ----- Method: SimpleButtonDelayedMenuMorph>>mouseDown: (in category 'event handling') -----
- mouseDown: evt
-
- didMenu := nil.
- super mouseDown: evt.
- !
Item was removed:
- ----- Method: SimpleButtonDelayedMenuMorph>>mouseStillDown: (in category 'event handling') -----
- mouseStillDown: evt
- (mouseDownTime isNil or: [(Time millisecondClockValue - mouseDownTime) abs < 1000]) ifTrue: [
- ^super mouseStillDown: evt
- ].
- didMenu ifNotNil: [^super mouseStillDown: evt].
- self color: oldColor. "in case menu never returns"
- didMenu := target showMenuFor: actionSelector event: evt.
- !
Item was removed:
- ----- Method: SimpleButtonDelayedMenuMorph>>mouseUp: (in category 'event handling') -----
- mouseUp: evt
-
- didMenu == true ifFalse: [^super mouseUp: evt].
- oldColor ifNotNil: [
- self color: oldColor.
- oldColor := nil
- ].!
Item was removed:
- RectangleMorph subclass: #SimpleButtonMorph
- instanceVariableNames: 'target actionSelector arguments actWhen oldColor mouseDownTime'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !SimpleButtonMorph commentStamp: 'ul 7/22/2010 04:30' prior: 0!
- I am labeled, rectangular morph which allows the user to click me. I can be configured to send my "target" the message "actionSelector" with "arguments" when I am clicked. I may have a label, implemented as a StringMorph.
-
- Example:
-
- SimpleButtonMorph new
- target: Beeper;
- label: 'Beep!!';
- actionSelector: #beep;
- openInWorld
-
- Structure:
- instance var Type Description
- target Object The Object to notify upon a click
- actionSelector Symbol The message to send to Target (#messageName)
- arguments Array Arguments to send with #actionSelection (optional)
- actWhen Symbol When to take action: may be #buttonUp (default), #buttonDown,
- #whilePressed, or #startDrag
- oldColor Color Used to restore color after click
-
- Another example: a button which quits the image without saving it.
-
- SimpleButtonMorph new
- target: Smalltalk;
- label: 'quit';
- actionSelector: #snapshot:andQuit:;
- arguments: (Array with: false with: true);
- openInWorld
-
- !
Item was removed:
- ----- Method: SimpleButtonMorph class>>authoringPrototype (in category 'scripting') -----
- authoringPrototype
- ^ super authoringPrototype label: 'Button'!
Item was removed:
- ----- Method: SimpleButtonMorph class>>defaultNameStemForInstances (in category 'printing') -----
- defaultNameStemForInstances
- ^ self = SimpleButtonMorph
- ifTrue: ['Button' translatedNoop]
- ifFalse: [^ super defaultNameStemForInstances]!
Item was removed:
- ----- Method: SimpleButtonMorph class>>newWithLabel: (in category 'as yet unclassified') -----
- newWithLabel: labelString
-
- ^ self basicNew initializeWithLabel: labelString
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>actWhen (in category 'submorphs - add/remove') -----
- actWhen
- "acceptable symbols: #buttonDown, #buttonUp, and #whilePressed"
-
- ^ actWhen!
Item was removed:
- ----- Method: SimpleButtonMorph>>actWhen: (in category 'submorphs - add/remove') -----
- actWhen: condition
- "Accepts symbols: #buttonDown, #buttonUp, and #whilePressed, #startDrag"
- actWhen := condition.
- actWhen == #startDrag
- ifFalse: [self on: #startDrag send: nil to: nil ]
- ifTrue:[self on: #startDrag send: #doButtonAction to: self].!
Item was removed:
- ----- Method: SimpleButtonMorph>>actionSelector (in category 'accessing') -----
- actionSelector
-
- ^ actionSelector
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>actionSelector: (in category 'accessing') -----
- actionSelector: aSymbolOrString
-
- (nil = aSymbolOrString or:
- ['nil' = aSymbolOrString or:
- [aSymbolOrString isEmpty]])
- ifTrue: [^ actionSelector := nil].
-
- actionSelector := aSymbolOrString asSymbol.
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>addCustomMenuItems:hand: (in category 'menu') -----
- addCustomMenuItems: aCustomMenu hand: aHandMorph
-
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- self addLabelItemsTo: aCustomMenu hand: aHandMorph.
- (target isKindOf: BookMorph)
- ifTrue:
- [aCustomMenu add: 'set page sound' translated action: #setPageSound:.
- aCustomMenu add: 'set page visual' translated action: #setPageVisual:]
- ifFalse:
- [
- aCustomMenu add: 'change action selector' translated action: #setActionSelector.
- aCustomMenu add: 'change arguments' translated action: #setArguments.
- aCustomMenu add: 'change when to act' translated action: #setActWhen.
- aCustomMenu add: 'set target' translated action: #sightTargets:.
- target ifNotNil: [aCustomMenu add: 'clear target' translated action: #clearTarget]].
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>addLabelItemsTo:hand: (in category 'menu') -----
- addLabelItemsTo: aCustomMenu hand: aHandMorph
- aCustomMenu add: 'change label' translated action: #setLabel!
Item was removed:
- ----- Method: SimpleButtonMorph>>addTargetingMenuItems:hand: (in category 'menu') -----
- addTargetingMenuItems: aCustomMenu hand: aHandMorph
- "Add targeting menu items"
- aCustomMenu addLine.
-
- aCustomMenu add: 'set target' translated action: #targetWith:.
- aCustomMenu add: 'sight target' translated action: #sightTargets:.
- target
- ifNotNil: [aCustomMenu add: 'clear target' translated action: #clearTarget]!
Item was removed:
- ----- Method: SimpleButtonMorph>>arguments (in category 'accessing') -----
- arguments
-
- ^ arguments
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>arguments: (in category 'accessing') -----
- arguments: aCollection
-
- arguments := aCollection asArray copy.
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>browseImplementationOfActionSelector (in category 'debug menu') -----
- browseImplementationOfActionSelector
-
- ToolSet browseMethod: (self target class lookupSelector: self actionSelector).!
Item was removed:
- ----- Method: SimpleButtonMorph>>buildDebugMenu: (in category 'debug menu') -----
- buildDebugMenu: aHandMorph
-
- | aMenu |
- aMenu := super buildDebugMenu: aHandMorph.
- aMenu addLine.
- aMenu add: 'browse action code' translated target: self action: #browseImplementationOfActionSelector.
- aMenu add: 'debug action invocation' translated target: self action: #debugAction.
- ^ aMenu!
Item was removed:
- ----- Method: SimpleButtonMorph>>clearTarget (in category 'menu') -----
- clearTarget
-
- target := nil.
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>debugAction (in category 'debug menu') -----
- debugAction
-
- (Process
- forBlock: [self doButtonAction]
- runUntil: [:context | context selector = self actionSelector])
- debugWithTitle: ('Debug button action "{1}" in model "{2}"' translated format: {self label. self target printString}).!
Item was removed:
- ----- Method: SimpleButtonMorph>>doButtonAction (in category 'button') -----
- doButtonAction
- "Perform the action of this button. Subclasses may override this method. The default behavior is to send the button's actionSelector to its target object with its arguments."
-
- (target notNil and: [actionSelector notNil])
- ifTrue:
- [target perform: actionSelector withArguments: arguments].
- actWhen == #startDrag ifTrue: [oldColor ifNotNil: [self color: oldColor]]!
Item was removed:
- ----- Method: SimpleButtonMorph>>extent: (in category 'geometry') -----
- extent: newExtent
- | label |
- super extent: newExtent.
- submorphs size = 1 ifTrue:
- ["keep the label centered"
- "NOTE: may want to test more that it IS a label..."
- label := self firstSubmorph.
- label position: self center - (label extent // 2)]!
Item was removed:
- ----- Method: SimpleButtonMorph>>fitContents (in category 'layout') -----
- fitContents
- | aMorph aCenter |
- aCenter := self center.
- self hasSubmorphs ifFalse: [^self].
- aMorph := self firstSubmorph.
- self extent: aMorph extent + (self borderWidth + 6).
- self center: aCenter.
- aMorph position: aCenter - (aMorph extent // 2)!
Item was removed:
- ----- Method: SimpleButtonMorph>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: evt
- ^ self isPartsDonor not
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>handlesMouseStillDown: (in category 'event handling') -----
- handlesMouseStillDown: evt
- ^actWhen == #whilePressed!
Item was removed:
- ----- Method: SimpleButtonMorph>>initialize (in category 'initialization') -----
- initialize
-
- self initializeAllButLabel; setDefaultLabel!
Item was removed:
- ----- Method: SimpleButtonMorph>>initializeAllButLabel (in category 'initialization') -----
- initializeAllButLabel
- super initialize.
- self
- borderWidth: 1 ;
- color: (Color r: 0.4 g: 0.8 b: 0.6) ;
- borderColor: self color darker ;
- borderStyle: BorderStyle thinGray.
- target := nil.
- actionSelector := #flash.
- arguments := Array empty.
- actWhen := #buttonUp!
Item was removed:
- ----- Method: SimpleButtonMorph>>initializeWithLabel: (in category 'initialization') -----
- initializeWithLabel: labelString
-
- self initializeAllButLabel; label: labelString
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>isButton (in category 'classification') -----
- isButton
-
- ^ true!
Item was removed:
- ----- Method: SimpleButtonMorph>>label (in category 'accessing') -----
- label
-
- | s |
- s := ''.
- self allMorphsDo: [:m | (m isKindOf: StringMorph) ifTrue: [s := m contents]].
- ^ s!
Item was removed:
- ----- Method: SimpleButtonMorph>>label: (in category 'accessing') -----
- label: aString
-
- | oldLabel m |
- (oldLabel := self findA: StringMorph)
- ifNotNil: [oldLabel delete].
- m := StringMorph contents: aString font: TextStyle defaultFont.
- self extent: m extent + (self borderWidth + 6).
- m position: self center - (m extent // 2).
- self addMorph: m.
- m lock!
Item was removed:
- ----- Method: SimpleButtonMorph>>label:font: (in category 'accessing') -----
- label: aString font: aFont
-
- | oldLabel m |
- (oldLabel := self findA: StringMorph)
- ifNotNil: [oldLabel delete].
- m := StringMorph contents: aString font: (aFont ifNil: [Preferences standardButtonFont]).
- self extent: (m width + 6) @ (m height + 6).
- m position: self center - (m extent // 2).
- self addMorph: m.
- m lock
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>labelString: (in category 'accessing') -----
- labelString: aString
-
- | existingLabel |
- (existingLabel := self findA: StringMorph)
- ifNil:
- [self label: aString]
- ifNotNil:
- [existingLabel contents: aString.
- self fitContents]
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>mouseDown: (in category 'event handling') -----
- mouseDown: evt
-
- super mouseDown: evt.
- evt yellowButtonPressed ifTrue: [ ^self ] .
- mouseDownTime := Time millisecondClockValue.
- oldColor := self fillStyle.
- actWhen == #buttonDown
- ifTrue: [ self doButtonAction]
- ifFalse: [ self updateVisualState: evt ].
- self mouseStillDown: evt.!
Item was removed:
- ----- Method: SimpleButtonMorph>>mouseMove: (in category 'event handling') -----
- mouseMove: evt
- actWhen == #buttonDown ifTrue: [^ self].
- self updateVisualState: evt.!
Item was removed:
- ----- Method: SimpleButtonMorph>>mouseStillDown: (in category 'event handling') -----
- mouseStillDown: evt
- actWhen == #whilePressed ifFalse:[^self].
- (self containsPoint: evt cursorPoint) ifTrue:[self doButtonAction].!
Item was removed:
- ----- Method: SimpleButtonMorph>>mouseStillDownStepRate (in category 'events-processing') -----
- mouseStillDownStepRate
- "Answer how often I want the #handleMouseStillDown: stepped"
- ^200!
Item was removed:
- ----- Method: SimpleButtonMorph>>mouseUp: (in category 'event handling') -----
- mouseUp: evt
- super mouseUp: evt.
- oldColor ifNotNil:
- ["if oldColor nil, it signals that mouse had not gone DOWN
- inside me, e.g. because of a cmd-drag; in this case we want
- to avoid triggering the action!!"
- self color: oldColor.
- oldColor := nil.
- (self containsPoint: evt cursorPoint)
- ifTrue: [ actWhen == #buttonUp
- ifTrue: [self doButtonAction] ]
- ifFalse: [ self mouseLeave: evt "This is a balk. Note that we have left." ]].
- self borderStyle style = #inset ifTrue: [self borderRaised].
-
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>objectForDataStream: (in category 'objects from disk') -----
- objectForDataStream: refStrm
-
- ^ super objectForDataStream: refStrm
-
-
- "I am about to be written on an object file. If I send a message to a BookMorph, it would be bad to write that object out. Create and write out a URLMorph instead.
- Feb 2007: It seems unlikely that Squeak Pages will be used in the OLPC image. Don't use this code. Consider removing all code that supports SqueakPages."
- "
- | bb thatPage um stem ind sqPg |
- (actionSelector == #goToPageMorph:fromBookmark:) |
- (actionSelector == #goToPageMorph:) ifFalse: [
- ^ super objectForDataStream: refStrm]. 'normal case'.
-
- target url ifNil: ['Later force target book to get a url.'.
- bb := SimpleButtonMorph new. 'write out a dummy'.
- bb label: self label.
- bb bounds: bounds.
- refStrm replace: self with: bb.
- ^ bb].
-
- (thatPage := arguments first) url ifNil: [
- 'Need to assign a url to a page that will be written later.
- It might have bookmarks too. Don't want to recurse deeply.
- Have that page write out a dummy morph to save its url on the server.'.
- stem := target getStemUrl. 'know it has one'.
- ind := target pages identityIndexOf: thatPage.
- thatPage reserveUrl: stem,(ind printString),'.sp'].
- um := URLMorph newForURL: thatPage url.
- sqPg := thatPage sqkPage clone.
- sqPg contentsMorph: nil.
- um setURL: thatPage url page: sqPg.
- (SqueakPage stemUrl: target url) = (SqueakPage stemUrl: thatPage url)
- ifTrue: [um book: true]
- ifFalse: [um book: target url]. 'remember which book'.
- um privateOwner: owner.
- um bounds: bounds.
- um isBookmark: true; label: self label.
- um borderWidth: borderWidth; borderColor: borderColor.
- um color: color.
- refStrm replace: self with: um.
- ^ um
- "!
Item was removed:
- ----- Method: SimpleButtonMorph>>recolor: (in category 'copying') -----
- recolor: c
- self color: c.
- oldColor := c!
Item was removed:
- ----- Method: SimpleButtonMorph>>setActWhen (in category 'menu') -----
- setActWhen
-
- | selections |
- selections := #(buttonDown buttonUp whilePressed startDrag).
- actWhen := UIManager default
- chooseFrom: (selections collect: [:t | t translated])
- values: selections
- title: 'Choose one of the following conditions' translated.!
Item was removed:
- ----- Method: SimpleButtonMorph>>setActionSelector (in category 'menu') -----
- setActionSelector
-
- | newSel |
- newSel := UIManager default
- request:
- 'Please type the selector to be sent to
- the target when this button is pressed' translated
- initialAnswer: actionSelector.
- newSel isEmpty ifFalse: [self actionSelector: newSel].
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>setArguments (in category 'menu') -----
- setArguments
-
- | s newArgs newArgsArray |
- s := WriteStream on: ''.
- arguments do: [:arg | arg printOn: s. s nextPutAll: '. '].
- newArgs := UIManager default
- request:
- 'Please type the arguments to be sent to the target
- when this button is pressed separated by periods' translated
- initialAnswer: s contents.
- newArgs isEmpty ifFalse: [
- newArgsArray := Compiler evaluate: '{', newArgs, '}' for: self.
- self arguments: newArgsArray].
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>setDefaultLabel (in category 'initialization') -----
- setDefaultLabel
- self label: 'Flash'.
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>setLabel (in category 'menu') -----
- setLabel
-
- | newLabel |
- newLabel := UIManager default
- request: 'Please enter a new label for this button'
- initialAnswer: self label.
- newLabel isEmpty ifFalse: [self labelString: newLabel].
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>setPageSound: (in category 'menu') -----
- setPageSound: event
-
- ^ target menuPageSoundFor: self event: event!
Item was removed:
- ----- Method: SimpleButtonMorph>>setPageVisual: (in category 'menu') -----
- setPageVisual: event
-
- ^ target menuPageVisualFor: self event: event!
Item was removed:
- ----- Method: SimpleButtonMorph>>setTarget (in category 'menu') -----
- setTarget
-
- | newLabel |
- newLabel := UIManager default request: 'Enter an expression that create the target' translated initialAnswer: 'World'.
- newLabel isEmpty
- ifFalse: [self target: (Compiler evaluate: newLabel)]!
Item was removed:
- ----- Method: SimpleButtonMorph>>setTarget: (in category 'menu') -----
- setTarget: evt
- | rootMorphs |
- rootMorphs := self world rootMorphsAt: evt hand targetPoint.
- target := rootMorphs size > 1
- ifTrue: [rootMorphs second]!
Item was removed:
- ----- Method: SimpleButtonMorph>>target (in category 'accessing') -----
- target
-
- ^ target
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>target: (in category 'accessing') -----
- target: anObject
-
- target := anObject
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>updateVisualState: (in category 'visual properties') -----
- updateVisualState: evt
-
- (self containsPoint: evt cursorPoint)
- ifTrue: [
- oldColor ifNotNil: [self color: (oldColor mixed: 1/2 with: Color white)].
- self borderStyle style = #raised ifTrue: [self borderInset]]
- ifFalse: [
- oldColor ifNotNil: [self color: oldColor].
- self borderStyle style = #inset ifTrue: [self borderRaised]].
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>veryDeepFixupWith: (in category 'copying') -----
- veryDeepFixupWith: deepCopier
- "If target and arguments fields were weakly copied, fix them here. If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"
-
- super veryDeepFixupWith: deepCopier.
- target := deepCopier references at: target ifAbsent: [target].
- arguments := arguments collect: [:each |
- deepCopier references at: each ifAbsent: [each]].
- !
Item was removed:
- ----- Method: SimpleButtonMorph>>veryDeepInner: (in category 'copying') -----
- veryDeepInner: deepCopier
- "Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment."
-
- super veryDeepInner: deepCopier.
- "target := target. Weakly copied"
- "actionSelector := actionSelector. a Symbol"
- "arguments := arguments. All weakly copied"
- actWhen := actWhen veryDeepCopyWith: deepCopier.
- oldColor := oldColor veryDeepCopyWith: deepCopier.
- mouseDownTime := nil.!
Item was removed:
- Morph subclass: #SimpleHaloMorph
- instanceVariableNames: 'target positionOffset enclosesFullBounds'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !SimpleHaloMorph commentStamp: 'mt 11/6/2015 09:59' prior: 0!
- This is a simple base class for halos in the system. It represents the minimal interface used to implement custom halo morphs.
-
- It provides:
-
- - event handling code to invoke and transfer a halo when clicking the meta-button (blue)
- - move the halo's target (morph) when click-hold-drag the meta-button
- - one close button as a minimal handle (see #addHandles)
-
- In general, the halo concept consists of one dedicated user interaction (meta-button click) to invoke an additional, interactive view (the halo) for any morph. This interactive view is itself a morph that can have submorphs (e.g. buttons or text fields) to enrich the target morph. Besides button-based interactions (e.g. resize, move, duplicate, etc.), this could also be used to show other, even domain-specific, information.
-
- Use the halo concept to provide means to explore and modify interactive, graphical elements in Squeak and your application. You can benefit from this concept without wasting additional screen space. In non-Squeak applications, the meta-key (typically the mouse-wheel button) is often without real functionality for the user. There, it makes scrolling more convenient---at best. In Squeak, you can easily take advantage of this button click.
-
- Notice that direct user input is very limited. Many keyboard shortcuts (such as [ctrl]+[c]) are already pre-defined and should not be remapped for your domain-specific applications to avoid user confusion. Key chords (such as [ctrl]+[alt]+[v], [a] from Visual Studio) have to be learned with great effort.
-
- The left mouse click (red) selects something.
- The right mouse click (yellow) invokes a context menu.
- Only the middle click, the meta-key, the blue button, is unused in many environments.
-
- This is where the halo concept comes in.
-
- [For two- or single-button mice, the meta-key can be simulated.]!
Item was removed:
- ----- Method: SimpleHaloMorph>>addHandles (in category 'construction') -----
- addHandles
- "This is an example for handles."
-
- self addMorphFront: (IconicButton new
- color: Color red muchLighter;
- borderColor: Color red;
- labelGraphic: MenuIcons smallCancelIcon;
- target: self target;
- actionSelector: #delete;
- bottomRight: self topLeft;
- yourself).!
Item was removed:
- ----- Method: SimpleHaloMorph>>delete (in category 'submorphs - add/remove') -----
- delete
-
- self target hasHalo: false.
- super delete.!
Item was removed:
- ----- Method: SimpleHaloMorph>>doDragTarget: (in category 'dragging') -----
- doDragTarget: event
-
- self target
- setConstrainedPosition: (self target point: (event position - self positionOffset) from: self owner)
- hangOut: true.
-
- self updateBounds.!
Item was removed:
- ----- Method: SimpleHaloMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- "Draw this morph only if it has no target."
-
- (Preferences showBoundsInHalo and: [self target isWorldMorph not])
- ifTrue: [
- aCanvas
- frameAndFillRectangle: self bounds
- fillColor: Color transparent
- borderWidth: 2
- borderColor: (self userInterfaceTheme borderColor ifNil: [Color blue alpha: 0.8])]!
Item was removed:
- ----- Method: SimpleHaloMorph>>enclosesFullBounds (in category 'accessing') -----
- enclosesFullBounds
-
- ^ enclosesFullBounds!
Item was removed:
- ----- Method: SimpleHaloMorph>>enclosesFullBounds: (in category 'accessing') -----
- enclosesFullBounds: aBoolean
-
- enclosesFullBounds := aBoolean.!
Item was removed:
- ----- Method: SimpleHaloMorph>>haloBoundsFor: (in category 'initialization') -----
- haloBoundsFor: aMorph
-
- | rect |
- rect := self enclosesFullBounds
- ifFalse: [aMorph boundsIn: nil]
- ifTrue: [aMorph fullBoundsInWorld].
-
- Preferences showBoundsInHalo ifFalse: [^ rect].
- ^ rect outsetBy: 2!
Item was removed:
- ----- Method: SimpleHaloMorph>>handleMouseUp: (in category 'events') -----
- handleMouseUp: evt
-
- super handleMouseUp: evt.
- evt hand newMouseFocus: self.!
Item was removed:
- ----- Method: SimpleHaloMorph>>handlesMouseDown: (in category 'events') -----
- handlesMouseDown: evt
-
- ^ true!
Item was removed:
- ----- Method: SimpleHaloMorph>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
- self morphicLayerNumber: self class haloLayer.
-
- "Each halo is a (kind of global) overlay that should not be bothered with the world's current layout policy. For example, a halo must match the target's bounds, which can be any inner part of the graphical hierarchy."
- self disableLayout: true.
-
- self initializeEnclosesFullBounds.!
Item was removed:
- ----- Method: SimpleHaloMorph>>initializeEnclosesFullBounds (in category 'initialization') -----
- initializeEnclosesFullBounds
-
- ^ self updateEnclosesFullBounds: self currentEvent!
Item was removed:
- ----- Method: SimpleHaloMorph>>innerTarget (in category 'accessing') -----
- innerTarget
- "If the target is merely a decorator for another morph, the inner target can be distiguished. Scroll panes, for example, could have their scrolled content as an inner target."
-
- ^ self target!
Item was removed:
- ----- Method: SimpleHaloMorph>>isMagicHalo (in category 'testing') -----
- isMagicHalo
-
- ^ false!
Item was removed:
- ----- Method: SimpleHaloMorph>>mouseDown: (in category 'events') -----
- mouseDown: event
- "Transfer the halo to the next likely recipient"
-
- event hand obtainHalo: self.
-
- ((self containsPoint: event position) not or: [event blueButtonPressed not])
- ifTrue: [
- "Close this halo and give another morph the chance to react."
- event hand removeHalo.
- event resetHandlerFields.
- event hand world processEvent: event.
- ^ self].
-
- self target ifNil: [
- event hand removeHalo.
- ^self].
-
- self positionOffset: (event position - (self target point: self target position in: self owner)).
-
- "wait for drags or transfer"
- event hand
- waitForClicksOrDrag: self
- event: event
- selectors: { #transferHalo:. nil. nil. #startDragTarget:. }
- threshold: HandMorph dragThreshold.!
Item was removed:
- ----- Method: SimpleHaloMorph>>mouseMove: (in category 'events') -----
- mouseMove: event
-
- self doDragTarget: event.!
Item was removed:
- ----- Method: SimpleHaloMorph>>popUpFor: (in category 'pop up') -----
- popUpFor: morph
-
- self
- popUpFor: morph
- hand: (morph world activeHand ifNil: [morph world primaryHand]).!
Item was removed:
- ----- Method: SimpleHaloMorph>>popUpFor:at:hand: (in category 'pop up') -----
- popUpFor: morph at: position hand: hand
-
- self target: morph.
-
- hand halo: self.
- hand world addMorphFront: self.
-
- self positionOffset: position - (morph point: morph position in: self owner).!
Item was removed:
- ----- Method: SimpleHaloMorph>>popUpFor:event: (in category 'pop up') -----
- popUpFor: morph event: event
-
- self
- popUpFor: morph
- at: event position
- hand: event hand.!
Item was removed:
- ----- Method: SimpleHaloMorph>>popUpFor:hand: (in category 'pop up') -----
- popUpFor: morph hand: hand
-
- self
- popUpFor: morph
- at: (hand lastEvent transformedBy: (morph transformedFrom: nil)) position
- hand: hand!
Item was removed:
- ----- Method: SimpleHaloMorph>>popUpMagicallyFor:hand: (in category 'pop up') -----
- popUpMagicallyFor: morph hand: hand
-
- self
- popUpFor: morph
- hand: hand.!
Item was removed:
- ----- Method: SimpleHaloMorph>>positionOffset (in category 'accessing') -----
- positionOffset
-
- ^ positionOffset!
Item was removed:
- ----- Method: SimpleHaloMorph>>positionOffset: (in category 'accessing') -----
- positionOffset: aPoint
-
- positionOffset := aPoint.!
Item was removed:
- ----- Method: SimpleHaloMorph>>processFocusEvent:using: (in category 'events') -----
- processFocusEvent: evt using: dispatcher
-
- ^ dispatcher dispatchFocusEventAllOver: evt with: self!
Item was removed:
- ----- Method: SimpleHaloMorph>>rejectsEvent: (in category 'events') -----
- rejectsEvent: anEvent
- "Return true to reject the given event. Rejecting an event means neither the receiver nor any of it's submorphs will be given any chance to handle it."
- (super rejectsEvent: anEvent) ifTrue:[^true].
- anEvent isDropEvent ifTrue:[^true]. "never attempt to drop on halos"
- ^false!
Item was removed:
- ----- Method: SimpleHaloMorph>>startDragTarget: (in category 'dragging') -----
- startDragTarget: event
-
- self positionOffset: (event position - (self target point: self target position in: self owner)).
- event hand newMouseFocus: self.!
Item was removed:
- ----- Method: SimpleHaloMorph>>staysUpWhenMouseIsDownIn: (in category 'testing') -----
- staysUpWhenMouseIsDownIn: aMorph
- ^ ((aMorph == self target) or: [aMorph hasOwner: self])!
Item was removed:
- ----- Method: SimpleHaloMorph>>target (in category 'accessing') -----
- target
-
- ^ target ifNil: [target := Morph new]!
Item was removed:
- ----- Method: SimpleHaloMorph>>target: (in category 'accessing') -----
- target: morph
-
- target := morph.
- morph hasHalo: true.
- self addHandles.!
Item was removed:
- ----- Method: SimpleHaloMorph>>transferHalo: (in category 'pop up') -----
- transferHalo: event
- "Transfer the halo to the next likely recipient"
-
- ^ self
- transferHalo: event
- using: (self
- valueOfProperty: #lastHaloDispatcher
- ifAbsent: [self target defaultHaloDispatcher])!
Item was removed:
- ----- Method: SimpleHaloMorph>>transferHalo:using: (in category 'pop up') -----
- transferHalo: event using: dispatcher
- "Transfer the halo to the next likely recipient. Call the target again so that it may change the dispatcher."
-
- self updateEnclosesFullBounds: event.
- ^ self target
- transferHalo: (event transformedBy: (self target transformedFrom: self))
- using: dispatcher!
Item was removed:
- ----- Method: SimpleHaloMorph>>updateBounds (in category 'updating') -----
- updateBounds
-
- self bounds: (self haloBoundsFor: self target).!
Item was removed:
- ----- Method: SimpleHaloMorph>>updateEnclosesFullBounds: (in category 'updating') -----
- updateEnclosesFullBounds: anEvent
-
- self enclosesFullBounds: (Preferences haloEnclosesFullBounds xor: anEvent controlKeyPressed).!
Item was removed:
- ----- Method: SimpleHaloMorph>>wantsHaloFromClick (in category 'halos and balloon help') -----
- wantsHaloFromClick
-
- ^ false!
Item was removed:
- ScrollPane subclass: #SimpleHierarchicalListMorph
- instanceVariableNames: 'selectedMorph hoveredMorph getListSelector keystrokeActionSelector autoDeselect columns columnsCache sortingSelector getSelectionSelector setSelectionSelector potentialDropMorph lineColor font textColor'
- classVariableNames: 'ExpandedForm NotExpandedForm WrappedNavigation'
- poolDictionaries: ''
- category: 'Morphic-Explorer'!
-
- !SimpleHierarchicalListMorph commentStamp: 'ls 3/1/2004 12:15' prior: 0!
- Display a hierarchical list of items. Each item should be wrapped with a ListItemWrapper.
-
- For a simple example, look at submorphsExample. For beefier examples, look at ObjectExplorer or FileList2.!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph class>>applyUserInterfaceTheme (in category 'preferences') -----
- applyUserInterfaceTheme
-
- ExpandedForm := nil.
- NotExpandedForm := nil.!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph class>>expandedForm (in category 'instance creation') -----
- expandedForm
- ExpandedForm
- ifNotNil: [ExpandedForm depth ~= Display depth
- ifTrue: [ExpandedForm := nil]].
- ^ ExpandedForm
- ifNil: [ExpandedForm := ((Form
- extent: 10 @ 9
- depth: 8
- fromArray: #(4294967295 4294967295 4294901760 4294967295 4294967295 4294901760 4278255873 16843009 16842752 4294902089 1229539657 33488896 4294967041 1229539585 4294901760 4294967295 21561855 4294901760 4294967295 4278321151 4294901760 4294967295 4294967295 4294901760 4294967295 4294967295 4294901760 )
- offset: 0 @ 0)
- asFormOfDepth: Display depth)
- replaceColor: Color white withColor: Color transparent;
- scaleIconToDisplay]!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph class>>notExpandedForm (in category 'instance creation') -----
- notExpandedForm
- NotExpandedForm
- ifNotNil: [NotExpandedForm depth ~= Display depth
- ifTrue: [NotExpandedForm := nil]].
- ^ NotExpandedForm
- ifNil: [NotExpandedForm := ((Form
- extent: 10 @ 9
- depth: 8
- fromArray: #(4294967041 4294967295 4294901760 4294967041 33554431 4294901760 4294967041 1224867839 4294901760 4294967041 1229521407 4294901760 4294967041 1229539585 4294901760 4294967041 1229521407 4294901760 4294967041 1224867839 4294901760 4294967041 33554431 4294901760 4294967041 4294967295 4294901760 )
- offset: 0 @ 0)
- asFormOfDepth: Display depth)
- replaceColor: Color white withColor: Color transparent;
- scaleIconToDisplay]!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph class>>on:list:selected:changeSelected: (in category 'instance creation') -----
- on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel
- "Create a 'pluggable' list view on the given model parameterized by the given message selectors."
-
- ^ self new
- on: anObject
- list: getListSel
- selected: getSelectionSel
- changeSelected: setSelectionSel
- menu: nil
- keystroke: #arrowKey:from: "default"!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph class>>on:list:selected:changeSelected:menu: (in category 'instance creation') -----
- on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel
- "Create a 'pluggable' list view on the given model parameterized by the given message selectors."
-
- ^ self new
- on: anObject
- list: getListSel
- selected: getSelectionSel
- changeSelected: setSelectionSel
- menu: getMenuSel
- keystroke: #arrowKey:from: "default"
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph class>>on:list:selected:changeSelected:menu:keystroke: (in category 'instance creation') -----
- on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel
- "Create a 'pluggable' list view on the given model parameterized by the given message selectors."
-
- ^ self new
- on: anObject
- list: getListSel
- selected: getSelectionSel
- changeSelected: setSelectionSel
- menu: getMenuSel
- keystroke: keyActionSel
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph class>>submorphsExample (in category 'examples') -----
- submorphsExample
- "display a hierarchical list of the current world plus its submorphs plus its submorphs' submorphs etc."
- "SimpleHierarchicalListMorph submorphsExample"
- | morph |
- morph :=
- SimpleHierarchicalListMorph
- on: [ Array with: (MorphWithSubmorphsWrapper with: Project current world) ]
- list: #value
- selected: nil
- changeSelected: nil
- menu: nil
- keystroke: nil.
-
- morph openInWindow!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ super themeProperties, {
- { #font. 'Fonts'. 'Font of the list items.' }.
- { #textColor. 'Colors'. 'Color of the list items.' }.
- { #selectionColor. 'Colors'. 'Color used for items when hovering or selecting them.' }.
- { #selectionTextColor. 'Colors'. 'Color used for label when hovering or selecting them.' }.
-
- { #filterColor. 'Colors'. 'Color used for items to indicate the matching filter.' }.
- { #filterTextColor. 'Colors'. 'Color used for items to indicate the matching filter.' }.
- { #highlightTextColor. 'Colors'. 'Color used for highlighted items.' }.
-
- { #hoverSelectionModifier. 'Colors'. 'How to derive the hover color from the selection color.'}.
-
- { #lineColor. 'Colors'. 'How the lines are drawn.' }.
- }!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph class>>wrappedNavigation (in category 'preferences') -----
- wrappedNavigation
- <preference: 'Wrapped Tree Navigation'
- category: 'Morphic'
- description: 'When enabled, use of the arrow keys at the top or bottom of a hierarchical list will wrap to the opposite side of the list.'
- type: #Boolean>
- ^ WrappedNavigation ifNil: [ false ]!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph class>>wrappedNavigation: (in category 'preferences') -----
- wrappedNavigation: aBoolean
- WrappedNavigation := aBoolean!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>acceptDroppingMorph:event: (in category 'drag and drop') -----
- acceptDroppingMorph: aMorph event: evt
-
- self model
- acceptDroppingMorph: aMorph
- event: evt
- inMorph: self.
- self resetPotentialDropMorph.
- evt hand releaseMouseFocus: self.
- Cursor normal show.
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>addMorphsTo:from:allowSorting:withExpandedItems:atLevel: (in category 'private') -----
- addMorphsTo: morphList from: aCollection allowSorting: sortBoolean withExpandedItems: expandedItems atLevel: newIndent
-
- | priorMorph newCollection firstAddition |
- priorMorph := nil.
- newCollection := (sortBoolean and: [sortingSelector notNil]) ifTrue: [
- aCollection sorted: [ :a :b |
- (a perform: sortingSelector) <= (b perform: sortingSelector)]
- ] ifFalse: [
- aCollection
- ].
- firstAddition := nil.
- newCollection do: [:item |
- priorMorph := self indentingItemClass basicNew
- initWithContents: item
- prior: priorMorph
- forList: self
- indentLevel: newIndent.
- priorMorph
- initWithColor: self textColor
- andFont: self font.
- priorMorph
- selectionColor: self selectionColor;
- selectionTextColor: self selectionTextColor;
- hoverColor: self hoverColor;
- highlightTextColor: self highlightTextColor;
- filterColor: self filterColor;
- filterTextColor: self filterTextColor;
- wantsYellowButtonMenu: false.
- firstAddition ifNil: [firstAddition := priorMorph].
- morphList add: priorMorph.
- ((item hasEquivalentIn: expandedItems) or: [priorMorph isExpanded]) ifTrue: [
- self flag: #bug. "mt: Endless recursion can happen for similar items in the tree."
- priorMorph isExpanded: true.
- priorMorph
- addChildrenForList: self
- addingTo: morphList
- withExpandedItems: expandedItems.
- ].
- ].
- ^firstAddition
-
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>addSubmorphsAfter:fromCollection:allowSorting: (in category 'private') -----
- addSubmorphsAfter: parentMorph fromCollection: aCollection allowSorting: sortBoolean
-
- | priorMorph morphList newCollection |
- priorMorph := nil.
- newCollection := (sortBoolean and: [sortingSelector notNil]) ifTrue: [
- aCollection sorted: [ :a :b |
- (a perform: sortingSelector) <= (b perform: sortingSelector)]
- ] ifFalse: [
- aCollection
- ].
- morphList := OrderedCollection new.
- newCollection do: [:item |
- priorMorph := self indentingItemClass basicNew
- initWithContents: item
- prior: priorMorph
- forList: self
- indentLevel: parentMorph indentLevel + 1.
- priorMorph
- initWithColor: self textColor
- andFont: self font.
- priorMorph
- selectionColor: self selectionColor;
- selectionTextColor: self selectionTextColor;
- hoverColor: self hoverColor;
- highlightTextColor: self highlightTextColor;
- filterColor: self filterColor;
- filterTextColor: self filterTextColor;
- wantsYellowButtonMenu: false.
- morphList add: priorMorph.
- ].
- scroller addAllMorphs: morphList after: parentMorph.
- ^morphList!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>adjustSubmorphPositions (in category 'private') -----
- adjustSubmorphPositions
-
- | p |
- p := 0 at 0.
- scroller submorphsDo: [ :each | | h |
- each visible ifTrue: [
- h := each height.
- each privateBounds: (p extent: self preferredSubmorphWidth at h).
- p := p + (0 at h) ]].
- self
- clearColumnsCache;
- changed;
- layoutChanged;
- setScrollDeltas.
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>applyUserInterfaceTheme (in category 'updating') -----
- applyUserInterfaceTheme
-
- super applyUserInterfaceTheme.
-
- scroller submorphsDo: [:ea | ea refreshIcon].
- self adjustSubmorphPositions.!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>arrowKey: (in category 'keyboard navigation') -----
- arrowKey: asciiValue
- "Handle a keyboard navigation character. Answer true if handled, false if not."
- | keyEvent max oldSelection nextSelection howManyItemsShowing keyHandled |
- keyHandled := false.
- keyEvent := asciiValue.
- max := self maximumSelection.
- nextSelection := oldSelection := self getSelectionIndex.
- keyEvent = 31 ifTrue:["down"
- keyHandled := true.
- nextSelection :=oldSelection + 1.
- nextSelection > max ifTrue: [nextSelection := (self class wrappedNavigation ifTrue: [1] ifFalse: [max])]].
- keyEvent = 30 ifTrue:["up"
- keyHandled := true.
- nextSelection := oldSelection - 1.
- nextSelection < 1 ifTrue: [nextSelection := self class wrappedNavigation ifTrue: [max] ifFalse: [1]]].
- keyEvent = 1 ifTrue: ["home"
- keyHandled := true.
- nextSelection := 1].
- keyEvent = 4 ifTrue: ["end"
- keyHandled := true.
- nextSelection := max].
- howManyItemsShowing := self numSelectionsInView.
- keyEvent = 11 ifTrue: ["page up"
- keyHandled := true.
- nextSelection := 1 max: oldSelection - howManyItemsShowing].
- keyEvent = 12 ifTrue: ["page down"
- keyHandled := true.
- nextSelection := oldSelection + howManyItemsShowing min: max].
-
- (nextSelection ~= oldSelection or: [ keyHandled and: [ self class wrappedNavigation not ]]) ifTrue: [
- self setSelectionIndex: nextSelection.
- ^ true].
-
- keyEvent = 29 ifTrue:["right"
- selectedMorph ifNotNil:[
- (selectedMorph canExpand and:[selectedMorph isExpanded not])
- ifTrue:[self toggleExpandedState: selectedMorph]
- ifFalse:[self setSelectionIndex: self getSelectionIndex+1].
- ].
- ^true].
- keyEvent = 28 ifTrue:["left"
- selectedMorph ifNotNil:[
- (selectedMorph isExpanded)
- ifTrue:[self toggleExpandedState: selectedMorph]
- ifFalse:[self setSelectionIndex: (self getSelectionIndex-1 max: 1)].
- ].
- ^true].
- ^false!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>autoDeselect: (in category 'initialization') -----
- autoDeselect: trueOrFalse
- "When selecting a selected item, it will be deselected. See #mouseUp:."
-
- autoDeselect := trueOrFalse.!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>clearColumnsCache (in category 'private - caching') -----
- clearColumnsCache
-
- columnsCache := self columns
- ifNil: [Array empty]
- ifNotNil: [:c | Array new: c size].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>columns (in category 'accessing') -----
- columns
-
- ^columns!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>columns: (in category 'accessing') -----
- columns: anArray
- "You can specify columns or specs for columns. This depends on the actual morph that is used as item. ObjectExplorers produce items that support exact numbers, blocks, and nil for max width."
-
- columns := anArray.
- self clearColumnsCache.!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>columnsCache (in category 'private - caching') -----
- columnsCache
- columnsCache ifNil: [self clearColumnsCache].
- ^ columnsCache!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>currentlyExpanded (in category 'initialization') -----
- currentlyExpanded
-
- ^(scroller submorphs select: [ :each | each isExpanded]) collect: [ :each |
- each complexContents
- ].
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>drawHoverOn: (in category 'drawing') -----
- drawHoverOn: aCanvas
-
- self hoveredMorph ifNil: [^ self].
- PluggableListMorph highlightHoveredRow ifFalse: [^ self].
-
- aCanvas
- transformBy: scroller transform
- clippingTo: scroller innerBounds
- during: [:c | self hoveredMorph drawHoverOn: c].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>drawLinesOn: (in category 'drawing') -----
- drawLinesOn: aCanvas
-
- | lColor |
- lColor := self lineColor.
- aCanvas
- transformBy: scroller transform
- clippingTo: scroller innerBounds
- during:[:clippedCanvas |
- scroller submorphsDo: [ :submorph |
- (submorph visible and: [(submorph isExpanded
- or: [clippedCanvas isVisible: submorph fullBounds] )
- or: [ submorph nextSibling notNil and: [clippedCanvas isVisible: submorph nextSibling fullBounds]]])
- ifTrue: [submorph drawLinesOn: clippedCanvas lineColor: lColor indentThreshold: 0] ] ]
- smoothing: scroller smoothing.
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- super drawOn: aCanvas.
-
- self drawHoverOn: aCanvas.
- self drawSelectionOn: aCanvas.
- self drawLinesOn: aCanvas.!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>drawSelectionOn: (in category 'drawing') -----
- drawSelectionOn: aCanvas
-
- self selectedMorph ifNotNil: [:m |
- aCanvas
- transformBy: scroller transform
- clippingTo: scroller innerBounds
- during: [:c | m drawSelectionOn: c] ].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>expand:to: (in category 'events') -----
- expand: aMorph to: level
- | allChildren |
- aMorph toggleExpandedState.
- allChildren := OrderedCollection new: 10.
- aMorph recursiveAddTo: allChildren.
- allChildren do: [:each |
- ((each canExpand
- and: [each isExpanded not])
- and: [level > 0])
- ifTrue: [self expand: each to: level-1]].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>expandAll (in category 'events') -----
- expandAll
- (selectedMorph isNil
- or: [selectedMorph isExpanded])
- ifTrue: [^self].
- self expandAll: selectedMorph.
- self adjustSubmorphPositions!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>expandAll: (in category 'events') -----
- expandAll: aMorph
- | allChildren |
- aMorph toggleExpandedState.
- allChildren := OrderedCollection new: 10.
- aMorph recursiveAddTo: allChildren.
- allChildren do: [:each |
- (each canExpand and: [each isExpanded not])
- ifTrue: [self expandAll: each]].
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>expandAll:except: (in category 'events') -----
- expandAll: aMorph except: aBlock
- | allChildren |
- (aBlock value: aMorph complexContents)
- ifFalse: [^self].
- aMorph toggleExpandedState.
- allChildren := OrderedCollection new: 10.
- aMorph recursiveAddTo: allChildren.
- allChildren do: [:each |
- (each canExpand
- and: [each isExpanded not])
- ifTrue: [self expandAll: each except: aBlock]].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>expandRoots (in category 'events') -----
- expandRoots
- "Expand all the receiver's roots"
- self roots
- do: [:each |
- (each canExpand and: [each isExpanded not])
- ifTrue: [each toggleExpandedState]].
- self adjustSubmorphPositions!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>expandedForm (in category 'drawing') -----
- expandedForm
-
- ^self class expandedForm!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>extent: (in category 'geometry') -----
- extent: newExtent
- bounds extent = newExtent ifTrue: [^ self].
- super extent: newExtent.
- self setScrollDeltas !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>filterColor (in category 'accessing') -----
- filterColor
-
- ^ self valueOfProperty: #filterColor ifAbsent: [Color yellow]!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>filterColor: (in category 'accessing') -----
- filterColor: aColor
-
- self setProperty: #filterColor toValue: aColor.
- scroller submorphsDo: [:ea | ea filterColor: aColor].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>filterTextColor (in category 'accessing') -----
- filterTextColor
-
- ^ self valueOfProperty: #filterTextColor ifAbsent: [Color black]!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>filterTextColor: (in category 'accessing') -----
- filterTextColor: aColor
-
- self setProperty: #filterTextColor toValue: aColor.
- scroller submorphsDo: [:ea | ea filterTextColor: aColor].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>font (in category 'accessing') -----
- font
- ^ font ifNil: [TextStyle defaultFont]!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>font: (in category 'accessing') -----
- font: aFont
- font := aFont.
- scroller submorphsDo: [:ea | ea font: font].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>getCurrentSelectionItem (in category 'selection') -----
- getCurrentSelectionItem
-
- ^model perform: (getSelectionSelector ifNil: [^nil])
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>getList (in category 'model access') -----
- getList
- "Answer the list to be displayed."
-
- ^(model perform: (getListSelector ifNil: [^#()])) ifNil: [#()]
-
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>getSelectionIndex (in category 'keyboard navigation') -----
- getSelectionIndex
- ^scroller submorphs indexOf: selectedMorph!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>hUnadjustedScrollRange (in category 'scrolling') -----
- hUnadjustedScrollRange
- "Return the width of the widest item in the list"
-
- | max count |
- self flag: #tofix. "mt: What about icons and columns? Do we ever show horizontal scroll bars for such tree views anyway? Maybe just return 0?"
-
- max := 0.
- count := 0.
- scroller submorphsDo: [ :each | | stringW right |
- stringW := each font widthOfStringOrText: each contents.
- right := (each toggleRectangle right + stringW + 10).
- max := max max: right.
-
- "NOTE: need to optimize this method by caching list item morph widths (can init that cache most efficiently in the #list: method before the item widths are reset to 9999). For now, just punt on really long lists"
- ((count := count + 1) > 200) ifTrue:[ ^max * 3].
- ].
-
- ^max
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>handleMouseMove: (in category 'events-processing') -----
- handleMouseMove: anEvent
- anEvent wasHandled ifFalse: [self hoveredMorph: (self itemFromPoint: anEvent position)].
- super handleMouseMove: anEvent.!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>handlesMouseMove: (in category 'event handling') -----
- handlesMouseMove: anEvent
- ^ anEvent anyButtonPressed and: [anEvent hand mouseFocus == self]!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>handlesMouseOverDragging: (in category 'event handling') -----
- handlesMouseOverDragging: evt
- ^self dropEnabled!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>highlightSelection (in category 'drawing') -----
- highlightSelection
-
- selectedMorph ifNotNil: [selectedMorph highlight]!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>highlightTextColor (in category 'accessing') -----
- highlightTextColor
-
- ^ self valueOfProperty: #highlightTextColor ifAbsent: [Color red]!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>highlightTextColor: (in category 'accessing') -----
- highlightTextColor: aColor
-
- self setProperty: #highlightTextColor toValue: aColor.
- scroller submorphsDo: [:ea | ea highlightTextColor: aColor].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>hoverColor (in category 'accessing') -----
- hoverColor
-
- ^ self valueOfProperty: #hoverColor ifAbsent: [Color veryLightGray]!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>hoverColor: (in category 'accessing') -----
- hoverColor: aColor
-
- self setProperty: #hoverColor toValue: aColor.
- scroller submorphsDo: [:ea | ea setProperty: #hoverColor toValue: aColor].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>hoveredMorph (in category 'accessing') -----
- hoveredMorph
-
- ^ hoveredMorph!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>hoveredMorph: (in category 'accessing') -----
- hoveredMorph: aMorph
-
- hoveredMorph == aMorph ifTrue: [^ self].
-
- hoveredMorph ifNotNil: [:m | m changed].
- hoveredMorph := aMorph.
- hoveredMorph ifNotNil: [:m | m changed]. !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>indentingItemClass (in category 'initialization') -----
- indentingItemClass
-
- ^IndentingListItemMorph!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- self setProperty: #autoExpand toValue: false.
- scroller wantsYellowButtonMenu: false.
- self
- on: #mouseMove
- send: #mouseStillDown:onItem:
- to: self!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>insertNewMorphs: (in category 'private') -----
- insertNewMorphs: morphList
-
- scroller addAllMorphs: morphList.
- self adjustSubmorphPositions.
- self selection: self getCurrentSelectionItem.
- self setScrollDeltas.
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>installModelIn: (in category 'debug and other') -----
- installModelIn: aWorld
- "No special inits for new components"
- ^ self!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>itemFromPoint: (in category 'event handling') -----
- itemFromPoint: aPoint
- "Return the list element (morph) at the given point or nil if outside"
- | ptY visibleRows |
- scroller hasSubmorphs ifFalse:[^nil].
- (scroller fullBounds containsPoint: aPoint) ifFalse:[^nil].
-
- visibleRows := scroller submorphs select: [:m | m visible].
-
- ptY := (visibleRows first point: aPoint from: self) y.
- "note: following assumes that submorphs are vertical, non-overlapping, and ordered"
- visibleRows first top > ptY ifTrue:[^nil].
- visibleRows last bottom < ptY ifTrue:[^nil].
- "now use binary search"
- ^visibleRows
- findBinary:[:item|
- (item top <= ptY and:[item bottom >= ptY])
- ifTrue:[0] "found"
- ifFalse:[ (item top + item bottom // 2) > ptY ifTrue:[-1] ifFalse:[1]]]
- ifNone: [nil]!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>keyStroke: (in category 'event handling') -----
- keyStroke: event
- "Process potential command keys"
-
- event keyCharacter asciiValue < 32 ifTrue: [
- ^ self specialKeyPressed: event keyCharacter asciiValue].
-
- " A lot of actions do not return a Boolean here (#messageListKey:from:,
- #classListKey:from:, ...); even most #arrowKey:from: implementors do not.
- Hence, we explicitely check for false and else assume truthieness"
- ^ (self keyStrokeAction: event) ~~ false
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>keyStrokeAction: (in category 'event handling') -----
- keyStrokeAction: event
-
- | numArgs |
- keystrokeActionSelector ifNil: [^false].
-
- numArgs := keystrokeActionSelector numArgs.
-
- numArgs = 1 ifTrue: [
- ^ model
- perform: keystrokeActionSelector
- with: event keyCharacter].
- numArgs = 2 ifTrue: [
- ^ model
- perform: keystrokeActionSelector
- with: event keyCharacter
- with: self].
- numArgs = 3 ifTrue: [
- ^ model
- perform: keystrokeActionSelector
- with: event keyCharacter
- with: self
- with: event].
- ^self error: 'The keystrokeActionSelector must be a 1-, 2-, or 3-keyword symbol'!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>lineColor (in category 'accessing') -----
- lineColor
- "Answer a good color to use for drawing the lines that connect members of the hierarchy view.
- Used the cached color, or derive it if necessary by finding the first owner (up to my root) that is not transparent, then picking a contrasting color.
- Fall back to veryLightGray if all my owners are transparent."
-
- | coloredOwner targetLuminance ownerColor darken |
- lineColor ifNotNil: [ ^lineColor ].
- coloredOwner := self firstOwnerSuchThat: [ :o | o isWorldOrHandMorph not and: [ o color isTransparent not ]].
- coloredOwner ifNil: [ ^Color veryLightGray ].
- ownerColor := coloredOwner color.
- darken := ownerColor luminance > 0.5.
- targetLuminance := ownerColor luminance + (darken ifTrue: [ -0.2 ] ifFalse: [ 0.2 ]).
- ^darken
- ifTrue: [ ownerColor atMostAsLuminentAs: targetLuminance ]
- ifFalse: [ ownerColor atLeastAsLuminentAs: targetLuminance ]
-
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>lineColor: (in category 'accessing') -----
- lineColor: aColor
- ^lineColor := aColor
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>list: (in category 'initialization') -----
- list: aCollection
-
- | wereExpanded morphList |
- wereExpanded := self currentlyExpanded.
- scroller removeAllMorphs.
- (aCollection isNil or: [aCollection isEmpty]) ifTrue: [^ self selectedMorph: nil].
- morphList := OrderedCollection new.
- self
- addMorphsTo: morphList
- from: aCollection
- allowSorting: false
- withExpandedItems: wereExpanded
- atLevel: 0.
- self insertNewMorphs: morphList.!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>listItemHeight (in category 'initialization') -----
- listItemHeight
- "This should be cleaned up. The list should get spaced by this parameter."
- ^ 12!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>maximumSelection (in category 'selection') -----
- maximumSelection
-
- ^ scroller submorphs size
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>minimumSelection (in category 'selection') -----
- minimumSelection
- ^ 1!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>mouseDown: (in category 'event handling') -----
- mouseDown: evt
- | aMorph selectors |
- aMorph := self itemFromPoint: evt position.
- evt yellowButtonPressed "First check for option (menu) click"
- ifTrue: [
- (PluggableListMorph menuRequestUpdatesSelection and: [model okToChange]) ifTrue: [
- aMorph == selectedMorph
- ifFalse: [self setSelectedMorph: aMorph]].
- ^ self yellowButtonActivity: evt shiftPressed].
- (aMorph notNil and:[aMorph inToggleArea: (aMorph point: evt position from: self)])
- ifTrue:[^self toggleExpandedState: aMorph event: evt].
- aMorph ifNil:[^super mouseDown: evt].
-
- aMorph highlightForMouseDown.
- self setProperty: #highlightedMorph toValue: aMorph.
-
- selectors := Array
- with: #click:
- with: nil
- with: nil
- with: (self dragEnabled ifTrue:[#startDrag:] ifFalse:[nil]).
- evt hand waitForClicksOrDrag: self event: evt selectors: selectors threshold: HandMorph dragThreshold "pixels".!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>mouseDown:onItem: (in category 'obsolete') -----
- mouseDown: event onItem: aMorph
- self removeObsoleteEventHandlers.
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>mouseEnter: (in category 'event handling') -----
- mouseEnter: event
-
- super mouseEnter: event.
-
- Preferences mouseOverForKeyboardFocus
- ifTrue: [event hand newKeyboardFocus: self].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>mouseEnterDragging: (in category 'event handling') -----
- mouseEnterDragging: evt
- | aMorph |
- (evt hand hasSubmorphs and:[self dropEnabled]) ifFalse: ["no d&d"
- ^super mouseEnterDragging: evt].
- (self wantsDroppedMorph: evt hand firstSubmorph event: evt )
- ifTrue:[
- aMorph := self itemFromPoint: evt position.
- aMorph ifNotNil:[self potentialDropMorph: aMorph].
- evt hand newMouseFocus: self.
- "above is ugly but necessary for now"
- ].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>mouseEnterDragging:onItem: (in category 'obsolete') -----
- mouseEnterDragging: anEvent onItem: aMorph
- self removeObsoleteEventHandlers.!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>mouseLeave: (in category 'event handling') -----
- mouseLeave: aMouseEvent
-
- super mouseLeave: aMouseEvent.
- self hoveredMorph: nil.
-
- Preferences mouseOverForKeyboardFocus
- ifTrue: [aMouseEvent hand releaseKeyboardFocus: self].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>mouseLeaveDragging: (in category 'event handling') -----
- mouseLeaveDragging: anEvent
-
- self hoveredMorph: nil.
- (self dropEnabled and:[anEvent hand hasSubmorphs]) ifFalse: ["no d&d"
- ^ super mouseLeaveDragging: anEvent].
- self resetPotentialDropMorph.
- anEvent hand releaseMouseFocus: self.
- "above is ugly but necessary for now"
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>mouseLeaveDragging:onItem: (in category 'obsolete') -----
- mouseLeaveDragging: anEvent onItem: aMorph
- self removeObsoleteEventHandlers.!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>mouseMove: (in category 'event handling') -----
- mouseMove: evt
-
- (self dropEnabled and:[evt hand hasSubmorphs])
- ifFalse:[^super mouseMove: evt].
- potentialDropMorph ifNotNil:[
- (potentialDropMorph containsPoint: (potentialDropMorph point: evt position from: self))
- ifTrue:[^self].
- ].
- self mouseLeaveDragging: evt.
- (self containsPoint: evt position)
- ifTrue:[self mouseEnterDragging: evt].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>mouseUp: (in category 'event handling') -----
- mouseUp: event
-
- | clickedMorph highlightedMorph |
- clickedMorph := self itemFromPoint: event position.
- highlightedMorph := self valueOfProperty: #highlightedMorph ifAbsent: [].
- self removeProperty: #highlightedMorph.
-
- ((model okToChange not
- or: [clickedMorph isNil])
- or: [clickedMorph ~~ highlightedMorph]) ifTrue: [
- highlightedMorph ifNotNil: [:m | m highlightForMouseDown: false].
- ^ self].
-
- ((autoDeselect isNil or: [autoDeselect]) and: [clickedMorph == selectedMorph])
- ifTrue: [self setSelectedMorph: nil]
- ifFalse: [self setSelectedMorph: clickedMorph].
-
- highlightedMorph highlightForMouseDown: false.
- event hand newKeyboardFocus: self.
- Cursor normal show.!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>notExpandedForm (in category 'drawing') -----
- notExpandedForm
-
- ^self class notExpandedForm!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>noteRemovalOfAll: (in category 'private') -----
- noteRemovalOfAll: aCollection
-
- scroller removeAllMorphsIn: aCollection.
- (aCollection includes: selectedMorph) ifTrue: [self setSelectedMorph: nil].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>offsetToShow: (in category 'scrolling') -----
- offsetToShow: aRectangle
- "Focus rectangles are too wide and the view hence jumps to the right. Snap it back to 0 on the horizontal axis."
-
- ^ 0 @ (super offsetToShow: aRectangle) y!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>on:list:selected:changeSelected:menu:keystroke: (in category 'initialization') -----
- on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel
-
- self model: anObject.
- getListSelector := getListSel.
- getSelectionSelector := getSelectionSel.
- setSelectionSelector := setSelectionSel.
- getMenuSelector := getMenuSel.
- keystrokeActionSelector := keyActionSel.
- autoDeselect := true.
- self borderWidth: 1.
- self list: self getList.!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>potentialDropMorph (in category 'drag and drop') -----
- potentialDropMorph
- ^potentialDropMorph!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>potentialDropMorph: (in category 'drag and drop') -----
- potentialDropMorph: aMorph
- potentialDropMorph := aMorph.
- aMorph highlightForDrop!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>preferredSubmorphWidth (in category 'private') -----
- preferredSubmorphWidth
-
- ^ 9999!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>removeObsoleteEventHandlers (in category 'obsolete') -----
- removeObsoleteEventHandlers
- scroller submorphs do:[:m|
- m eventHandler: nil; highlightForMouseDown: false; resetExtension].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>resetPotentialDropMorph (in category 'drag and drop') -----
- resetPotentialDropMorph
- potentialDropMorph ifNotNil: [
- potentialDropMorph resetHighlightForDrop.
- potentialDropMorph := nil]
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>roots (in category 'accessing') -----
- roots
- "Answer the receiver's roots"
- ^ scroller submorphs
- select: [:each | each indentLevel isZero]!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>scrollDeltaHeight (in category 'geometry') -----
- scrollDeltaHeight
- ^ scroller hasSubmorphs
- ifTrue: [scroller firstSubmorph height]
- ifFalse: [super scrollDeltaHeight]!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>scrollDeltaWidth (in category 'geometry') -----
- scrollDeltaWidth
- "A guess -- assume that the width of a char is approx 1/2 the height of the font"
- ^ self scrollDeltaHeight // 2
-
-
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>selectedMorph (in category 'selection') -----
- selectedMorph
- ^selectedMorph!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>selectedMorph: (in category 'selection') -----
- selectedMorph: aMorph
-
- self unhighlightSelection.
- selectedMorph := aMorph.
- self highlightSelection!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>selection: (in category 'selection') -----
- selection: item
- "Called from outside to request setting a new selection.
- Assumes scroller submorphs is exactly our list.
- Note: MAY NOT work right if list includes repeated items"
-
- | i |
- item ifNil: [^self selectionIndex: 0].
- i := scroller submorphs findFirst: [:m | m complexContents == item].
- i > 0 ifTrue: [^self selectionIndex: i].
- i := scroller submorphs findFirst: [:m | m withoutListWrapper = item withoutListWrapper].
- self selectionIndex: i!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>selectionColor (in category 'accessing') -----
- selectionColor
-
- ^ self valueOfProperty: #selectionColor ifAbsent: [Color blue]!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>selectionColor: (in category 'accessing') -----
- selectionColor: aColor
-
- self setProperty: #selectionColor toValue: aColor.
- scroller submorphsDo: [:ea | ea selectionColor: aColor].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>selectionIndex: (in category 'selection') -----
- selectionIndex: idx
- "Called internally to select the index-th item."
- | theMorph index |
- idx ifNil: [^ self].
- index := idx min: scroller submorphs size max: 0.
- (theMorph := index = 0 ifTrue: [nil] ifFalse: [scroller submorphs at: index])
- ifNotNil: [self scrollToShow: theMorph bounds].
- self selectedMorph: theMorph!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>selectionOneOf: (in category 'selection') -----
- selectionOneOf: aListOfItems
- "Set the selection to the first item in the list which is represented by one of my submorphs"
-
-
- aListOfItems do: [ :item | | index |
- index := scroller submorphs findFirst: [:m |
- m withoutListWrapper = item withoutListWrapper
- ].
- index > 0 ifTrue: [^self selectionIndex: index].
- ].
- self selectionIndex: 0.!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>selectionTextColor (in category 'accessing') -----
- selectionTextColor
-
- ^ self valueOfProperty: #selectionTextColor ifAbsent: [Color white]!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>selectionTextColor: (in category 'accessing') -----
- selectionTextColor: aColor
-
- self setProperty: #selectionTextColor toValue: aColor.
- scroller submorphsDo: [:ea | ea selectionTextColor: aColor].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>setDefaultParameters (in category 'initialization') -----
- setDefaultParameters
-
- super setDefaultParameters.
-
- self
- font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]);
- textColor: (self userInterfaceTheme textColor ifNil: [Color black]).
-
- self
- selectionColor: (self userInterfaceTheme selectionColor ifNil: [Color r: 0.72 g: 0.72 b: 0.9]);
- selectionTextColor: (self userInterfaceTheme selectionTextColor ifNil: [Color black]);
- filterColor: (self userInterfaceTheme filterColor ifNil: [Color yellow paler]);
- filterTextColor: (self userInterfaceTheme filterTextColor ifNil: [Color black]);
- lineColor: (self userInterfaceTheme lineColor ifNil: [Color veryLightGray]);
- hoverColor: ((self userInterfaceTheme hoverSelectionModifier ifNil: [ [:c | c darker alpha: 0.3] ]) value: self selectionColor);
- highlightTextColor: (self userInterfaceTheme highlightTextColor ifNil: [Color red]).!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>setSelectedMorph: (in category 'selection') -----
- setSelectedMorph: aMorph
-
- "Avoid unnecessary model callbacks."
- self selectedMorph == aMorph ifTrue: [^ self].
-
- model
- perform: (setSelectionSelector ifNil: [^self])
- with: aMorph complexContents "leave last wrapper in place"
-
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>setSelectionIndex: (in category 'keyboard navigation') -----
- setSelectionIndex: idx
- "Called internally to select the index-th item."
- | theMorph index max currentIndex |
- idx ifNil: [^ self].
- max := scroller submorphs size.
- currentIndex := self getSelectionIndex.
-
- index := idx min: max max: 0.
- theMorph := index = 0 ifTrue: [nil] ifFalse: [scroller submorphs at: index].
-
- "Skip invisible rows."
- [theMorph notNil and: [theMorph visible not]] whileTrue: [
- currentIndex < index
- ifTrue: [index := index + 1]
- ifFalse: [index := index - 1].
- (index < 1 or: [index > max]) ifTrue: [^ self].
- theMorph := scroller submorphs at: index.
- ].
- self setSelectedMorph: theMorph.!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>sortingSelector: (in category 'accessing') -----
- sortingSelector: s
-
- sortingSelector := s!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>specialKeyPressed: (in category 'event handling') -----
- specialKeyPressed: asciiValue
-
- (self arrowKey: asciiValue)
- ifTrue: [^ true].
-
- asciiValue = 27 "escape"
- ifTrue: [
- self currentEvent shiftPressed
- ifTrue: [self currentWorld putUpWorldMenuFromEscapeKey]
- ifFalse: [self yellowButtonActivity: false].
- ^ true].
-
- ^ false!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>startDrag: (in category 'drag and drop') -----
- startDrag: evt
-
- | itemMorph |
- evt hand hasSubmorphs ifTrue: [^ self].
- self model okToChange ifFalse: [^ self].
-
- itemMorph := scroller submorphs
- detect: [:any | any highlightedForMouseDown]
- ifNone: [^ self].
-
- "Prepare visuals."
- itemMorph highlightForMouseDown: false.
- self setSelectedMorph: itemMorph.
-
- [ "Initiate drag."
- (self model dragPassengerFor: itemMorph inMorph: self) ifNotNil: [:passenger | | ddm |
- ddm := (self valueOfProperty: #dragTransferClass ifAbsent: [TransferMorph]) withPassenger: passenger from: self.
- ddm dragTransferType: (self model dragTransferTypeForMorph: self).
- ddm updateFromUserInputEvent: evt.
- self model dragStartedFor: itemMorph transferMorph: ddm.
- evt hand grabMorph: ddm].
- ] ensure: [
- Cursor normal show.
- evt hand releaseMouseFocus: self].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>startDrag:onItem: (in category 'obsolete') -----
- startDrag: evt onItem: itemMorph
- self removeObsoleteEventHandlers.!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>textColor (in category 'accessing') -----
- textColor
- ^ textColor ifNil: [Color black]!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>textColor: (in category 'accessing') -----
- textColor: aColor
- textColor := aColor.
- scroller submorphsDo: [:ea | ea color: textColor].!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>toggleExpandedState: (in category 'keyboard navigation') -----
- toggleExpandedState: aMorph
- aMorph toggleExpandedState.
- self adjustSubmorphPositions.
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>toggleExpandedState:event: (in category 'events') -----
- toggleExpandedState: aMorph event: event
- | oldState |
- "self setSelectedMorph: aMorph."
- event yellowButtonPressed ifTrue: [
- oldState := aMorph isExpanded.
- scroller submorphs copy do: [ :each |
- (each canExpand and: [each isExpanded = oldState]) ifTrue: [
- each toggleExpandedState.
- ].
- ].
- ] ifFalse: [
- aMorph toggleExpandedState.
- ].
- self adjustSubmorphPositions.
- !
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>unhighlightSelection (in category 'drawing') -----
- unhighlightSelection
- selectedMorph ifNotNil: [selectedMorph unhighlight]!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>update: (in category 'updating') -----
- update: aSymbol
- aSymbol == getSelectionSelector
- ifTrue:
- [self selection: self getCurrentSelectionItem.
- ^self].
- aSymbol == getListSelector
- ifTrue:
- [self list: self getList.
- ^self].
- ((aSymbol isKindOf: Array)
- and: [aSymbol notEmpty and: [aSymbol first == #openPath]])
- ifTrue:
- [^(scroller submorphs at: 1 ifAbsent: [^self])
- openPath: aSymbol allButFirst]!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>wantsDroppedMorph:event: (in category 'drag and drop') -----
- wantsDroppedMorph: aMorph event: anEvent
- ^ self model wantsDroppedMorph: aMorph event: anEvent inMorph: self!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph>>widthOfColumn: (in category 'private - caching') -----
- widthOfColumn: index
-
- self columns ifNil: [^ nil].
-
- "Try columns cache."
- (self columnsCache at: index)
- ifNotNil: [:cachedWidth | ^ cachedWidth].
-
- ^ (self columns at: index)
- ifNil: [nil]
- ifNotNil: [:widthOrSpec |
- "Fill columns cache."
- self columnsCache
- at: index
- put: (widthOrSpec isNumber
- ifTrue: [widthOrSpec]
- ifFalse: [widthOrSpec isBlock
- ifTrue: [widthOrSpec cull: self]
- ifFalse: [50 "fall back for bad spec"]])]!
Item was removed:
- Morph subclass: #SketchMorph
- instanceVariableNames: 'originalForm rotationStyle scalePoint framesToDwell rotatedForm keepAspectRatio'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Basic'!
-
- !SketchMorph commentStamp: '<historical>' prior: 0!
- The morph that results when the user draws a color bitmap using the PaintBox (SketchEditorMorph and PaintBoxMorph).
-
- forwardDirection is the angle at which the object will go forward. When the rotationStyle is not #normal, then forwardDirection is any angle, while the rotation is highly restricted. If flexed, this is remembered by the Transform morph. For non-normal rotationStyle, it is rotationDegrees.
-
- setupAngle (a property) is where the user put the green arrow to indicate which direction on the picture is forward. When #normal, draw the morph initially at (0.0 - setupAngle). The enclosing TransformationMorph then rotates it to the true angle.
-
- rotationDegrees In a #normal object, rotationDegrees is constant an equal to setupAngle.
- For non-normal, it is the direction the object is going.
-
- When repainting, set it back to its original state. The green arrow is set to setupAngle, and the sketch is shown as drawn originally (rotationDegrees = 0).
-
- rotationStyle = normal (turns), leftRight, upDown, fixed.
- When leftRight upDown or fixed, bit map has severe restrictions.
- !
Item was removed:
- ----- Method: SketchMorph class>>defaultNameStemForInstances (in category 'scripting') -----
- defaultNameStemForInstances
- ^ 'Sketch' translatedNoop!
Item was removed:
- ----- Method: SketchMorph class>>fromFile: (in category 'instance creation') -----
- fromFile: aFileName
- ^self fromStream: (FileStream readOnlyFileNamed: aFileName)!
Item was removed:
- ----- Method: SketchMorph class>>fromStream: (in category 'instance creation') -----
- fromStream: aStream
- ^self withForm: (ImageReadWriter formFromStream: aStream)!
Item was removed:
- ----- Method: SketchMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
- includeInNewMorphMenu
- "Not to be instantiated from the menu"
- ^ false!
Item was removed:
- ----- Method: SketchMorph class>>isSketchMorphClass (in category 'testing') -----
- isSketchMorphClass
- ^true!
Item was removed:
- ----- Method: SketchMorph class>>openEditor (in category 'instance creation') -----
- openEditor
- "Create a new SketchMorph and open a SketchMorphEditor on it.
- Answers the painted SketchMorph."
- "SketchMorph openEditor"
- | newSketch |
- newSketch := (self
- withForm: (Form extent: 100 @ 100 depth: Display depth)) center: self currentWorld center;
- openInWorld;
- editDrawing.
- ^ newSketch!
Item was removed:
- ----- Method: SketchMorph class>>withForm: (in category 'instance creation') -----
- withForm: aForm
- "Note: 'SketchMorph withForm: zz' is MUCH faster
- than 'SketchMorph new form: zz'."
-
- ^ self basicNew initializeWith: aForm!
Item was removed:
- ----- Method: SketchMorph>>addBorderToShape: (in category 'menu') -----
- addBorderToShape: evt
- | str borderWidth borderedForm r |
- str := UIManager default
- request: 'Please enter the desired border width' translated
- initialAnswer: '0'.
- borderWidth := Integer readFrom: (ReadStream on: str).
- (borderWidth between: 1 and: 10) ifFalse: [^ self].
-
- "Take care of growing appropriately. Does this lose the reg point?"
- borderedForm := originalForm shapeBorder: Color black width: borderWidth.
- r := borderedForm rectangleEnclosingPixelsNotOfColor: Color transparent.
- self form: (borderedForm copy: r).
- !
Item was removed:
- ----- Method: SketchMorph>>addCustomMenuItems:hand: (in category 'menu') -----
- addCustomMenuItems: aCustomMenu hand: aHandMorph
- "Add custom menu items"
-
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- aCustomMenu add: 'restore base graphic' translated target: self action: #restoreBaseGraphicFromMenu.
- aCustomMenu add: 'call this my base graphic' translated target: self action: #callThisBaseGraphic.
- aCustomMenu add: 'choose new graphic...' translated target: self action: #chooseNewGraphic.
- aCustomMenu addLine.
- aCustomMenu add: 'set as background' translated target: rotatedForm action: #setAsBackground.
- self addPaintingItemsTo: aCustomMenu hand: aHandMorph!
Item was removed:
- ----- Method: SketchMorph>>addFillStyleMenuItems:hand: (in category 'menus') -----
- addFillStyleMenuItems: aMenu hand: aHand
- "Do nothing here - we do not allow changing the fill style of a SketchMorph yet."!
Item was removed:
- ----- Method: SketchMorph>>addToggleItemsToHaloMenu: (in category 'menus') -----
- addToggleItemsToHaloMenu: aCustomMenu
- "Add toggle-items to the halo menu"
- super addToggleItemsToHaloMenu: aCustomMenu.
- Preferences noviceMode
- ifFalse: [""aCustomMenu
- addUpdating: #useInterpolationString
- target: self
- action: #toggleInterpolation]!
Item was removed:
- ----- Method: SketchMorph>>baseGraphic (in category 'e-toy support') -----
- baseGraphic
- "Answer my base graphic"
-
- ^ self valueOfProperty: #baseGraphic ifAbsent:
- [self setProperty: #baseGraphic toValue: originalForm.
- ^ originalForm]!
Item was removed:
- ----- Method: SketchMorph>>baseGraphic: (in category 'e-toy support') -----
- baseGraphic: aForm
- "Remember the given form as the receiver's base graphic"
-
- ^ self setProperty: #baseGraphic toValue: aForm!
Item was removed:
- ----- Method: SketchMorph>>blur (in category 'menu') -----
- blur
-
- Cursor wait showWhile:[^(SketchMorph withForm: (self form approxGaussianBlur)) openInHand]!
Item was removed:
- ----- Method: SketchMorph>>callThisBaseGraphic (in category 'menu') -----
- callThisBaseGraphic
- "Set my baseGraphic to be the current form"
-
- | aGraphic |
- self isInWorld ifFalse: [^ self inform:
-
- 'oops, this menu is a for a morph that
- has been replaced, probably because a
- "look like" script was run. Please dismiss
- the menu and get a new one!!. Sorry!!' translated].
-
- ((aGraphic := self valueOfProperty: #baseGraphic)
- notNil and: [aGraphic ~= originalForm])
- ifTrue:
- [self setProperty: #baseGraphic toValue: originalForm]
- ifFalse:
- [self inform: 'this already *was* your baseGraphic' translated]!
Item was removed:
- ----- Method: SketchMorph>>canBeEnlargedWithB3D (in category 'drawing') -----
- canBeEnlargedWithB3D
- ^self
- valueOfProperty: #canBeEnlargedWithB3D
- ifAbsent: [
- | answer |
- answer := self rotatedForm colorsUsed allSatisfy: [ :c | c isTranslucent not].
- self setProperty: #canBeEnlargedWithB3D toValue: answer.
- answer
- ]!
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>>clearExtent:fillColor: (in category 'pen support') -----
- clearExtent: aPoint fillColor: aColor
- "Make this sketch have the given pixel dimensions and fill it with given color. Its previous contents are replaced."
-
- self form:
- ((Form extent: aPoint depth: Display depth) fillColor: aColor).
- !
Item was removed:
- ----- Method: SketchMorph>>collapse (in category 'menus') -----
- collapse
- "Replace the receiver with a collapsed rendition of itself."
-
- | w collapsedVersion a ht |
-
- (w := self world) ifNil: [^ self].
- collapsedVersion := (self imageForm scaledToSize: 50 at 50) asMorph.
- collapsedVersion setProperty: #uncollapsedMorph toValue: self.
- collapsedVersion on: #mouseUp send: #uncollapseSketch to: collapsedVersion.
-
- collapsedVersion setBalloonText: ('A collapsed version of {1}. Click to open it back up.' translated format: {self externalName}).
-
- self delete.
- w addMorphFront: (
- a := AlignmentMorph newRow
- hResizing: #shrinkWrap;
- vResizing: #shrinkWrap;
- borderWidth: 4;
- borderColor: Color white;
- addMorph: collapsedVersion;
- yourself).
- a setNameTo: self externalName.
- ht := (Smalltalk at: #SugarNavTab ifPresent: [:c | Project current world findA: c])
- ifNotNil: [:tab | tab height]
- ifNil: [80].
- a position: 0 at ht.
-
- collapsedVersion setProperty: #collapsedMorphCarrier toValue: a.
-
- (self valueOfProperty: #collapsedPosition) ifNotNil: [:priorPosition |
- a position: priorPosition].!
Item was removed:
- ----- Method: SketchMorph>>containsPoint: (in category 'geometry testing') -----
- containsPoint: aPoint
-
- ^ (self bounds containsPoint: aPoint) and:
- [(self rotatedForm isTransparentAt: aPoint - bounds origin) not]
- !
Item was removed:
- ----- Method: SketchMorph>>convertToCurrentVersion:refStream: (in category 'objects from disk') -----
- convertToCurrentVersion: varDict refStream: smartRefStrm
-
- scalePoint ifNil: [scalePoint := 1.0 at 1.0].
- ^super convertToCurrentVersion: varDict refStream: smartRefStrm.
-
- !
Item was removed:
- ----- Method: SketchMorph>>drawHighResolutionOn:in: (in category 'drawing') -----
- drawHighResolutionOn: aCanvas in: aRectangle
-
- | r finalClipRect scale sourceOrigin sourceExtent sourceRect biggerSource biggerDestExtent interForm offsetInBigger |
-
- r := aRectangle translateBy: aCanvas origin.
- finalClipRect := r intersect: (aCanvas clipRect translateBy: aCanvas origin).
- self canBeEnlargedWithB3D ifTrue: [
- (WarpBlt toForm: aCanvas form)
- clipRect: finalClipRect;
- sourceForm: originalForm;
- cellSize: 2; "installs a colormap"
- combinationRule: Form paint;
-
- copyQuad: originalForm boundingBox innerCorners
- toRect: r.
- ^self
- ].
- scale := aRectangle extent / originalForm extent.
- sourceOrigin := originalForm offset + (aCanvas clipRect origin - aRectangle origin / scale).
- sourceExtent := aCanvas clipRect extent / scale.
- sourceRect := sourceOrigin rounded extent: sourceExtent rounded.
- biggerSource := sourceRect expandBy: 1.
- biggerDestExtent := (biggerSource extent * scale) rounded.
- offsetInBigger := (sourceOrigin - biggerSource origin * scale) rounded.
-
- interForm := Form extent: biggerDestExtent depth: aCanvas depth.
- (originalForm copy: biggerSource)
- displayInterpolatedIn: interForm boundingBox
- on: interForm.
- aCanvas
- drawImage: interForm
- at: aCanvas clipRect origin
- sourceRect: (offsetInBigger extent: aCanvas clipRect extent).
-
-
- !
Item was removed:
- ----- Method: SketchMorph>>drawInterpolatedImage:on: (in category 'drawing') -----
- drawInterpolatedImage: aForm on: aCanvas
- "Draw the given form onto the canvas using the Balloon 3D engine"
- | engine |
- engine := Smalltalk at: #B3DRenderEngine
- ifPresent:[:b3d | b3d defaultForPlatformOn: aCanvas form].
- engine == nil ifTrue:[
- self useInterpolation: false.
- ^self generateRotatedForm].
- "Setup the engine"
- engine viewport: aCanvas form boundingBox.
- "Install the material to be used (using a plain white emission color)"
- engine material: ((Smalltalk at: #B3DMaterial) new emission: Color white).
- "Install the texture"
- engine texture: aForm.
- "Draw the mesh"
- engine render: ((Smalltalk at: #B3DIndexedQuadMesh) new plainTextureRect).
- "and finish"
- engine finish.!
Item was removed:
- ----- Method: SketchMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- aCanvas translucentImage: self rotatedForm at: bounds origin
- !
Item was removed:
- ----- Method: SketchMorph>>edgeDetect (in category 'menu') -----
- edgeDetect
-
- Cursor wait showWhile:[^(SketchMorph withForm: (self form edgeDetect)) openInHand]
- !
Item was removed:
- ----- Method: SketchMorph>>editDrawing (in category 'menu') -----
- editDrawing
- self flag: #deferred. "Don't allow this if the user is already in paint mode, because it creates a very strange situation."
- "costumee ifNotNil: [self forwardDirection: costumee direction]." "how say this?"
- self editDrawingIn: self pasteUpMorph forBackground: false
- !
Item was removed:
- ----- Method: SketchMorph>>editDrawingIn:forBackground: (in category 'menu') -----
- editDrawingIn: aPasteUpMorph forBackground: forBackground
- "Edit an existing sketch."
-
- | w bnds sketchEditor rotCenter aPaintTab aWorld aPaintBox |
- self world assureNotPaintingElse: [^self].
- w := aPasteUpMorph world.
- w prepareToPaint.
- w displayWorld.
- self visible: false.
- bnds := forBackground
- ifTrue: [aPasteUpMorph boundsInWorld]
- ifFalse:
- [bnds := self boundsInWorld expandBy: 60 @ 60.
- (aPasteUpMorph paintingBoundsAround: bnds center) merge: bnds].
- sketchEditor := SketchEditorMorph new.
- forBackground
- ifTrue: [sketchEditor setProperty: #background toValue: true].
- w addMorphFront: sketchEditor.
- sketchEditor
- initializeFor: self
- inBounds: bnds
- pasteUpMorph: aPasteUpMorph.
- rotCenter := self rotationCenter.
-
- sketchEditor afterNewPicDo:
- [:aForm :aRect | | tfx |
- self visible: true.
- self form: aForm.
- tfx := aPasteUpMorph transformFrom: aPasteUpMorph world.
- self topRendererOrSelf position: (tfx globalPointToLocal: aRect origin).
- self rotationStyle: sketchEditor rotationStyle.
- self forwardDirection: sketchEditor forwardDirection.
- (rotCenter notNil and: [(rotCenter = (0.5 @ 0.5)) not]) ifTrue:
- [self rotationCenter: rotCenter].
- (aPaintTab := (aWorld := self world) paintingFlapTab)
- ifNotNil: [aPaintTab hideFlap]
- ifNil: [(aPaintBox := aWorld paintBox) ifNotNil: [aPaintBox delete]].
- self presenter drawingJustCompleted: self.
-
- forBackground ifTrue: [self goBehind "shouldn't be necessary"]]
- ifNoBits:
- [ | pal |"If no bits drawn. Must keep old pic. Can't have no picture"
-
- self visible: true.
- aWorld := self currentWorld.
- "sometimes by now I'm no longer in a world myself, but we still need
- to get ahold of the world so that we can deal with the palette"
- ((pal := aPasteUpMorph standardPalette) notNil and: [pal isInWorld])
- ifTrue:
- [(aPaintBox := aWorld paintBox) ifNotNil: [aPaintBox delete].
- pal viewMorph: self]
- ifFalse:
- [(aPaintTab := (aWorld := self world) paintingFlapTab)
- ifNotNil: [aPaintTab hideFlap]
- ifNil: [(aPaintBox := aWorld paintBox) ifNotNil: [aPaintBox delete]]]]!
Item was removed:
- ----- Method: SketchMorph>>emboss (in category 'menu') -----
- emboss
-
- Cursor wait showWhile:[^(SketchMorph withForm: (self form emboss)) openInHand]
- !
Item was removed:
- ----- Method: SketchMorph>>erasePixelsOfColor: (in category 'menu') -----
- erasePixelsOfColor: aColor
- "Let the user specifiy a color such that all pixels of that color should be erased; then do the erasure"
- | newBounds |
- originalForm
- mapColor: aColor
- to: Color transparent.
- newBounds := originalForm rectangleEnclosingPixelsNotOfColor: Color transparent.
- self form: (originalForm copy: newBounds)!
Item was removed:
- ----- Method: SketchMorph>>erasePixelsUsing: (in category 'menu') -----
- erasePixelsUsing: evt
- "Let the user specifiy a color such that all pixels of that color should be erased; then do the erasure"
- self
- changeColorTarget: self
- selector: #rememberedColor:
- originalColor: nil
- hand: evt hand.
- self rememberedColor "color to erase"
- ifNil: [ ^ self ]
- ifNotNil:
- [ : chosenColor | self erasePixelsOfColor: chosenColor ]!
Item was removed:
- ----- Method: SketchMorph>>extent: (in category 'geometry') -----
- extent: newExtent
- "Change my scale to fit myself into the given extent.
- Avoid extents where X or Y is zero."
-
- newExtent isZero ifTrue: [ ^self ].
- self extent = newExtent ifTrue:[^self].
- self scalePoint: newExtent asFloatPoint / (originalForm extent max: 1 at 1).
- self layoutChanged.
- !
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 sorted: [ :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: SketchMorph>>flipHorizontal (in category 'e-toy support') -----
- flipHorizontal
-
- | r |
- r := self rotationCenter.
- self left: self left - (1.0 - (2 * r x) * self width).
- self form: (self form flipBy: #horizontal centerAt: self form center).
- self rotationCenter: (1 - r x) @ (r y).!
Item was removed:
- ----- Method: SketchMorph>>flipVertical (in category 'e-toy support') -----
- flipVertical
-
- | r |
- r := self rotationCenter.
- self top: self top - (1.0 - (2 * r y) * self height).
- self form: (self form flipBy: #vertical centerAt: self form center).
- self rotationCenter: r x @ (1 - r y).!
Item was removed:
- ----- Method: SketchMorph>>form (in category 'accessing') -----
- form
-
- ^ originalForm
- !
Item was removed:
- ----- Method: SketchMorph>>form: (in category 'accessing') -----
- form: aForm
- "Set the receiver's form"
-
- | oldForm topRenderer |
- oldForm := originalForm.
- (self hasProperty: #baseGraphic) ifFalse: [self setProperty: #baseGraphic toValue: aForm].
- originalForm := aForm.
- self rotationCenter: 0.5 at 0.5.
- self layoutChanged.
- topRenderer := self topRendererOrSelf.
-
- oldForm ifNotNil: [topRenderer position: topRenderer position + (oldForm extent - aForm extent // 2)].
- !
Item was removed:
- ----- Method: SketchMorph>>forwardDirection: (in category 'geometry eToy') -----
- forwardDirection: degrees
- "If not rotating normally, update my rotatedForm"
- super forwardDirection: degrees.
- rotationStyle == #normal ifFalse:[self layoutChanged].!
Item was removed:
- ----- Method: SketchMorph>>framesToDwell (in category 'accessing') -----
- framesToDwell
-
- ^ framesToDwell
- !
Item was removed:
- ----- Method: SketchMorph>>framesToDwell: (in category 'accessing') -----
- framesToDwell: anInteger
-
- framesToDwell := anInteger.
- !
Item was removed:
- ----- Method: SketchMorph>>generateInterpolatedForm (in category 'drawing') -----
- generateInterpolatedForm
- "Draw the given form onto the canvas using the Balloon 3D engine"
- | aCanvas extent |
- extent := (originalForm extent * scalePoint) asIntegerPoint.
- rotatedForm := Form extent: extent asIntegerPoint depth: originalForm depth.
- aCanvas := rotatedForm getCanvas.
- ^self drawInterpolatedImage: originalForm on: aCanvas!
Item was removed:
- ----- Method: SketchMorph>>generateRotatedForm (in category 'drawing') -----
- generateRotatedForm
- "Compute my rotatedForm and offsetWhenRotated."
-
- | scalePt smoothPix pair |
- scalePoint ifNil: [scalePoint := 1 @ 1].
- scalePt := scalePoint x abs @ scalePoint y abs.
- rotationStyle == #none ifTrue: [scalePt := 1 @ 1].
- smoothPix := (scalePt x < 1.0 or: [scalePt y < 1.0])
- ifTrue: [2]
- ifFalse: [1].
- rotationStyle = #leftRight
- ifTrue:
- [self heading asSmallAngleDegrees < 0.0
- ifTrue: [scalePt := scalePt x negated @ scalePt y]].
- rotationStyle = #upDown
- ifTrue:
- [self heading asSmallAngleDegrees abs > 90.0
- ifTrue: [scalePt := scalePt x @ scalePt y negated]].
- rotatedForm := scalePt = (1 @ 1)
- ifTrue: [originalForm]
- ifFalse:
- ["ar 11/19/2001: I am uncertain what happens in the case of rotationStyle ~~ normal"
-
- (rotationStyle == #normal and: [self useInterpolation])
- ifTrue: [^self generateInterpolatedForm].
- pair := WarpBlt
- rotate: originalForm
- degrees: 0
- center: originalForm boundingBox center
- scaleBy: scalePt
- smoothing: smoothPix.
- pair first]!
Item was removed:
- ----- Method: SketchMorph>>heading: (in category 'rotate scale and flex') -----
- heading: newHeading
- "If not rotating normally, change forward direction rather than heading"
- rotationStyle == #normal ifTrue:[^super heading: newHeading].
- self isFlexed
- ifTrue:[self forwardDirection: newHeading - owner rotationDegrees]
- ifFalse:[self forwardDirection: newHeading].
- self layoutChanged!
Item was removed:
- ----- Method: SketchMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- ^ self initializeWith: (ScriptingSystem formAtKey: 'Painting') deepCopy!
Item was removed:
- ----- Method: SketchMorph>>initializeToStandAlone (in category 'parts bin') -----
- initializeToStandAlone
- super initializeToStandAlone.
- self initializeWith: (ScriptingSystem formAtKey: 'Painting') deepCopy
-
- !
Item was removed:
- ----- Method: SketchMorph>>initializeWith: (in category 'initialization') -----
- initializeWith: aForm
-
- super initialize.
- originalForm := aForm.
- rotationStyle := #normal. "styles: #normal, #leftRight, #upDown, or #none"
- scalePoint := 1.0 at 1.0.
- framesToDwell := 1.
- rotatedForm := originalForm. "cached rotation of originalForm"
- self extent: originalForm extent.
- !
Item was removed:
- ----- Method: SketchMorph>>insertIntoMovie: (in category 'menu') -----
- insertIntoMovie: evt
-
- | movies aTarget |
- movies :=
- (self world rootMorphsAt: evt hand targetPoint)
- 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.
- !
Item was removed:
- ----- Method: SketchMorph>>isLikelyRecipientForMouseOverHalos (in category 'halos and balloon help') -----
- isLikelyRecipientForMouseOverHalos
- ^ true!
Item was removed:
- ----- Method: SketchMorph>>keepAspectRatio (in category 'accessing') -----
- keepAspectRatio
-
- ^ keepAspectRatio ifNil: [false]!
Item was removed:
- ----- Method: SketchMorph>>keepAspectRatio: (in category 'accessing') -----
- keepAspectRatio: aBoolean
-
- keepAspectRatio := aBoolean.!
Item was removed:
- ----- Method: SketchMorph>>layoutChanged (in category 'layout') -----
- layoutChanged
- "Update rotatedForm and compute new bounds."
-
- | priorBounds |
- fullBounds ifNotNil: [self changed].
-
- priorBounds := bounds.
-
- self flag: #refactor. "mt: Such side-effects in #layoutChanged can have a severe impact on performance. Better not overwrite it but manage the rotatedForm elsewhere and from there call #layoutChanged if bounds change. Also, just overwrite #extent to use the extent of the rotated form."
- self generateRotatedForm.
- bounds := bounds origin extent: rotatedForm extent.
-
- priorBounds ~= bounds
- ifTrue: [super layoutChanged].
-
- self changed.
- !
Item was removed:
- ----- Method: SketchMorph>>newForm: (in category 'other') -----
- newForm: aForm
- self originalForm: aForm.
- self layoutChanged!
Item was removed:
- ----- Method: SketchMorph>>nominalForm: (in category 'accessing') -----
- nominalForm: aForm
- "Ascribe the blank nominal form"
-
- originalForm := aForm.
- self rotationCenter: 0.5 at 0.5.
- self layoutChanged
- !
Item was removed:
- ----- Method: SketchMorph>>originalForm: (in category 'accessing') -----
- originalForm: aForm
- originalForm := aForm!
Item was removed:
- ----- Method: SketchMorph>>penOnMyForm (in category 'pen support') -----
- penOnMyForm
- "Support for experiments with drawing under program control. To get started, make a new SketchMorph in a morphic world. In an inspector, give it the desired pixel dimensions with clearExtent:fillColor:. Then use this method to get a pen to which you can send normal pen commands. Reveal the resulting drawing with revealPenStrokes."
-
- ^ Pen newOnForm: originalForm
- !
Item was removed:
- ----- Method: SketchMorph>>recolorPixelsOfColor:with: (in category 'menu') -----
- recolorPixelsOfColor: originalColor with: newColor
- "Let the user select a color to be remapped, and then a color to map that color to, then carry it out."
- | d newForm map |
- d := originalForm depth.
- newForm := Form extent: originalForm extent depth: d.
- map := (Color cachedColormapFrom: d to: d) copy.
- map at: (originalColor indexInMap: map) put: (newColor pixelValueForDepth: d).
- newForm copyBits: newForm boundingBox
- from: originalForm at: 0 at 0
- colorMap: map.
- self form: newForm.
- !
Item was removed:
- ----- Method: SketchMorph>>recolorPixelsUsing: (in category 'menu') -----
- recolorPixelsUsing: evt
- "Let the user select a color to be remapped, and then a color to map that color to, then carry it out."
- | originalColor newColor |
- self inform: 'choose the color you want to replace' translated.
- self
- changeColorTarget: self
- selector: #rememberedColor:
- originalColor: nil
- hand: evt hand.
- "color to replace"
- originalColor := self rememberedColor ifNil: [ ^ self ].
- self inform: 'now choose the color you want to replace it with' translated.
- self
- changeColorTarget: self
- selector: #rememberedColor:
- originalColor: originalColor
- hand: evt hand.
- "new color"
- newColor := self rememberedColor ifNil: [ ^ self ].
- self
- recolorPixelsOfColor: originalColor
- with: newColor!
Item was removed:
- ----- Method: SketchMorph>>reduceColorPalette: (in category 'menu') -----
- reduceColorPalette: evt
- "Let the user ask for a reduced number of colors in this sketch"
-
- | str nColors |
- str := UIManager default
- request: 'Please enter a number greater than one.
- (note: this cannot be undone, so answer zero
- to abort if you need to make a backup first)' translated
- initialAnswer: '256'.
- nColors := Integer readFrom: (ReadStream on: str).
- (nColors between: 2 and: 256) ifFalse: [^ self].
-
- originalForm := originalForm copyWithColorsReducedTo: nColors.
- rotatedForm := nil.
- self changed!
Item was removed:
- ----- Method: SketchMorph>>releaseCachedState (in category 'caching') -----
- releaseCachedState
- "Clear cache of rotated, scaled Form."
-
- super releaseCachedState.
- rotatedForm := nil.
- originalForm hibernate!
Item was removed:
- ----- Method: SketchMorph>>replaceSelfWithMovie (in category 'other') -----
- replaceSelfWithMovie
- "Replace this SketchMorph in its owner with a MovieMorph containing this sketch as its only frame. This allows a SketchMorph to be turned into a MovieMorph by just insering additional frames."
-
- | o movie |
- self changed.
- o := self owner.
- movie := MovieMorph new position: self referencePosition.
- movie insertFrames: (Array with: self).
- o ifNil: [^ movie].
- o addMorphFront: movie.
- ^ movie
- !
Item was removed:
- ----- Method: SketchMorph>>restoreBaseGraphic (in category 'menu') -----
- restoreBaseGraphic
- "Restore the receiver's base graphic"
-
- | aGraphic |
- ((aGraphic := self baseGraphic) notNil and:
- [aGraphic ~= originalForm])
- ifTrue:
- [self form: aGraphic]!
Item was removed:
- ----- Method: SketchMorph>>restoreBaseGraphicFromMenu (in category 'menu') -----
- restoreBaseGraphicFromMenu
- "Restore the base graphic -- invoked from a menu, so give interactive feedback if appropriate"
-
- self isInWorld ifFalse: [^ self inform:
-
- 'oops, this menu is a for a morph that
- has been replaced, probably because a
- "look like" script was run. Please dismiss
- the menu and get a new one!!. Sorry!!' translated].
-
- self baseGraphic = originalForm ifTrue: [^ self inform: 'This object is *already* showing its baseGraphic' translated].
- self restoreBaseGraphic!
Item was removed:
- ----- Method: SketchMorph>>revealPenStrokes (in category 'pen support') -----
- revealPenStrokes
- "This message must be sent after a sequence of pen strokes to make the resulting changes visible."
-
- rotatedForm := nil.
- self changed.
- !
Item was removed:
- ----- Method: SketchMorph>>rotatedForm (in category 'accessing') -----
- rotatedForm
-
- rotatedForm ifNil: [self layoutChanged].
- ^ rotatedForm
- !
Item was removed:
- ----- Method: SketchMorph>>rotationStyle (in category 'e-toy support') -----
- rotationStyle
-
- ^ rotationStyle
- !
Item was removed:
- ----- Method: SketchMorph>>rotationStyle: (in category 'e-toy support') -----
- rotationStyle: aSymbol
- "Set my rotation style to #normal, #leftRight, #upDown, or #none. Styles mean:
- #normal -- continuous 360 degree rotation
- #leftRight -- quantize angle to left or right facing
- #upDown -- quantize angle to up or down facing
- #none -- do not rotate
- Because my rendering code flips the form (see generateRotatedForm) we 'pre-flip' it here to preserve the same visual appearance.
- "
-
- | wasFlippedX wasFlippedY isFlippedX isFlippedY |
- wasFlippedX := rotationStyle == #leftRight
- and: [ self heading asSmallAngleDegrees < 0.0 ].
- wasFlippedY := rotationStyle == #upDown
- and: [ self heading asSmallAngleDegrees abs > 90.0 ].
-
- rotationStyle := aSymbol.
-
- isFlippedX := rotationStyle == #leftRight
- and: [ self heading asSmallAngleDegrees < 0.0 ].
- isFlippedY := rotationStyle == #upDown
- and: [ self heading asSmallAngleDegrees abs > 90.0 ].
-
- wasFlippedX == isFlippedX
- ifFalse: [self form: (self form flipBy: #horizontal centerAt: self form center)].
- wasFlippedY == isFlippedY
- ifFalse: [self form: (self form flipBy: #vertical centerAt: self form center)].
-
- self layoutChanged.
- !
Item was removed:
- ----- Method: SketchMorph>>scaleFactor (in category 'accessing') -----
- scaleFactor
- "Answer the number representing my scaleFactor, assuming the receiver to be unflexed (if flexed, the renderer's scaleFactor is called instead"
-
- | qty |
- ((qty := self scalePoint) isPoint) ifTrue: [^1.0].
- ^qty!
Item was removed:
- ----- Method: SketchMorph>>scalePoint (in category 'accessing') -----
- scalePoint
-
- scalePoint ifNil: [scalePoint := 1.0 at 1.0].
- ^ scalePoint
- !
Item was removed:
- ----- Method: SketchMorph>>scalePoint: (in category 'accessing') -----
- scalePoint: aPoint
-
- scalePoint := self keepAspectRatio
- ifTrue: [aPoint max: aPoint transposed]
- ifFalse: [aPoint].
- self layoutChanged.!
Item was removed:
- ----- Method: SketchMorph>>setNewFormFrom: (in category 'accessing') -----
- setNewFormFrom: formOrNil
- "Set the receiver's form as indicated. If nil is provided, then a default form will be used, possibly retrieved from the receiver's defaultValue property"
-
- | defaultImage |
- formOrNil ifNotNil: [^ self form: formOrNil].
- defaultImage := self defaultValueOrNil ifNil: [ScriptingSystem squeakyMouseForm].
- self form: defaultImage
- !
Item was removed:
- ----- Method: SketchMorph>>setRotationStyle (in category 'menu') -----
- setRotationStyle
- | selections labels sel reply |
- selections := #(normal leftRight upDown none).
- labels := #('rotate smoothly' 'left-right flip only' 'top-down flip only' 'don''t rotate').
- sel := labels at: (selections indexOf: self rotationStyle ifAbsent:[1]).
- labels := labels collect:[:lbl| sel = lbl ifTrue:['<on>', lbl translated] ifFalse:['<off>', lbl translated]].
- reply := UIManager default chooseFrom: labels values: selections.
- reply ifNotNil: [self rotationStyle: reply].
- !
Item was removed:
- ----- Method: SketchMorph>>sharpen (in category 'menu') -----
- sharpen
-
- Cursor wait showWhile:[^(SketchMorph withForm: (self form sharpen)) openInHand]
- !
Item was removed:
- ----- Method: SketchMorph>>toggleInterpolation (in category 'menu') -----
- toggleInterpolation
- ^self useInterpolation: self useInterpolation not!
Item was removed:
- ----- Method: SketchMorph>>useInterpolation (in category 'accessing') -----
- useInterpolation
- ^(self valueOfProperty: #useInterpolation ifAbsent:[false])
- and:[Smalltalk includesKey: #B3DRenderEngine]!
Item was removed:
- ----- Method: SketchMorph>>useInterpolation: (in category 'accessing') -----
- useInterpolation: aBool
- (aBool == true and: [ Smalltalk includesKey: #B3DRenderEngine ])
- ifTrue:[self setProperty: #useInterpolation toValue: aBool]
- ifFalse:[self removeProperty: #useInterpolation].
- self layoutChanged. "to regenerate the form"
- !
Item was removed:
- ----- Method: SketchMorph>>useInterpolationString (in category 'menu') -----
- useInterpolationString
- ^ (self useInterpolation
- ifTrue: ['<yes>']
- ifFalse: ['<no>'])
- , 'smooth image' translated!
Item was removed:
- ----- Method: SketchMorph>>wantsDirectionHandles (in category 'halos and balloon help') -----
- wantsDirectionHandles
- ^self valueOfProperty: #wantsDirectionHandles ifAbsent:[
- Preferences showDirectionHandles or:[Preferences showDirectionForSketches]]!
Item was removed:
- ----- Method: SketchMorph>>wantsDirectionHandles: (in category 'halos and balloon help') -----
- wantsDirectionHandles: aBool
- aBool == (Preferences showDirectionHandles or:[Preferences showDirectionForSketches])
- ifTrue:[self removeProperty: #wantsDirectionHandles]
- ifFalse:[self setProperty: #wantsDirectionHandles toValue: aBool].!
Item was removed:
- ----- Method: SketchMorph>>wantsRecolorHandle (in category 'e-toy support') -----
- wantsRecolorHandle
- "Answer whether the receiver would like a recolor handle to be
- put up for it. We'd want to disable this but for the moment
- that would cut off access to the button part of the properties
- sheet. So this remains a loose end."
- ^ false!
Item was removed:
- ----- Method: SketchMorph>>wantsSimpleSketchMorphHandles (in category 'accessing') -----
- wantsSimpleSketchMorphHandles
- "Answer true if my halo's simple handles should include the simple sketch morph handles."
- ^self isMemberOf: SketchMorph!
Item was removed:
- MorphicModel subclass: #Slider
- instanceVariableNames: 'slider value setValueSelector getValueSelector sliderShadow sliderColor descending minimumValue maximumValue quantum getMinimumValueSelector getMaximumValueSelector orientation'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
-
- !Slider commentStamp: 'mt 2/12/2016 10:21' prior: 0!
- I am a widget that helps users enter a numerically bounded value. I have a minimum and a maximum value. My thumb indicates my current value. My orientation can be vertical or horizontal, which is usually determined by the ratio of my extent. Nevertheless, you can force me to use a specific orientation,
-
- Note that I can be pluggable and get data from a model.!
Item was removed:
- ----- Method: Slider class>>includeInNewMorphMenu (in category 'new-morph participation') -----
- includeInNewMorphMenu
- "OK to instantiate"
- ^ true!
Item was removed:
- ----- Method: Slider class>>on:getValue:setValue: (in category 'instance creation') -----
- on: anObject getValue: getSel setValue: setSel
- "Answer a new instance of the receiver with
- the given selectors as the interface."
-
- ^self new
- on: anObject
- getValue: getSel
- setValue: setSel!
Item was removed:
- ----- Method: Slider class>>on:getValue:setValue:min:max:quantum: (in category 'instance creation') -----
- on: anObject getValue: getSel setValue: setSel min: min max: max quantum: quantum
- "Answer a new instance of the receiver with
- the given selectors as the interface."
-
- | instance |
- instance := self new
- quantum: quantum;
- on: anObject
- getValue: getSel
- setValue: setSel.
- min isSymbol
- ifTrue: [instance getMinimumValueSelector: min]
- ifFalse: [instance minimumValue: min].
- max isSymbol
- ifTrue: [instance getMaximumValueSelector: max]
- ifFalse: [instance maximumValue: max].
- ^ instance!
Item was removed:
- ----- Method: Slider class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ super themeProperties, {
- { #borderColor. 'Colors'. 'Color of the slider''s border.' }.
- { #borderWidth. 'Borders'. 'Width of the slider''s border.' }.
- { #color. 'Colors'. 'Background color of the slider.' }.
-
- { #thumbBorderColor. 'Colors'. 'Color of the slider thumb''s border.' }.
- { #thumbBorderWidth. 'Borders'. 'Width of the slider thumb''s border.' }.
- { #thumbColor. 'Colors'. 'Background color of the slider thumb.' }.
-
- { #thumbShadowModifier. 'Colors'. 'How to modify the thumb color to get the shadow color.' }.
- }!
Item was removed:
- ----- Method: Slider>>adoptPaneColor: (in category 'accessing - ui') -----
- adoptPaneColor: paneColor
-
- super adoptPaneColor: paneColor.
- paneColor ifNotNil: [:c | self sliderColor: c].!
Item was removed:
- ----- Method: Slider>>applyUserInterfaceTheme (in category 'updating') -----
- applyUserInterfaceTheme
-
- super applyUserInterfaceTheme.
-
- self setDefaultParameters.!
Item was removed:
- ----- Method: Slider>>computeSlider (in category 'geometry') -----
- computeSlider
- | r v |
- r := self roomToMove.
- v := self maximumValue = self minimumValue
- ifTrue: [0]
- ifFalse: [(value - self minimumValue) / (self maximumValue - self minimumValue)].
- self descending
- ifFalse:
- [self moveSliderTo: (self orientation == #horizontal
- ifTrue: [r topLeft + ((r width * v) asInteger @ 0)]
- ifFalse: [r topLeft + (0 @ (r height * v) asInteger)])]
- ifTrue:
- [self moveSliderTo: (self orientation == #horizontal
- ifTrue: [r bottomRight - ((r width * v) asInteger @ 0)]
- ifFalse: [r bottomRight - ((0 @ (r height * v) asInteger))])].
- self resizeSliderTo: self sliderExtent.!
Item was removed:
- ----- Method: Slider>>convertToCurrentVersion:refStream: (in category 'accessing') -----
- convertToCurrentVersion: varDict refStream: smartRefStrm
-
- (setValueSelector = #scrollBarValue:) ifTrue:[self setValueSelector: #vScrollBarValue:].
- ^ super convertToCurrentVersion: varDict refStream: smartRefStrm!
Item was removed:
- ----- Method: Slider>>defaultBounds (in category 'initialization') -----
- defaultBounds
- "answer the default bounds for the receiver"
- ^ 0 @ 0 corner: 16 @ 100!
Item was removed:
- ----- Method: Slider>>descending (in category 'accessing') -----
- descending
-
- ^ descending!
Item was removed:
- ----- Method: Slider>>descending: (in category 'accessing') -----
- descending: aBoolean
-
- descending := aBoolean.
- self computeSlider.!
Item was removed:
- ----- Method: Slider>>extent: (in category 'geometry') -----
- extent: newExtent
-
- (bounds extent closeTo: newExtent) ifTrue: [^ self].
-
- super extent: newExtent.
-
- self updateSlider.!
Item was removed:
- ----- Method: Slider>>getMaximumValue (in category 'model access') -----
- getMaximumValue
-
- self getMaximumValueSelector ifNotNil: [:selector |
- self maximumValue: (model perform: selector)].
- ^ self maximumValue!
Item was removed:
- ----- Method: Slider>>getMaximumValueSelector (in category 'accessing - model') -----
- getMaximumValueSelector
-
- ^ getMaximumValueSelector!
Item was removed:
- ----- Method: Slider>>getMaximumValueSelector: (in category 'accessing - model') -----
- getMaximumValueSelector: aSymbol
-
- getMaximumValueSelector := aSymbol.!
Item was removed:
- ----- Method: Slider>>getMinimumValue (in category 'model access') -----
- getMinimumValue
-
- self getMinimumValueSelector ifNotNil: [:selector |
- self minimumValue: (model perform: selector)].
- ^ self minimumValue!
Item was removed:
- ----- Method: Slider>>getMinimumValueSelector (in category 'accessing - model') -----
- getMinimumValueSelector
-
- ^ getMinimumValueSelector!
Item was removed:
- ----- Method: Slider>>getMinimumValueSelector: (in category 'accessing - model') -----
- getMinimumValueSelector: aSymbol
-
- getMinimumValueSelector := aSymbol.!
Item was removed:
- ----- Method: Slider>>getValue (in category 'model access') -----
- getValue
- "Updates internal value with model data if possible. Returns the updated value or the current one."
-
- self getValueSelector ifNotNil: [:selector |
- self value: (model perform: selector)].
- ^ self value!
Item was removed:
- ----- Method: Slider>>getValueSelector (in category 'accessing - model') -----
- getValueSelector
-
- ^ getValueSelector!
Item was removed:
- ----- Method: Slider>>getValueSelector: (in category 'accessing - model') -----
- getValueSelector: aSymbol
-
- getValueSelector := aSymbol.!
Item was removed:
- ----- Method: Slider>>hResizing (in category 'layout-properties') -----
- hResizing
- "Due to possible automatic orientation change on extent changes, we have to calculate the resizing property based on the current orientation. Otherwise, layout will break.There is, however, support for using the resizing property in layout properties if set."
-
- self layoutProperties ifNotNil: [:props |
- ^ props hResizing].
-
- ^ self orientation == #horizontal
- ifTrue: [#spaceFill]
- ifFalse: [#rigid]!
Item was removed:
- ----- Method: Slider>>hideSliderShadow (in category 'other events') -----
- hideSliderShadow
-
- sliderShadow hide.!
Item was removed:
- ----- Method: Slider>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
-
- value := 0.0.
- descending := false.
-
- self initializeSlider.
- self setDefaultParameters.!
Item was removed:
- ----- Method: Slider>>initializeSlider (in category 'initialization') -----
- initializeSlider
-
- slider := RectangleMorph
- newBounds: self totalSliderArea
- color: self thumbColor.
-
- sliderShadow := RectangleMorph
- newBounds: self totalSliderArea
- color: self pagingArea color.
-
- slider on: #mouseMove send: #scrollAbsolute: to: self.
- slider on: #mouseDown send: #mouseDownInSlider: to: self.
- slider on: #mouseUp send: #mouseUpInSlider: to: self.
-
- self addMorphFront: sliderShadow.
- self addMorphFront: slider.
-
- self computeSlider.
- self hideSliderShadow.!
Item was removed:
- ----- Method: Slider>>maximumValue (in category 'accessing') -----
- maximumValue
-
- ^ maximumValue ifNil: [1.0]!
Item was removed:
- ----- Method: Slider>>maximumValue: (in category 'accessing') -----
- maximumValue: aNumber
-
- maximumValue := aNumber.
- self setValue: self value.!
Item was removed:
- ----- Method: Slider>>minHeight (in category 'geometry') -----
- minHeight
-
- ^ self orientation == #horizontal
- ifTrue: [super minHeight max: self borderWidth + 1]
- ifFalse: [super minHeight max: self sliderThickness * 2]!
Item was removed:
- ----- Method: Slider>>minWidth (in category 'geometry') -----
- minWidth
-
- ^ self orientation == #horizontal
- ifTrue: [super minWidth max: self sliderThickness * 2]
- ifFalse: [super minWidth max: self borderWidth + 1]!
Item was removed:
- ----- Method: Slider>>minimumValue (in category 'accessing') -----
- minimumValue
- ^ minimumValue ifNil: [0.0]!
Item was removed:
- ----- Method: Slider>>minimumValue: (in category 'accessing') -----
- minimumValue: aNumber
-
- minimumValue := aNumber.
- self setValue: self value.!
Item was removed:
- ----- Method: Slider>>mouseDownInSlider: (in category 'other events') -----
- mouseDownInSlider: event
-
- slider borderStyle style == #raised
- ifTrue: [slider borderStyle: (BorderStyle inset width: slider borderWidth)].
-
- self showSliderShadow.!
Item was removed:
- ----- Method: Slider>>mouseUpInSlider: (in category 'other events') -----
- mouseUpInSlider: event
-
- slider borderStyle style == #inset
- ifTrue: [slider borderStyle: (BorderStyle raised width: slider borderWidth)].
-
- self hideSliderShadow.!
Item was removed:
- ----- Method: Slider>>moveSliderTo: (in category 'geometry') -----
- moveSliderTo: newPosition
- "Sliently move the slider (or thumb) to not trigger any #layoutChanged events."
-
- | delta |
- self flag: #codeDuplication. "mt: We need a better way to silently do position changes. See Morph >> #position:."
-
- delta := (newPosition - slider position) rounded.
- delta = (0 at 0) ifTrue: [^ self].
-
- slider privateFullMoveBy: delta.
- self changed.
- !
Item was removed:
- ----- Method: Slider>>on:getValue:setValue: (in category 'initialization') -----
- on: anObject getValue: getSel setValue: setSel
-
- self
- model: anObject;
- getValueSelector: getSel;
- setValueSelector: setSel;
- getValue.!
Item was removed:
- ----- Method: Slider>>orientation (in category 'accessing') -----
- orientation
-
- ^ orientation ifNil: [bounds isWide ifTrue: [#horizontal] ifFalse: [#vertical]]!
Item was removed:
- ----- Method: Slider>>orientation: (in category 'accessing') -----
- orientation: aSymbol
-
- orientation == aSymbol ifTrue: [^ self].
- orientation := aSymbol.
- self updateSlider.!
Item was removed:
- ----- Method: Slider>>pagingArea (in category 'accessing - ui') -----
- pagingArea
- ^self!
Item was removed:
- ----- Method: Slider>>quantum (in category 'accessing') -----
- quantum
-
- ^ quantum!
Item was removed:
- ----- Method: Slider>>quantum: (in category 'accessing') -----
- quantum: aNumber
-
- quantum := aNumber.
- self setValue: self value.!
Item was removed:
- ----- Method: Slider>>resizeSliderTo: (in category 'geometry') -----
- resizeSliderTo: newExtent
-
- slider extent: newExtent.!
Item was removed:
- ----- Method: Slider>>roomToMove (in category 'geometry') -----
- roomToMove
- ^ self totalSliderArea insetBy: (0 at 0 extent: self sliderExtent)!
Item was removed:
- ----- Method: Slider>>scrollAbsolute: (in category 'scrolling') -----
- scrollAbsolute: event
- | r p |
- r := self roomToMove.
- self orientation == #horizontal
- ifTrue: [r width = 0 ifTrue: [^ self]]
- ifFalse: [r height = 0 ifTrue: [^ self]].
- p := event targetPoint adhereTo: r.
- self descending
- ifFalse:
- [self setValueFraction: (self orientation == #horizontal
- ifTrue: [(p x - r left) asFloat / r width]
- ifFalse: [(p y - r top) asFloat / r height])]
- ifTrue:
- [self setValueFraction: (self orientation == #horizontal
- ifTrue: [(r right - p x) asFloat / r width]
- ifFalse: [(r bottom - p y) asFloat / r height])]!
Item was removed:
- ----- Method: Slider>>scrollBy: (in category 'scrolling') -----
- scrollBy: delta
-
- self setValue: self value + delta.!
Item was removed:
- ----- Method: Slider>>scrollToMaximum (in category 'scrolling') -----
- scrollToMaximum
-
- self setValue: self maximumValue.!
Item was removed:
- ----- Method: Slider>>scrollToMinimum (in category 'scrolling') -----
- scrollToMinimum
-
- self setValue: self minimumValue.!
Item was removed:
- ----- Method: Slider>>setDefaultParameters (in category 'initialization') -----
- setDefaultParameters
- "change the receiver's appareance parameters"
-
- self
- color: (self userInterfaceTheme color ifNil: [Color lightGray]);
- borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]);
- borderWidth: ((self userInterfaceTheme borderWidth ifNil: [1]) * RealEstateAgent scaleFactor) truncated.
-
- slider
- color: (self userInterfaceTheme thumbColor ifNil: [Color veryVeryLightGray]);
- borderColor: (self userInterfaceTheme thumbBorderColor ifNil: [Color gray: 0.6]);
- borderWidth: (self userInterfaceTheme thumbBorderWidth ifNil: [0]).
-
- sliderShadow
- borderWidth: slider borderWidth;
- borderColor: Color transparent.
-
- sliderColor := slider color.
- self updateSliderColor: slider color.!
Item was removed:
- ----- Method: Slider>>setValue: (in category 'model access') -----
- setValue: newValue
- "Either changes the value directly or tries to go the loop through the model. See #update:."
-
- self setValueSelector ifNotNil: [:selector |
- | trimmedValue |
- trimmedValue := self trimmedValue: newValue.
- "Only notify about changed values."
- trimmedValue ~= self value ifTrue: [
- model perform: selector with: trimmedValue]].
-
- (self setValueSelector isNil or: [self getValueSelector isNil])
- ifTrue: [self value: newValue].!
Item was removed:
- ----- Method: Slider>>setValueFraction: (in category 'support') -----
- setValueFraction: newValueFraction
-
- self setValue: (newValueFraction * (self maximumValue - self minimumValue)) + self minimumValue.!
Item was removed:
- ----- Method: Slider>>setValueSelector (in category 'accessing - model') -----
- setValueSelector
-
- ^ setValueSelector!
Item was removed:
- ----- Method: Slider>>setValueSelector: (in category 'accessing - model') -----
- setValueSelector: aSymbol
-
- setValueSelector := aSymbol.!
Item was removed:
- ----- Method: Slider>>showSliderShadow (in category 'other events') -----
- showSliderShadow
-
- sliderShadow color: self sliderShadowColor.
- sliderShadow cornerStyle: slider cornerStyle.
- sliderShadow privateBounds: slider bounds. "mt: Avoid #layoutChanged. See #moveSliderTo:."
- sliderShadow show.!
Item was removed:
- ----- Method: Slider>>sliderColor (in category 'accessing - ui') -----
- sliderColor
- "color scheme for the whole slider widget"
-
- ^ sliderColor ifNil: [self userInterfaceTheme thumbColor ifNil: [Color veryVeryLightGray]]!
Item was removed:
- ----- Method: Slider>>sliderColor: (in category 'accessing - ui') -----
- sliderColor: newColor
-
- sliderColor := newColor.
- self updateSliderColor: sliderColor.!
Item was removed:
- ----- Method: Slider>>sliderExtent (in category 'geometry') -----
- sliderExtent
- ^ self orientation == #horizontal
- ifTrue: [self sliderThickness @ self innerBounds height]
- ifFalse: [self innerBounds width @ self sliderThickness]!
Item was removed:
- ----- Method: Slider>>sliderShadowColor (in category 'accessing - ui') -----
- sliderShadowColor
-
- ^ ((self userInterfaceTheme thumbShadowModifier
- ifNil: [ [:c | c alpha: 0.7 ] ]) value: self sliderColor)!
Item was removed:
- ----- Method: Slider>>sliderThickness (in category 'geometry') -----
- sliderThickness
- ^ 7!
Item was removed:
- ----- Method: Slider>>thumb (in category 'accessing - ui') -----
- thumb
-
- ^ slider!
Item was removed:
- ----- Method: Slider>>thumbColor (in category 'accessing - ui') -----
- thumbColor
- "Color of the draggable 'thumb'"
- ^ self sliderColor!
Item was removed:
- ----- Method: Slider>>totalSliderArea (in category 'geometry') -----
- totalSliderArea
- ^ self innerBounds!
Item was removed:
- ----- Method: Slider>>trimmedValue: (in category 'support') -----
- trimmedValue: aValue
-
- | trimmedValue |
- trimmedValue := aValue min: self maximumValue max: self minimumValue.
- self quantum ifNotNil: [:q | trimmedValue := trimmedValue roundTo: q].
- ^ trimmedValue
- !
Item was removed:
- ----- Method: Slider>>truncate (in category 'accessing') -----
- truncate
-
- ^ self quantum == 1!
Item was removed:
- ----- Method: Slider>>truncate: (in category 'accessing') -----
- truncate: aBoolean
-
- self quantum: (aBoolean ifTrue: [1] ifFalse: [nil]).!
Item was removed:
- ----- Method: Slider>>update: (in category 'updating') -----
- update: aSymbol
- "Update the value."
-
- super update: aSymbol.
-
- aSymbol = self getValueSelector ifTrue: [self getValue. ^ self].
- aSymbol = self getMinimumValueSelector ifTrue: [self getMinimumValue. ^ self].
- aSymbol = self getMaximumValueSelector ifTrue: [self getMaximumValue. ^ self].!
Item was removed:
- ----- Method: Slider>>updateSlider (in category 'updating') -----
- updateSlider
- "Updates layout properties of the slider."
-
- slider bounds: self totalSliderArea.
- sliderShadow bounds: slider bounds.
-
- self computeSlider.
- !
Item was removed:
- ----- Method: Slider>>updateSliderColor: (in category 'updating') -----
- updateSliderColor: aColor
-
- slider color: aColor.
- sliderShadow color: self sliderShadowColor.!
Item was removed:
- ----- Method: Slider>>vResizing (in category 'layout-properties') -----
- vResizing
- "Due to possible automatic orientation change on extent changes, we have to calculate the resizing property based on the current orientation. Otherwise, layout will break. There is, however, support for using the resizing property in layout properties if set."
-
- self layoutProperties ifNotNil: [:props |
- ^ props vResizing].
-
- ^ self orientation == #vertical
- ifTrue: [#spaceFill]
- ifFalse: [#rigid]!
Item was removed:
- ----- Method: Slider>>value (in category 'accessing') -----
- value
-
- ^ value!
Item was removed:
- ----- Method: Slider>>value: (in category 'accessing') -----
- value: newValue
-
- | t |
- t := self trimmedValue: newValue.
- t = value ifTrue: [^ self].
-
- value := t.
- self computeSlider.!
Item was removed:
- ----- Method: Slider>>wantsSlot (in category 'testing') -----
- wantsSlot
- "For now do it the old way, until we sort this out"
- ^ true!
Item was removed:
- TextEditor subclass: #SmalltalkEditor
- instanceVariableNames: ''
- classVariableNames: 'WordBoundariesBackward WordBoundariesForward'
- poolDictionaries: ''
- category: 'Morphic-Text Support'!
-
- !SmalltalkEditor commentStamp: 'jmv 8/8/2009 15:10' prior: 0!
- The editor built specifically for Smalltalk code!
Item was removed:
- ----- Method: SmalltalkEditor class>>initialize (in category 'class initialization') -----
- initialize
- "SmalltalkEditor initialize"
-
- self initializeCmdKeyShortcuts.
- self initializeShiftCmdKeyShortcuts.
- self initializeYellowButtonMenu.
- self initializeShiftedYellowButtonMenu.
-
- self initializeWordBoundaries.!
Item was removed:
- ----- Method: SmalltalkEditor class>>initializeCmdKeyShortcuts (in category 'keyboard shortcut tables') -----
- initializeCmdKeyShortcuts
- "Initialize the (unshifted) command-key (or alt-key) shortcut table."
- "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest"
- "SmalltalkEditor initialize"
- | cmds |
- super initializeCmdKeyShortcuts.
- cmds := #($b #browseIt: $d #doIt: $i #inspectIt: $l #cancel: $m #implementorsOfIt: $n #sendersOfIt: $o #spawnIt: $p #printIt: $q #querySymbol: $s #save: ).
- 1 to: cmds size
- by: 2
- do: [ : i | cmdActions at: (cmds at: i) asciiValue + 1 put: (cmds at: i + 1)].
- "Set up type-method argument hot keys, 1-4.."
- '1234' do:
- [ : eachKeyboardChar |
- cmdActions
- at: eachKeyboardChar asciiValue + 1
- put: #typeMethodArgument: ]!
Item was removed:
- ----- Method: SmalltalkEditor class>>initializeShiftCmdKeyShortcuts (in category 'keyboard shortcut tables') -----
- initializeShiftCmdKeyShortcuts
- "Initialize the shift-command-key (or control-key) shortcut table."
- "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest"
- | cmds |
- super initializeShiftCmdKeyShortcuts.
- cmds := #(
- $a argAdvance:
- $b browseItHere:
- $d debugIt:
- $e methodStringsContainingIt:
- $f displayIfFalse:
- $g fileItIn:
- $i exploreIt:
- $n referencesToIt:
- $s invokePrettyPrint:
- $t displayIfTrue:
- $v pasteInitials:
- $w methodNamesContainingIt:
- ).
- 1 to: cmds size by: 2 do: [ :i |
- shiftCmdActions at: ((cmds at: i) asciiValue + 1) put: (cmds at: i + 1). "plain keys"
- shiftCmdActions at: ((cmds at: i) asciiValue - 32 + 1) put: (cmds at: i + 1). "shifted keys"
- shiftCmdActions at: ((cmds at: i) asciiValue - 96 + 1) put: (cmds at: i + 1). "ctrl keys"
- ].
- "shift+cmd _ (underscore)"
- shiftCmdActions at: $_ asciiValue+1 put: #flattenSelection:!
Item was removed:
- ----- Method: SmalltalkEditor class>>initializeShiftedYellowButtonMenu (in category 'keyboard shortcut tables') -----
- initializeShiftedYellowButtonMenu
- "Initialize the yellow button pop-up menu and corresponding messages."
-
- "SmalltalkEditor initialize"
-
- shiftedYellowButtonMenu := MenuMorph fromArray: StringHolder yellowButtonMenuItems.!
Item was removed:
- ----- Method: SmalltalkEditor class>>initializeWordBoundaries (in category 'class initialization') -----
- initializeWordBoundaries
- "
- self initializeWordBoundaries.
- "
-
- WordBoundariesBackward := '([{''"|^.',
- String space,
- Character nbsp asString,
- String tab,
- String cr,
- String lf.
-
- WordBoundariesForward := ')]}''"|^.',
- String space,
- Character nbsp asString,
- String tab,
- String cr,
- String lf.!
Item was removed:
- ----- Method: SmalltalkEditor class>>initializeYellowButtonMenu (in category 'keyboard shortcut tables') -----
- initializeYellowButtonMenu
- "Initialize the yellow button pop-up menu and corresponding messages."
-
- "SmalltalkEditor initialize"
-
- yellowButtonMenu := MenuMorph fromArray: StringHolder yellowButtonMenuItems!
Item was removed:
- ----- Method: SmalltalkEditor>>blinkPrevParen: (in category 'parenblinking') -----
- blinkPrevParen: aCharacter
- "Same as super, but tries to follow the Smalltalk syntax."
-
- | openDelimiter closeDelimiter level string here inside |
- string := paragraph text string.
- here := pointBlock stringIndex.
- openDelimiter := aCharacter.
- closeDelimiter := '([{' at: (')]}' indexOf: openDelimiter).
- level := 1.
- inside := nil. "Tricky."
- (here > 1 and: [ (string at: here - 1) = $$ ]) ifTrue: [ ^self ]. "Just a character literal."
- [ level > 0 and: [ here > 1 ] ] whileTrue: [
- | hereChar |
- hereChar := string at: (here := here - 1).
- inside "Are we inside a comment or string literal?"
- ifNotNil: [ "Yes."
- hereChar = inside ifTrue: [
- (here > 1 and: [ (string at: here - 1) ~= inside ])
- ifTrue: [ inside := nil ]
- ifFalse: [ here := here - 1 ] ] ]
- ifNil: [
- (here > 1 and: [ (string at: here - 1) = $$ ]) "Just a character literal."
- ifTrue: [ here := here - 1 ]
- ifFalse: [
- hereChar
- caseOf: {
- [ closeDelimiter ] -> [
- (level := level - 1) = 0 ifTrue: [
- ^self blinkParenAt: here ] ].
- [ openDelimiter ] -> [ level := level + 1 ].
- [ $" ] -> [ inside := $" ].
- [ $' ] -> [ inside := $' ] }
- otherwise: [] ] ] ]!
Item was removed:
- ----- Method: SmalltalkEditor>>buttonForIt (in category 'do-its') -----
- buttonForIt
-
- ^ self doItButtonFromSelection ifNotNil: [:e | e openInHand]!
Item was removed:
- ----- Method: SmalltalkEditor>>changeEmphasis: (in category 'editing keys') -----
- changeEmphasis: characterStream
- "Change emphasis without styling if necessary. NOTE THAT [cmd]+[1..4] will insert the name of the method argument number n."
-
- self styler ifNil: [^super changeEmphasis: characterStream].
- ^ self styler evaluateWithoutStyling: [super changeEmphasis: characterStream].!
Item was removed:
- ----- Method: SmalltalkEditor>>doItButtonFromSelection (in category 'do-its') -----
- doItButtonFromSelection
-
- | button string cm |
- self lineSelectAndEmptyCheck: [^ nil].
- button := SimpleButtonMorph new.
- string := self selection.
- (model respondsTo: #doItReceiver)
- ifTrue: [
- button setProperty: #rcvr toValue: model doItReceiver.
- button setProperty: #ctxt toValue: model doItContext].
-
- cm := (button valueOfProperty: #rcvr) class compilerClass new
- compiledMethodFor: string readStream
- in: (button valueOfProperty: #ctxt)
- to: (button valueOfProperty: #rcvr)
- notifying: nil
- ifFail: [^ nil].
- button setProperty: #cm toValue: cm.
- button target: [:b |
- [(b valueOfProperty: #cm) valueWithReceiver: (b valueOfProperty: #rcvr) arguments:
- ((b valueOfProperty: #ctxt) ifNotNil: [{(b valueOfProperty: #ctxt) }] ifNil: [#()])]
- on: OutOfScopeNotification
- do: [ :ex | ex resume: true]];
- actionSelector: #value:;
- arguments: {button}.
- button label: string.
- ^ button.
- !
Item was removed:
- ----- Method: SmalltalkEditor>>emphasisExtras (in category 'editing keys') -----
- emphasisExtras
- ^#(
- 'Do it'
- 'Print it'
- 'Style it'
- 'Link to comment of class'
- 'Link to definition of class'
- 'Link to hierarchy of class'
- 'Link to help on class'
- 'Link to method'
- 'URL Link...'
- 'Custom attribute...'
- ).!
Item was removed:
- ----- Method: SmalltalkEditor>>flattenSelection: (in category 'editing keys') -----
- flattenSelection: dummy
- "Replace all lines and consecutive whitespace characters of the current selection with one line separated by single spaces."
- self replaceSelectionWith: self selection string condensedIntoOneLine.
- ^ true!
Item was removed:
- ----- Method: SmalltalkEditor>>handleEmphasisExtra:with: (in category 'editing keys') -----
- handleEmphasisExtra: index with: aKeyboardEvent
- "Handle an extra emphasis menu item"
- | action attribute thisSel |
- action := {
- [attribute := TextDoIt new.
- thisSel := attribute analyze: self selection].
- [attribute := TextPrintIt new.
- thisSel := attribute analyze: self selection].
- [thisSel := self styleSelection].
- [attribute := TextLink new.
- thisSel := attribute analyze: self selection asString with: 'Comment'].
- [attribute := TextLink new.
- thisSel := attribute analyze: self selection asString with: 'Definition'].
- [attribute := TextLink new.
- thisSel := attribute analyze: self selection asString with: 'Hierarchy'].
- [attribute := TextLink new.
- thisSel := attribute analyze: self selection asString with: 'Help'].
- [attribute := TextLink new.
- thisSel := attribute analyze: self selection asString].
- [attribute := TextURL new.
- thisSel := attribute analyze: self selection asString].
- [thisSel := self selection.
- attribute := self requestAttribute].
- ["Edit hidden info"
- thisSel := self hiddenInfo. "includes selection"
- attribute := TextEmphasis normal].
- ["Copy hidden info"
- self copyHiddenInfo.
- ^true]. "no other action"
- } at: index.
- action value.
-
- thisSel ifNil: [^ true]. "Could not figure out what to link to"
-
- (thisSel isEmpty and: [attribute notNil])
- ifTrue: [
- | oldAttributes |
- "only change emphasisHere while typing"
- oldAttributes := paragraph text attributesAt: self pointIndex.
- emphasisHere := Text addAttribute: attribute toArray: oldAttributes]
- ifFalse: [
- self replaceSelectionWith: (attribute ifNil: [thisSel] ifNotNil: [thisSel asText addAttribute: attribute]) ].
- ^ true!
Item was removed:
- ----- Method: SmalltalkEditor>>invokePrettyPrint: (in category 'editing keys') -----
- invokePrettyPrint: dummy
- self prettyPrint: false.
- ^ true!
Item was removed:
- ----- Method: SmalltalkEditor>>methodArgument: (in category 'private') -----
- methodArgument: anInteger
- ^ (ReadStream on: self text asString) nextLine
- ifNil: [ String empty ]
- ifNotNil:
- [ : line |
- line substrings
- at: 2 * anInteger
- ifAbsent: [ String empty ] ]!
Item was removed:
- ----- Method: SmalltalkEditor>>nextWord: (in category 'private') -----
- nextWord: position
- | string index boundaryCharacters |
- string := self string.
- index := position - 1.
- [ (index
- between: 1
- and: string size) and: [ (string at: index) isSeparator ] ] whileTrue: [ index := index + 1 ].
- boundaryCharacters := WordBoundariesForward.
-
- ((index
- between: 1
- and: string size) and: [ boundaryCharacters includes: (string at: index) ])
- ifTrue:
- [ index := index + 1 ]
- ifFalse:
- [ [ (index
- between: 1
- and: string size) and: [ (boundaryCharacters includes: (string at: index)) not ] ] whileTrue: [ index := index + 1 ] ].
- ^ index!
Item was removed:
- ----- Method: SmalltalkEditor>>previousWord: (in category 'private') -----
- previousWord: position
- | string index boundaryCharacters |
- string := self string.
- index := position.
- "First, get out of whitespace."
- [ (index
- between: 2
- and: string size) and: [ (string at: index) isSeparator ] ] whileTrue: [ index := index - 1 ].
- boundaryCharacters := WordBoundariesBackward.
-
- "Are we at a boundary character?"
- ((index
- between: 2
- and: string size) and: [ boundaryCharacters includes: (string at: index) ])
- ifTrue:
- [ "yes, select it and any following whitespace of this line."
- index := index - 1 ]
- ifFalse:
- [ "no, select to the next boundary character"
- [ (index
- between: 1
- and: string size) and: [ (boundaryCharacters includes: (string at: index)) not ] ] whileTrue: [ index := index - 1 ] ].
- ^ index + 1!
Item was removed:
- ----- Method: SmalltalkEditor>>requestAttribute (in category 'editing keys') -----
- requestAttribute
-
- | attribute input |
- input := ''.
- [input := Project uiManager
- request: (input
- ifEmpty: ['Enter expression for text attribute:' translated]
- ifNotEmpty: ['This expression does not answer a TextAttribute, please correct it:' translated])
- initialAnswer: input.
- input isEmptyOrNil ifTrue: [^ nil].
- attribute := Compiler evaluate: input]
- doWhileFalse: [attribute respondsTo: #emphasizeScanner:].
- ^ attribute!
Item was removed:
- ----- Method: SmalltalkEditor>>spyOnIt (in category 'do-its') -----
- spyOnIt
-
- ^ MessageTally spyOn: [self evaluateSelection]!
Item was removed:
- ----- Method: SmalltalkEditor>>styleIt (in category 'do-its') -----
- styleIt
-
- ^ self styleSelection!
Item was removed:
- ----- Method: SmalltalkEditor>>styleSelection (in category 'do-its') -----
- styleSelection
-
- | styler |
- self lineSelectAndEmptyCheck: [^ ''].
- styler := self styler ifNil: [(TextStyler for: #Smalltalk) ifNotNil: [:c | c new]].
- ^ styler styledTextFor: self selection!
Item was removed:
- ----- Method: SmalltalkEditor>>styler (in category 'accessing') -----
- styler
- "Answers the styler for this editor. Only code editors support syntax highlighting"
- ^ self morph editView styler
- !
Item was removed:
- ----- Method: SmalltalkEditor>>tallyIt (in category 'do-its') -----
- tallyIt
-
- ^ self tallySelection!
Item was removed:
- ----- Method: SmalltalkEditor>>tallySelection (in category 'do-its') -----
- tallySelection
- "Treat the current selection as an expression; evaluate it and return the time took for this evaluation"
- | code result rcvr ctxt v |
- self lineSelectAndEmptyCheck: [^ self].
-
- (model respondsTo: #doItReceiver)
- ifTrue: [ rcvr := model doItReceiver.
- ctxt := model doItContext]
- ifFalse: [rcvr := ctxt := nil].
- result := [ | cm |
- code := self selectionAsStream.
- cm := rcvr class evaluatorClass new
- compiledMethodFor: code
- in: ctxt
- to: rcvr
- notifying: self
- ifFail: [morph flash. ^ self].
- Time millisecondsToRun:
- [v := cm valueWithReceiver: rcvr arguments: (ctxt ifNil: [#()] ifNotNil: [{ctxt}]) ].
- ]
- on: OutOfScopeNotification
- do: [ :ex | ex resume: true].
-
- UIManager default
- inform: ('<b>Expression</b>{1}<br>{2}<br><br><b>Time</b> (compile and execute)<br>{3} ms<br><br><b>Result</b><br>{4}' translated format: {
- rcvr ifNil: [''] ifNotNil: [' (', (rcvr printString truncateWithElipsisTo: 20), ')'].
- (code contents truncateWithElipsisTo: 200) copyReplaceAll: String cr with: '<br>'.
- result printString.
- v printString truncateWithElipsisTo: 100}) asTextFromHtml.!
Item was removed:
- ----- Method: SmalltalkEditor>>typeMethodArgument: (in category 'private') -----
- typeMethodArgument: aKeyboardEvent
- "Replace the current text selection with the name of the method argument represented by the keyCode."
- | keyCode |
- keyCode := ('1234'
- indexOf: aKeyboardEvent keyCharacter
- ifAbsent: [1]).
- self addString: (self methodArgument: keyCode).
- ^ false!
Item was removed:
- ----- Method: SmartRefStream>>bookPageMorphbosfcepcbbfgcc0 (in category '*Morphic-conversion') -----
- bookPageMorphbosfcepcbbfgcc0
- "BookPageMorph->PasteUpMorph. For reading in old BookMorphs."
-
- ^ PasteUpMorph
- !
Item was removed:
- ----- Method: SmartRefStream>>clippingMorphbosfcep0 (in category '*Morphic-conversion') -----
- clippingMorphbosfcep0
- ^ PasteUpMorph!
Item was removed:
- ----- Method: SmartRefStream>>clippingMorphbosfcepc0 (in category '*Morphic-conversion') -----
- clippingMorphbosfcepc0
- "ClippingMorph->PasteUpMorph. For reading in old BookMorphs."
-
- ^ PasteUpMorph!
Item was removed:
- ----- Method: SmartRefStream>>dropShadowMorphbosfces0 (in category '*Morphic-conversion') -----
- dropShadowMorphbosfces0
-
- ^ Morph !
Item was removed:
- ----- Method: SmartRefStream>>layoutMorphbosfcepbbochvimol0 (in category '*Morphic-conversion') -----
- layoutMorphbosfcepbbochvimol0
- ^ AlignmentMorph!
Item was removed:
- ----- Method: SmartRefStream>>layoutMorphbosfcepcbbochvimol0 (in category '*Morphic-conversion') -----
- layoutMorphbosfcepcbbochvimol0
- ^ AlignmentMorph!
Item was removed:
- ----- Method: SmartRefStream>>morphicEventtcbks0 (in category '*Morphic-conversion') -----
- morphicEventtcbks0
- ^ MorphicEvent!
Item was removed:
- ----- Method: SmartRefStream>>morphicSoundEventtcbkss0 (in category '*Morphic-conversion') -----
- morphicSoundEventtcbkss0
- ^ MorphicUnknownEvent!
Item was removed:
- ----- Method: SmartRefStream>>multiNewParagraphttfclpomsswfpp0 (in category '*Morphic-conversion') -----
- multiNewParagraphttfclpomsswfpp0
- "Selector composed in SmartRefStream>>mapClass:"
- ^ NewParagraph!
Item was removed:
- ----- Method: SmartRefStream>>myMorphbosfce0 (in category '*Morphic-conversion') -----
- myMorphbosfce0
-
- reshaped at: #MyMorph put: #convertbosfce0:bosfce0:.
- "Be sure to define that conversion method in class Morph"
- ^ Morph!
Item was removed:
- ----- Method: SmartRefStream>>newMorphicEventts0 (in category '*Morphic-conversion') -----
- newMorphicEventts0
-
- ^ MorphicEvent!
Item was removed:
- ----- Method: SolidFillStyle>>addFillStyleMenuItems:hand:from: (in category '*Morphic-Balloon') -----
- addFillStyleMenuItems: aMenu hand: aHand from: aMorph
- ^ self asColor addFillStyleMenuItems: aMenu hand: aHand from: aMorph!
Item was removed:
- ImageMorph subclass: #Sonogram
- instanceVariableNames: 'lastX scrollDelta columnForm minVal maxVal pixValMap'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Sound-Synthesis'!
-
- !Sonogram commentStamp: '<historical>' prior: 0!
- Sonograms are imageMorphs that will repeatedly plot arrays of values as black on white columns moving to the right in time and scrolling left as necessary.!
Item was removed:
- ----- Method: Sonogram>>extent: (in category 'geometry') -----
- extent: newExtent
- super image: (Form extent: newExtent depth: Display depth).
- lastX := -1.
- columnForm := Form extent: (32//image depth)@(image height) depth: image depth.
- pixValMap := ((1 to: 256) collect:
- [:i | columnForm pixelValueFor: (Color gray: (256-i)/255.0)])
- as: Bitmap.
- !
Item was removed:
- ----- Method: Sonogram>>extent:minVal:maxVal:scrollDelta: (in category 'all') -----
- extent: extent minVal: min maxVal: max scrollDelta: d
- minVal := min.
- maxVal := max.
- scrollDelta := d.
- self extent: extent.
-
- " try following with scrolldelta = 1, 20, 200
- | s data |
- s := Sonogram new extent: 200 at 50
- minVal: 0.0 maxVal: 1.0 scrollDelta: 20.
- World addMorph: s.
- data := (1 to: 133) collect: [:i | 0.0].
- 1 to: 300 do:
- [:i | data at: (i\\133)+1 put: 1.0.
- s plotColumn: data.
- data at: (i\\133)+1 put: 0.0.
- World doOneCycleNow].
- s delete
- "!
Item was removed:
- ----- Method: Sonogram>>plotColumn: (in category 'all') -----
- plotColumn: dataArray
- | chm1 i normVal r |
- columnForm unhibernate.
- chm1 := columnForm height - 1.
- 0 to: chm1
- do:
- [:y |
- i := y * (dataArray size - 1) // chm1 + 1.
- normVal := ((dataArray at: i) - minVal) / (maxVal - minVal).
- normVal := normVal max: 0.0.
- normVal := normVal min: 1.0.
- columnForm bits at: chm1 - y + 1
- put: (pixValMap at: (normVal * 255.0) truncated + 1)].
- (lastX := lastX + 1) > (image width - 1) ifTrue: [self scroll].
- image
- copy: (r := lastX @ 0 extent: 1 @ image height)
- from: (32 // image depth - 1) @ 0
- in: columnForm
- rule: Form over.
- "self changed."
- self invalidRect: (r translateBy: self position)!
Item was removed:
- ----- Method: Sonogram>>scroll (in category 'all') -----
- scroll
- image copy: (scrollDelta at 0 extent: (image width-scrollDelta)@image height)
- from: image to: 0 at 0 rule: Form over.
- lastX := lastX - scrollDelta.
- self changed!
Item was removed:
- ----- Method: SparseLargeTable>>explorerContents (in category '*Morphic-Explorer') -----
- explorerContents
-
- ^ Array streamContents: [:stream |
- stream nextPut: (ObjectExplorerWrapper
- with: defaultValue
- name: 'defaultValue'
- model: self).
- self sparseElementsAndIndicesDo: [:element :index |
- stream nextPut: (ObjectExplorerWrapper
- with: element
- name: index printString
- model: self)]]!
Item was removed:
- Object subclass: #StandardScriptingSystem
- instanceVariableNames: ''
- classVariableNames: 'ClassVarNamesInUse FormDictionary HelpStrings StandardPartsBin'
- poolDictionaries: ''
- category: 'Morphic-Worlds'!
-
- !StandardScriptingSystem commentStamp: '<historical>' prior: 0!
- An instance of this is installed as the value of the global variable "ScriptingSystem". Client subclasses are invited, such as one used internally by squeak team for ongoing internal work.!
Item was removed:
- ----- Method: StandardScriptingSystem class>>cleanUp: (in category 'class initialization') -----
- cleanUp: agressive
- "Clean up unreferenced players. If agressive, reinitialize and nuke players"
-
- self removeUnreferencedPlayers.
- agressive ifTrue:[
- References keys do: [:k | References removeKey: k].
- ClassVarNamesInUse := nil.
- self initialize.
- ].!
Item was removed:
- ----- Method: StandardScriptingSystem class>>initialize (in category 'class initialization') -----
- initialize
- "Initialize the scripting system. Sometimes this method is vacuously changed just to get it in a changeset so that its invocation will occur as part of an update"
-
- (self environment at: #ScriptingSystem ifAbsent: [nil]) ifNil:
- [self environment at: #ScriptingSystem put: self new].
-
- ScriptingSystem
- initializeHelpStrings.
-
- self registerInFlapsRegistry.
-
- "StandardScriptingSystem initialize"!
Item was removed:
- ----- Method: StandardScriptingSystem class>>removeUnreferencedPlayers (in category 'class initialization') -----
- removeUnreferencedPlayers
- "Remove existing but unreferenced player references"
- "StandardScriptingSystem removeUnreferencedPlayers"
- References keys do:
- [ : key | | ref |
- ref := References at: key.
- ((ref respondsTo: #costume) and: [ ref costume pasteUpMorph isNil ]) ifTrue: [ References removeKey: key ] ]!
Item was removed:
- ----- Method: StandardScriptingSystem>>allClassVarNamesInSystem (in category 'utilities') -----
- allClassVarNamesInSystem
- "Compute and answer a set of all the class variable names known to the sytem from any class"
-
- | aList |
- aList := OrderedCollection new.
- Object withAllSubclasses do:
- [:c | aList addAll: c allClassVarNames].
- ^ aList asSet
-
- "ScriptingSystem allClassVarNamesInSystem"
- !
Item was removed:
- ----- Method: StandardScriptingSystem>>customizeForEToyUsers: (in category 'utilities') -----
- customizeForEToyUsers: aBoolean
- "If aBoolean is true, set things up for etoy users. If it's false, unset some of those things. Some things are set when switching into etoy mode but not reversed when switching out of etoy mode."
-
- #(
- (allowEtoyUserCustomEvents no reverse)
- (balloonHelpEnabled yes dontReverse)
- (debugHaloHandle no reverse)
- (modalColorPickers yes dontReverse)
- (oliveHandleForScriptedObjects no dontReverse)
- (uniqueNamesInHalos yes reverse)
- (useUndo yes dontReverse)
- (infiniteUndo no dontReverse)
- (warnIfNoChangesFile no reverse)
- (warnIfNoSourcesFile no reverse)) do:
- [:trip |
- (aBoolean or: [trip third == #reverse]) ifTrue:
- [Preferences setFlag: trip first toValue:
- ((trip second == #yes) & aBoolean) | ((trip second == #no) & aBoolean not)]]!
Item was removed:
- ----- Method: StandardScriptingSystem>>deletePrivateGraphics (in category 'form dictionary') -----
- deletePrivateGraphics
- "ScriptingSystem deletePrivateGraphics"
- self deletePrivateGraphics: self privateGraphics
- afterStoringToFileNamed: 'disGraphics'!
Item was removed:
- ----- Method: StandardScriptingSystem>>deletePrivateGraphics:afterStoringToFileNamed: (in category 'form dictionary') -----
- deletePrivateGraphics: nameList afterStoringToFileNamed: aFileName
- "This method is used to strip private graphics from the FormDictionary and store them on a file of the given name"
-
- | replacement toRemove aReferenceStream |
- toRemove := Dictionary new.
- replacement := FormDictionary at: #Gets.
-
- nameList do:
- [:aKey |
- | keySymbol |
- keySymbol := aKey asSymbol.
- (toRemove at: keySymbol put: (self formAtKey: keySymbol)).
- FormDictionary at: keySymbol put: replacement].
-
- aReferenceStream := ReferenceStream fileNamed: aFileName.
- aReferenceStream nextPut: toRemove.
- aReferenceStream close!
Item was removed:
- ----- Method: StandardScriptingSystem>>formAtKey: (in category 'form dictionary') -----
- formAtKey: aString
- "Answer the form saved under the given key"
-
- ^(Symbol lookup: aString)
- ifNotNil: [ :aKey | FormDictionary at: aKey ifAbsent: [ FormDictionary at: #Cat ] ]
- ifNil: [ FormDictionary at: #Cat ]!
Item was removed:
- ----- Method: StandardScriptingSystem>>formAtKey:extent:depth: (in category 'form dictionary') -----
- formAtKey: aKey extent: extent depth: depth
- "ScriptingSystem saveForm: (TileMorph downPicture) atKey: 'downArrow'"
- ^ FormDictionary at: aKey asSymbol ifAbsent: [Form extent: extent depth: depth]!
Item was removed:
- ----- Method: StandardScriptingSystem>>formDictionary (in category 'form dictionary') -----
- formDictionary
- ^FormDictionary!
Item was removed:
- ----- Method: StandardScriptingSystem>>helpStringOrNilFor: (in category 'help dictionary') -----
- helpStringOrNilFor: aSymbol
- "If my HelpStrings dictionary has an entry at the given symbol,
- answer that entry's value, else answer nil"
- HelpStrings
- at: aSymbol
- ifPresent:[:string | ^ string translated].
- ^ nil!
Item was removed:
- ----- Method: StandardScriptingSystem>>initializeHelpStrings (in category 'help dictionary') -----
- initializeHelpStrings
- "Initialize the data structure that determines, for the etoy system, help messages for various scripting elements. The structure is built up by letting every Morph subclass contribute elements simply by implementing method #helpContributions. Consult implementors of #helpContributions for examples of how this goes."
-
- "ScriptingSystem initializeHelpStrings"
-
- | aDictionary |
- aDictionary := IdentityDictionary new.
- "For safety, the new copy is built up in this temp first, so that if an error occurs during the creation of the structure, the old version will remain remain in place"
-
- Morph withAllSubclasses do:
- [:aClass | (aClass class includesSelector: #helpContributions)
- ifTrue:
- [aClass helpContributions do:
- [:pair | aDictionary at: pair first put: pair second]]].
-
- HelpStrings := aDictionary!
Item was removed:
- ----- Method: StandardScriptingSystem>>inspectFormDictionary (in category 'form dictionary') -----
- inspectFormDictionary
- "ScriptingSystem inspectFormDictionary"
-
- GraphicalDictionaryMenu openOn: FormDictionary withLabel: 'Testing One Two Three'!
Item was removed:
- ----- Method: StandardScriptingSystem>>privateGraphics (in category 'form dictionary') -----
- privateGraphics
- "ScriptingSystem deletePrivateGraphics"
- ^#(#BadgeMiniPic #BadgePic #Broom #CedarPic #CollagePic #CoverMain #CoverSpiral #CoverTexture #Fred #ImagiPic #KayaPic #StudioPic)!
Item was removed:
- ----- Method: StandardScriptingSystem>>saveForm:atKey: (in category 'form dictionary') -----
- saveForm: aForm atKey: aKey
- FormDictionary at: aKey asSymbol put: aForm!
Item was removed:
- ----- Method: StandardScriptingSystem>>soundNamesToSuppress (in category 'utilities') -----
- soundNamesToSuppress
- "Answer a list of sound-names that are not to be offered in sound-choice pop-ups unless they are the current choice"
-
- ^ #('scrape' 'scritch' 'peaks')!
Item was removed:
- ----- Method: StandardScriptingSystem>>squeakyMouseForm (in category 'form dictionary') -----
- squeakyMouseForm
- ^ self formAtKey: 'squeakyMouse'
-
- "
- ScriptingSystem saveForm: (Form
- extent: 30 at 29
- depth: 16
- fromArray: #( 1811114995 1878286257 2012637171 1811180532 1811180533 1811179508 1811180532 1811179508 1744006133 1878289396 1811180533 1878289396 1744007156 1674736630 1744006132 1811114995 1811181556 1744006131 1811246068 1811180532 1811179508 1811180532 1744071668 1811113972 1811180532 1811180532 1811179507 1878288338 1945529332 1744071668 1743941620 1811112945 1811179506 1811114995 1744006131 1744006130 1744005106 1811048434 1811113969 1743939570 1811179506 1743939571 1676833782 1676765171 1811047410 1744006131 1811048435 1811116020 1811180531 1743939571 1811048435 1743939570 1743939570 1743939570 1743940594 1744005106 1811181556 1811180532 1676766196 1743939570 1878420468 1676963830 1189896082 1811245044 1744137204 1744070644 1811179508 1811113971 1743939571 1811179508 1811246070 1811309524 1811302093 1811310580 1811246068 1674867703 1744049472 1120606594 1118465013 1744137205 1811179508 1811180532 1744071667 1744006132 1811112947 1811247095 1605584589 358761132 289435638 1676
830707 1741975543 1462778473 1811312631 702891724 1811310548 1945528308 1811178450 1945528307 1878288372 1878353875 1878421494 1051471335 1809213397 1118524175 1811246068 1945659348 1185698607 1878486005 1672694510 1118531574 1607626741 1878420467 1811180533 1743942645 1744072693 1811301035 1185770487 1878486006 1324239597 1811180533 1811116019 1120623438 1878352818 1945462739 704868339 1878289395 1811049459 1878221808 1878223859 1743876083 1811162563 1945463796 1811181556 1464746666 1811116018 1809019893 1120551562 1945464821 1741844468 1466842760 1878289395 1811048434 1811050483 1811050483 1878223859 1049188174 1741910004 1811181556 1256998634 1811114994 1878289396 1466840647 1744007156 1744006131 1676877216 1743940596 1878222835 1743938545 1878351792 1676833781 358641652 1743940596 1811050484 845566798 1811113970 1811114995 1811163652 1811112913 1878420468 1878282028 1811179506 1607560178 1878289395 1676900342 1878351825 1466853330 1811113971 1811116019 635659217 1811179506 18112
45045 1676942754 1744137206 1744201717 1676962806 1676962805 1811310581 1676896245 1744199635 1811376117 1744072695 1744005109 1811244019 499279861 1811310581 1811244020 1811293668 1399943159 1605528567 1744136181 982063522 986342388 1744070645 1744189066 430063308 1744071669 1744070644 1744067504 566519797 1744136181 1744137205 1743999854 912813044 1811311606 1742162607 4195488 283139922 1945531382 1253113857 144710948 1601400791 1811246069 1811167879 1464821747 1744136180 1674799094 1811178482 843473875 1811311606 1878533542 2106790 2080066222 1876193270 696845376 627472380 1185772536 1878355957 1743990309 1744007157 1676898294 1744006132 1811114996 1743941620 1811180533 1809204941 4194368 4217681 1878290421 1252982848 4194336 1670540278 1739811795 1878353906 1744006131 1811179506 1744007157 1744005106 1945462771 1811182582 1811311574 1393641133 1462856629 2012638196 1876382449 1112301394 1742041045 1945596917 1676833781 1811113970 1811179507 1811180532 1672705014 1674735606 16726
97648 1945725943 1878551479 1809215479 1811312629 1809216504 1809215479 1809215478 1462853490 1878487029 1744007158 1744005075 1811239726 704979363 495004132 700789287 562372997 631646663 1739998892 4194400 1116497846 698688932 562375109 770124262 633609569 495070758 1257010166 562315916 1809279958 2012894002 1047280171 980237901 910966381 1668677696 4194400 6314867 1047281260 908804749 910968495 1393719290 1809279959 1185750370 1809214455 1878469062 423836236 1532188466 1601592148 1462986647 1672937568 4194368 6319062 1603622706 1601525554 1601522417 1047336194 770206679 1878487031 1878409899 977955830 1809145716 1118586509 980105834 980045584 1811372914 980104778 1605526483 1395605131 910769804 1118651052 1534358520 1809136234 1118596053 1532059506 1878485973 1326456163 1945660374 1742106615 1811311607 1945725942 1742107641 1744072693 1811311605 1744203767 1878551543 564478604 1878553591 1603428242 1811048433 1811049459 1051290611 1744006131 1811049459 1878156273 1743874034 174400
7156 1743874033 1811048434 1811113970 1743939571 1743933228 1603301363 1743875059 1811049458 1945461745 1811181556 1811113971 1811049458 1811048434 1811116020 1878287346 1878223857 1743940594 1744006130 1744007157 1945395153 1945400309 1811048434 1743810547 1676765170 1878353906 1811113970 1743874032 1810983921 1743874033 1811113971 1676765169 1743874034 1743940593 1743939569 1811047409 1676765168 1743940595 1810981872 1945397235 1607560179 1743941620 1810982897 1810983921 1811048433 1744007155 1743875059 1811048434 1743875058 1743939568 1676832754 1811116019 1811114994 1811244019 1676962805 1677029367 1811244020 1744005106 1743940594 1811246068 1744070645 1676961781 1744004084 1676897269 1811180533 1878353908 1744004083 1744070645)
- offset: 0 at 0) atKey: 'squeakyMouse'"!
Item was removed:
- ----- Method: StandardScriptingSystem>>stripGraphicsForExternalRelease (in category 'utilities') -----
- stripGraphicsForExternalRelease
- "ScriptingSystem stripGraphicsForExternalRelease"
-
- | replacement |
- replacement := FormDictionary at: #Gets.
-
- #('BadgeMiniPic' 'BadgePic' 'Broom' 'CedarPic' 'CollagePic' 'CoverMain' 'CoverSpiral' 'CoverTexture' 'Fred' 'ImagiPic' 'KayaPic' 'StudioPic')
- do:
- [:aKey | FormDictionary at: aKey asSymbol put: replacement]!
Item was removed:
- MorphicAlarm subclass: #StepMessage
- instanceVariableNames: 'stepTime'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!
Item was removed:
- ----- Method: StepMessage class>>scheduledAt:stepTime:receiver:selector:arguments: (in category 'instance creation') -----
- scheduledAt: scheduledTime stepTime: stepTime receiver: aTarget selector: aSelector arguments: argArray
- ^(self receiver: aTarget selector: aSelector arguments: argArray)
- scheduledTime: scheduledTime;
- stepTime: stepTime!
Item was removed:
- ----- Method: StepMessage>>printOn: (in category 'printing') -----
- printOn: aStream
- super printOn: aStream.
- aStream
- nextPut: $(;
- print: receiver;
- space;
- print: selector;
- space;
- print: scheduledTime;
- nextPut: $).!
Item was removed:
- ----- Method: StepMessage>>stepTime (in category 'stepping and presenter') -----
- stepTime
- "Return the step time for this message. If nil, the receiver of the message will be asked for its #stepTime."
- ^stepTime!
Item was removed:
- ----- Method: StepMessage>>stepTime: (in category 'accessing') -----
- stepTime: aNumber
- "Set the step time for this message. If nil, the receiver of the message will be asked for its #stepTime."
- stepTime := aNumber!
Item was removed:
- ----- Method: String>>asMorph (in category '*Morphic') -----
- asMorph
- "Answer the receiver as a StringMorph"
-
- ^ StringMorph contents: self
-
- "'bugs black blood' asMorph openInHand"!
Item was removed:
- ----- Method: String>>asStringMorph (in category '*Morphic') -----
- asStringMorph
- "Answer the receiver as a StringMorph"
-
- ^ StringMorph contents: self
-
- "'bugs black blood' asStringMorph openInHand"!
Item was removed:
- ----- Method: String>>hasContentsInExplorer (in category '*Morphic-Explorer') -----
- hasContentsInExplorer
-
- ^false!
Item was removed:
- ----- Method: String>>openAsMorph (in category '*Morphic-converting') -----
- openAsMorph
- "Open the receiver as a morph"
-
- ^ self asMorph openInHand !
Item was removed:
- Morph subclass: #StringMorph
- instanceVariableNames: 'font emphasis contents hasFocus'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Basic'!
-
- !StringMorph commentStamp: 'efc 3/7/2003 17:34' prior: 0!
- StringMorph is a "lightweight" Morph to display a String. It supports only a single font, color, and emphasis combination. For multiple text styles, use TextMorph.
-
- Structure:
- instance var Type Description
- font StrikeFont (normally nil; then the accessor #font gives back TextStyle
- or nil defaultFont)
- emphasis SmallInteger bitmask determining character attributes (underline, bold, italics, narrow, struckout)
- contents String The text that will be displayed.
- hasFocus Boolean Do I have the keyboard focus or not?
-
- If you shift-click on a StringMorph you can edit its string. This is accomplished the following way: StringMorph can launch a StringMorphEditor if it receives a #mouseDown event.
-
- A StringMorph may also be used like a SimpleButtonMorph to do an action when clicked. Use the menu 'extras' / 'add mouseUpAction'.
-
- The following propery will be defined:
- aStringMorph valueOfProperty: #mouseUpCodeToRun!
Item was removed:
- ----- Method: StringMorph class>>authoringPrototype (in category 'scripting') -----
- authoringPrototype
- ^ super authoringPrototype contents: 'String'!
Item was removed:
- ----- Method: StringMorph class>>contents: (in category 'instance creation') -----
- contents: aString
- " 'StringMorph contents: str' is faster than 'StringMorph new contents: str' "
- ^ self contents: aString font: nil!
Item was removed:
- ----- Method: StringMorph class>>contents:font: (in category 'instance creation') -----
- contents: aString font: aFont
- ^ self basicNew initWithContents: aString font: aFont emphasis: 0!
Item was removed:
- ----- Method: StringMorph class>>contents:font:emphasis: (in category 'instance creation') -----
- contents: aString font: aFont emphasis: emphasisCode
- ^ self basicNew initWithContents: aString font: aFont emphasis: emphasisCode!
Item was removed:
- ----- Method: StringMorph class>>test (in category 'testing') -----
- test
- "Return a morph with lots of strings for testing display speed."
- | c |
- c := AlignmentMorph newColumn.
- SystemOrganization categories do:
- [:cat | c addMorph: (StringMorph new contents: cat)].
- ^ c!
Item was removed:
- ----- Method: StringMorph class>>test2 (in category 'testing') -----
- test2
- "Return a morph with lots of strings for testing display speed."
- | c r |
- c := AlignmentMorph newColumn.
- SystemOrganization categories reverseDo:
- [:cat | c addMorph: (StringMorph new contents: cat)].
- r := RectangleMorph new extent: c fullBounds extent.
- c submorphsDo: [:m | r addMorph: m].
- ^ r
- !
Item was removed:
- ----- Method: StringMorph>>acceptContents (in category 'editing') -----
- acceptContents
- "The message is sent when the user hits enter or Cmd-S. Accept the current contents and end editing. This default implementation updates the model's known window title for pluggable windows."
-
- self containingWindow ifNotNil: [:wnd |
- wnd setLabel: self contents. "Needed for models that do not accept changes."
- (wnd respondsTo: #getLabelSelector) ifTrue: [
- wnd getLabelSelector ifNotNil: [:selector |
- | mutator |
- mutator := selector asSimpleSetter.
- (wnd model respondsTo: mutator) ifTrue: [
- wnd model perform: mutator with: self contents]]]]!
Item was removed:
- ----- Method: StringMorph>>acceptValue: (in category 'editing') -----
- acceptValue: aValue
- | val |
- self contents: (val := aValue asString).
- ^ val!
Item was removed:
- ----- Method: StringMorph>>addCustomMenuItems:hand: (in category 'menu') -----
- addCustomMenuItems: aCustomMenu hand: aHandMorph
-
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- aCustomMenu add: 'change font' translated action: #changeFont.
- aCustomMenu add: 'change emphasis' translated action: #changeEmphasis.
- !
Item was removed:
- ----- Method: StringMorph>>addOptionalHandlesTo:box: (in category 'halos and balloon help') -----
- addOptionalHandlesTo: aHalo box: box
- "eventually, add more handles for font..."
-
- self flag: #deferred.
- ^ super addOptionalHandlesTo: aHalo box: box
-
- "Eventually...
- self addFontHandlesTo: aHalo box: box"!
Item was removed:
- ----- Method: StringMorph>>boundsForBalloon (in category 'halos and balloon help') -----
- boundsForBalloon
- "Some morphs have bounds that are way too big. This is a contorted way of making things work okay in PluggableListMorphs, whose list elements historically have huge widths"
-
- | ownerOwner |
- ^ ((owner notNil and: [(ownerOwner := owner owner) notNil]) and:
- [ownerOwner isKindOf: PluggableListMorph])
- ifTrue:
- [self boundsInWorld intersect: ownerOwner boundsInWorld]
- ifFalse:
- [super boundsForBalloon]!
Item was removed:
- ----- Method: StringMorph>>cancelEdits (in category 'editing') -----
- cancelEdits
-
- self doneWithEdits!
Item was removed:
- ----- Method: StringMorph>>changeEmphasis (in category 'menu') -----
- changeEmphasis
-
- | reply aList |
- aList := #(normal bold italic narrow underlined struckOut).
- reply := UIManager default
- chooseFrom: (aList collect: [:t | t translated])
- values: aList..
- reply ifNotNil:[
- self emphasis: (TextEmphasis perform: reply) emphasisCode.
- ].
- !
Item was removed:
- ----- Method: StringMorph>>changeFont (in category 'menu') -----
- changeFont
-
- | chooser originalFont |
- originalFont := self fontToUse.
- self openModal: (
- Cursor wait showWhile: [
- | window |
- window := UIManager default
- chooseFont: 'Choose a Font'
- for: self
- setSelector: #font:
- getSelector: originalFont.
- "We have to save the model here, because it will be gone when the window is closed."
- chooser := window model.
- window ]).
- originalFont = self fontToUse ifFalse: [
- "Ensure that we restore the original font in case it was changed, but Cancel was clicked."
- self font: (chooser result ifNil: [ originalFont ]) ]!
Item was removed:
- ----- Method: StringMorph>>contents (in category 'accessing') -----
- contents
-
- ^ contents ifNil: [ self contents: 'String Morph'. contents ]
- !
Item was removed:
- ----- Method: StringMorph>>contents: (in category 'accessing') -----
- contents: newContents
-
- self flag: #todo. "mt: hasFocus == true means that the mini editor was launched. We should now ignore any external calls to this method to avoid visual glitches. However, #interimContents: does also use this callback. Figure something out."
-
- newContents isText
- ifTrue: [^ self initializeFromText: newContents].
-
- contents = newContents
- ifTrue: [^ self "No substantive change."].
-
- contents := newContents.
- self changed. "New contents need to be drawn."
-
- self fitContents. "Resize if necessary."!
Item was removed:
- ----- Method: StringMorph>>contentsClipped: (in category 'accessing - convenience') -----
- contentsClipped: aString
- "Change my text, but do not change my size as a result"
- contents = aString ifTrue: [^ self]. "No substantive change"
- contents := aString.
- self changed!
Item was removed:
- ----- Method: StringMorph>>contentsFitted: (in category 'accessing - convenience') -----
- contentsFitted: aString
- "I fit my contents by default."
-
- self contents: aString.!
Item was removed:
- ----- Method: StringMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color black!
Item was removed:
- ----- Method: StringMorph>>doneWithEdits (in category 'editing') -----
- doneWithEdits
-
- hasFocus := false!
Item was removed:
- ----- Method: StringMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- | drawBounds |
- drawBounds := self innerBounds. "within border, no other (layout) inset"
- drawBounds := drawBounds origin + (0 @ self fontToUse lineGapSliceForMorphs) corner: drawBounds corner.
-
- aCanvas
- drawString: self contents
- in: drawBounds
- font: self fontToUse
- color: self color.!
Item was removed:
- ----- Method: StringMorph>>emphasis (in category 'accessing') -----
- emphasis
- "self assert: emphasis = self font emphasis"
-
- ^ emphasis!
Item was removed:
- ----- Method: StringMorph>>emphasis: (in category 'accessing') -----
- emphasis: aNumber
- "Set the receiver's emphasis as indicated. aNumber is a bitmask with the following format:
-
- bit attribute
- 1 bold
- 2 italic
- 4 underlined
- 8 narrow
- 16 struckOut"
-
- "examples: 0 -> plain.
- 1 -> bold. 2 -> italic. 3 -> bold italic. 4 -> underlined
- 5 -> bold underlined. 6 -> italic underlined. 7 -> bold italic underlined
- etc..."
-
- self
- setFont: (self font emphasized: aNumber)
- emphasis: aNumber!
Item was removed:
- ----- Method: StringMorph>>fitContents (in category 'layout') -----
- fitContents
-
- self extent: self measureContents.!
Item was removed:
- ----- Method: StringMorph>>fixUponLoad:seg: (in category 'objects from disk') -----
- fixUponLoad: aProject seg: anImageSegment
- "We are in an old project that is being loaded from disk.
- Fix up conventions that have changed."
-
- | substituteFont |
- substituteFont := aProject projectParameters at:
- #substitutedFont ifAbsent: [#none].
- (substituteFont ~~ #none and: [self font == substituteFont])
- ifTrue: [ self fitContents ].
-
- ^ super fixUponLoad: aProject seg: anImageSegment!
Item was removed:
- ----- Method: StringMorph>>font (in category 'accessing') -----
- font
- "who came up with #fontToUse rather than font?!!"
- ^self fontToUse!
Item was removed:
- ----- Method: StringMorph>>font: (in category 'accessing') -----
- font: aFont
- "Set the font my text will use. The emphasis remains unchanged."
-
- self
- setFont: (aFont emphasized: self emphasis)
- emphasis: self emphasis.!
Item was removed:
- ----- Method: StringMorph>>font:emphasis: (in category 'accessing - convenience') -----
- font: aFontOrNil emphasis: emphasisCodeOrNil
- "For convenience only. Try to use #font: and #emphasis: instead.
-
- Changes font and/or emphasis. If both are given, the font's current emphasis will be discarded. If only the emphasis is given, the system's default font will be used. If only the font is given, the font's emphasis will be cached so that future calls to #font: will keep the emphasis."
-
- self
- assert: aFontOrNil notNil | emphasisCodeOrNil notNil
- description: 'Either font or emphasis must be non-nil.'.
-
- self
- setFont: ((aFontOrNil isNil or: [aFontOrNil emphasis = emphasisCodeOrNil] or: [emphasisCodeOrNil isNil])
- ifTrue: [aFontOrNil]
- ifFalse: [aFontOrNil emphasized: emphasisCodeOrNil])
- emphasis: (emphasisCodeOrNil ifNil: [aFontOrNil emphasis]).
-
- "self assert: self font emphasis = self emphasis. --- mt: Does not always work because of how StrikeFont treats emphasis 0 in #emphasized:."!
Item was removed:
- ----- Method: StringMorph>>fontName: (in category 'fonts') -----
- fontName: fontName
-
- self
- fontName: fontName
- size: TextStyle defaultFont pixelSize
- emphasis: 0.!
Item was removed:
- ----- Method: StringMorph>>fontName:pointSize: (in category 'fonts') -----
- fontName: fontName pointSize: fontSize
-
- self
- fontName: fontName
- pointSize: fontSize
- emphasis: 0.!
Item was removed:
- ----- Method: StringMorph>>fontName:pointSize:emphasis: (in category 'fonts') -----
- fontName: fontName pointSize: fontSize emphasis: emphasisCode
-
- self
- setFont: (StrikeFont familyName: fontName pointSize: fontSize emphasized: emphasisCode)
- emphasis: emphasisCode.!
Item was removed:
- ----- Method: StringMorph>>fontName:size: (in category 'fonts') -----
- fontName: fontName size: fontSize
-
- self
- fontName: fontName
- size: fontSize
- emphasis: 0.!
Item was removed:
- ----- Method: StringMorph>>fontName:size:emphasis: (in category 'fonts') -----
- fontName: fontName size: fontSize emphasis: emphasisCode
-
- self
- setFont: (StrikeFont familyName: fontName size: fontSize emphasized: emphasisCode)
- emphasis: emphasisCode.!
Item was removed:
- ----- Method: StringMorph>>fontToUse (in category 'drawing') -----
- fontToUse
- "Support un-initialized font or emphasis variable."
-
- ^ font ifNil: [TextStyle defaultFont emphasized: (self emphasis ifNil: [0])]!
Item was removed:
- ----- Method: StringMorph>>fullPrintOn: (in category 'printing') -----
- fullPrintOn: aStream
-
- aStream nextPutAll: '('.
- super fullPrintOn: aStream.
- aStream nextPutAll: ') contents: '; print: contents!
Item was removed:
- ----- Method: StringMorph>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: evt
- ^ (evt shiftPressed and: [self wantsKeyboardFocusOnShiftClick])
- ifTrue: [true]
- ifFalse: [super handlesMouseDown: evt].
- !
Item was removed:
- ----- Method: StringMorph>>hasFocus (in category 'event handling') -----
- hasFocus
- ^ hasFocus!
Item was removed:
- ----- Method: StringMorph>>hasTranslucentColor (in category 'testing') -----
- hasTranslucentColor
-
- ^true!
Item was removed:
- ----- Method: StringMorph>>imageForm:forRectangle: (in category 'drawing') -----
- imageForm: depth forRectangle: rect
- | canvas |
- canvas := Display defaultCanvasClass extent: rect extent depth: depth.
- canvas form fillColor: self color negated.
- canvas translateBy: rect topLeft negated
- during:[:tempCanvas| tempCanvas fullDrawMorph: self].
- ^ canvas form offset: rect topLeft!
Item was removed:
- ----- Method: StringMorph>>initWithContents:font:emphasis: (in category 'initialization') -----
- initWithContents: aStringOrText font: aFont emphasis: emphasisCode
-
- self initialize.
- self font: aFont emphasis: emphasisCode.
-
- aStringOrText isText
- ifTrue: [self initializeFromText: aStringOrText]
- ifFalse: [self initializeFromString: aStringOrText].!
Item was removed:
- ----- Method: StringMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
- font := nil.
- emphasis := 0.
- hasFocus := false!
Item was removed:
- ----- Method: StringMorph>>initializeFromString: (in category 'initialization') -----
- initializeFromString: aString
-
- contents := aString.
- self fitContents.!
Item was removed:
- ----- Method: StringMorph>>initializeFromText: (in category 'initialization') -----
- initializeFromText: aText
-
- | scanner |
- scanner := StringMorphAttributeScanner new initializeFromStringMorph: self.
-
- (aText attributesAt: 1 forStyle: self font textStyle)
- do: [:attr | attr emphasizeScanner: scanner].
-
- font := scanner font emphasized: scanner emphasis.
- emphasis := scanner emphasis.
- color := scanner textColor.
-
- contents := aText string.
- self fitContents.!
Item was removed:
- ----- Method: StringMorph>>initializeToStandAlone (in category 'parts bin') -----
- initializeToStandAlone
- super initializeToStandAlone.
-
- font := nil.
- emphasis := 0.
- hasFocus := false.
- self contents: 'String: Shift-click on me to edit'!
Item was removed:
- ----- Method: StringMorph>>interimContents: (in category 'accessing - support') -----
- interimContents: aString
- "The receiver is under edit and aString represents the string the user sees as she edits, which typically will not have been accepted and indeed may be abandoned"
-
- self contents: aString!
Item was removed:
- ----- Method: StringMorph>>label:font: (in category 'accessing - convenience') -----
- label: aString font: aFont
- "compatible protocol used in ScriptEditorMorph>>bringUpToDate"
- self contents: aString.
- self font: aFont!
Item was removed:
- ----- Method: StringMorph>>launchMiniEditor: (in category 'editing') -----
- launchMiniEditor: evt
-
- | textMorph |
- hasFocus := true. "Really only means edit in progress for this morph"
- textMorph := StringMorphEditor new contentsAsIs: contents.
- textMorph font: self fontToUse.
- textMorph color: self color.
- textMorph plainTextOnly: true.
- textMorph innerBounds: self innerBounds.
- self addMorphFront: textMorph.
- evt hand newKeyboardFocus: textMorph.
- textMorph editor selectFrom: 1 to: textMorph paragraph text string size!
Item was removed:
- ----- Method: StringMorph>>lookTranslucent (in category 'drawing') -----
- lookTranslucent
-
- "keep the text the same color (black)"!
Item was removed:
- ----- Method: StringMorph>>lostFocusWithoutAccepting (in category 'editing') -----
- lostFocusWithoutAccepting
- "The message is sent when the user, having been in an editing episode on the receiver, changes the keyboard focus -- typically by clicking on some editable text somewhere else -- without having accepted the current edits."
-
- self acceptContents!
Item was removed:
- ----- Method: StringMorph>>measureContents (in category 'accessing - support') -----
- measureContents
- | f |
- f := self fontToUse.
- ^(((f widthOfString: contents) max: self minimumWidth) @ f lineGridForMorphs).!
Item was removed:
- ----- Method: StringMorph>>minHeight (in category 'layout') -----
- minHeight
- "Layout specific."
-
- ^ super minHeight max: self fontToUse lineGridForMorphs!
Item was removed:
- ----- Method: StringMorph>>minWidth (in category 'layout') -----
- minWidth
- "Layout specific."
-
- ^ self hResizing = #spaceFill
- ifTrue: [0] ifFalse: [super minWidth max: (self fontToUse widthOfString: self contents)]!
Item was removed:
- ----- Method: StringMorph>>mouseDown: (in category 'event handling') -----
- mouseDown: evt
- "If the shift key is pressed, make this string the keyboard input focus."
-
- (evt shiftPressed and: [self wantsKeyboardFocusOnShiftClick])
- ifTrue: [self launchMiniEditor: evt]
- ifFalse: [super mouseDown: evt].
- !
Item was removed:
- ----- Method: StringMorph>>printOn: (in category 'printing') -----
- printOn: aStream
-
- super printOn: aStream.
- aStream print: contents.
- !
Item was removed:
- ----- Method: StringMorph>>setFont:emphasis: (in category 'initialization') -----
- setFont: aFont emphasis: emphasisCode
- "self assert: emphasisCode = aFont emphasis."
-
- font := aFont.
- emphasis := emphasisCode.
-
- self fitContents.
-
- "
- in inspector say,
- self font: (TextStyle default fontAt: 2) emphasis: 1
- "!
Item was removed:
- ----- Method: StringMorph>>setWidth: (in category 'accessing - support') -----
- setWidth: width
-
- self extent: width @ self height!
Item was removed:
- ----- Method: StringMorph>>userString (in category 'accessing - support') -----
- userString
- "Do I have a text string to be searched on?"
-
- ^ contents!
Item was removed:
- ----- Method: StringMorph>>valueFromContents (in category 'accessing - support') -----
- valueFromContents
- "Return a new value from the current contents string."
- ^ contents!
Item was removed:
- ----- Method: StringMorph>>wantsKeyboardFocusOnShiftClick (in category 'editing') -----
- wantsKeyboardFocusOnShiftClick
- ^ owner topRendererOrSelf wantsKeyboardFocusFor: self
- !
Item was removed:
- ----- Method: StringMorph>>wouldAcceptKeyboardFocus (in category 'event handling') -----
- wouldAcceptKeyboardFocus
- ^ self isLocked not!
Item was removed:
- Object subclass: #StringMorphAttributeScanner
- instanceVariableNames: 'fontNumber textColor emphasis alignment actualFont indent kern'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Text Support'!
-
- !StringMorphAttributeScanner commentStamp: '<historical>' prior: 0!
- A StringMorphAttributeScanner provides the interface of a CharacterScanner so that text attributes may be collected from a Text and used elsewhere, like in setting the attributes of a StringMorph.
- !
Item was removed:
- ----- Method: StringMorphAttributeScanner>>actualFont (in category 'accessing') -----
- actualFont
- "Answer the value of actualFont"
-
- ^ actualFont ifNil: [ TextStyle defaultFont ]!
Item was removed:
- ----- Method: StringMorphAttributeScanner>>addEmphasis: (in category 'scanning') -----
- addEmphasis: anInteger
- "Set the value of emphasis"
-
- emphasis := emphasis bitOr: anInteger!
Item was removed:
- ----- Method: StringMorphAttributeScanner>>addKern: (in category 'scanning') -----
- addKern: kernDelta
- "Set the current kern amount."
- kern := kern + kernDelta!
Item was removed:
- ----- Method: StringMorphAttributeScanner>>alignment (in category 'accessing') -----
- alignment
- "Answer the value of alignment"
-
- ^ alignment!
Item was removed:
- ----- Method: StringMorphAttributeScanner>>emphasis (in category 'accessing') -----
- emphasis
- "Answer the value of emphasis"
-
- ^ emphasis!
Item was removed:
- ----- Method: StringMorphAttributeScanner>>font (in category 'accessing') -----
- font
- "Answer the value of font"
-
- ^self textStyle fontAt: self fontNumber!
Item was removed:
- ----- Method: StringMorphAttributeScanner>>fontNumber (in category 'accessing') -----
- fontNumber
- "Answer the value of font"
-
- ^ fontNumber!
Item was removed:
- ----- Method: StringMorphAttributeScanner>>indent (in category 'accessing') -----
- indent
- "Answer the value of indent"
-
- ^ indent!
Item was removed:
- ----- Method: StringMorphAttributeScanner>>indentationLevel: (in category 'scanning') -----
- indentationLevel: anInteger
- "Set the value of indent"
-
- indent := anInteger!
Item was removed:
- ----- Method: StringMorphAttributeScanner>>initialize (in category 'initialize-release') -----
- initialize
- emphasis := 0.
- indent := 0.
- kern := 0.
- fontNumber := 1.
- actualFont := TextStyle defaultFont!
Item was removed:
- ----- Method: StringMorphAttributeScanner>>initializeFromStringMorph: (in category 'string morph') -----
- initializeFromStringMorph: aStringMorph
-
- actualFont := aStringMorph font ifNil: [ TextStyle defaultFont ].
- emphasis := 0. "We must start with no emphasis."
- fontNumber := (actualFont textStyleOrNil
- ifNil: [1]
- ifNotNil: [:style | style fontIndexOfPointSize: actualFont pointSize]).
- textColor := aStringMorph color.
- !
Item was removed:
- ----- Method: StringMorphAttributeScanner>>kern (in category 'accessing') -----
- kern
- "Answer the value of kern"
-
- ^ kern!
Item was removed:
- ----- Method: StringMorphAttributeScanner>>setActualFont: (in category 'scanning') -----
- setActualFont: aFont
- "Set the value of actualFont, from a TextFontReference"
-
- actualFont := aFont.
- aFont textStyle ifNotNil: [ :ts | fontNumber := ts fontIndexOf: aFont ]!
Item was removed:
- ----- Method: StringMorphAttributeScanner>>setAlignment: (in category 'scanning') -----
- setAlignment: aSymbol
- "Set the value of alignment"
-
- alignment := aSymbol!
Item was removed:
- ----- Method: StringMorphAttributeScanner>>setFont: (in category 'scanning') -----
- setFont: fontNum
- "Set the value of font"
-
- fontNumber := fontNum!
Item was removed:
- ----- Method: StringMorphAttributeScanner>>textColor (in category 'accessing') -----
- textColor
- "Answer the value of textColor"
-
- ^ textColor!
Item was removed:
- ----- Method: StringMorphAttributeScanner>>textColor: (in category 'scanning') -----
- textColor: anObject
- "Set the value of textColor"
-
- textColor := anObject!
Item was removed:
- ----- Method: StringMorphAttributeScanner>>textStyle (in category 'accessing') -----
- textStyle
- ^self actualFont textStyle ifNil: [ TextStyle default ]!
Item was removed:
- TextMorph subclass: #StringMorphEditor
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Text Support'!
-
- !StringMorphEditor commentStamp: '<historical>' prior: 0!
- I am a textMorph used as a pop-up editor for StringMorphs. I present a yellow background and I go away when a CR is typed or when the user clicks elsewhere.!
Item was removed:
- ----- Method: StringMorphEditor class>>includeInNewMorphMenu (in category 'new-morph participation') -----
- includeInNewMorphMenu
- "Not to be instantiated from the menu"
- ^ false!
Item was removed:
- ----- Method: StringMorphEditor>>initialize (in category 'display') -----
- initialize
- "Initialize the receiver. Give it a white background"
-
- super initialize.
- self setDefaultParameters.!
Item was removed:
- ----- Method: StringMorphEditor>>keyStroke: (in category 'event handling') -----
- keyStroke: evt
- "This is hugely inefficient, but it seems to work, and it's unlikely it will ever need
- to be any more efficient -- it's only intended to edit single-line strings."
-
- | char priorEditor newSel |
- (((char := evt keyCharacter) = Character enter) or: [(char = Character cr)
- or: [char = $s and: [evt commandKeyPressed]]])
- ifTrue: [owner doneWithEdits; acceptContents.
- self flag: #arNote. "Probably unnecessary"
- evt hand releaseKeyboardFocus.
- ^ self delete].
-
- ((char := evt keyCharacter) = Character escape
- or: [char = $l and: [evt commandKeyPressed]]) ifTrue: "cancel"
- [owner cancelEdits.
- evt hand releaseKeyboardFocus.
- ^ self delete].
-
- super keyStroke: evt.
-
- owner ifNil: [^self].
- owner interimContents: self contents asString.
- newSel := self editor selectionInterval.
-
- priorEditor := self editor. "Save editor state"
- self releaseParagraph. "Release paragraph so it will grow with selection."
- self paragraph. "Re-instantiate to set new bounds"
- self installEditorToReplace: priorEditor. "restore editor state"
- self editor selectFrom: newSel first to: newSel last.
- !
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: StringMorphEditor>>setDefaultParameters (in category 'display') -----
- setDefaultParameters
- "Based on PluggableTextMorph >> #setDefaultParameters."
-
- self
- backgroundColor: ((UserInterfaceTheme current get: #color for: #ScrollPane) ifNil: [Color white]);
- borderStyle: ((UserInterfaceTheme current get: #borderStyle for: #ScrollPane) ifNil: [BorderStyle simple]) copy;
- borderColor: ((UserInterfaceTheme current get: #borderColor for: #ScrollPane) ifNil: [Color gray: 0.6]);
- borderWidth: (((UserInterfaceTheme current get: #borderWidth for: #ScrollPane) ifNil: [1]) * RealEstateAgent scaleFactor) truncated.
-
- self
- caretColor: ((UserInterfaceTheme current get: #caretColor for: #PluggableTextMorph) ifNil: [Color red]);
- selectionColor: ((UserInterfaceTheme current get: #selectionColor for: #PluggableTextMorph) ifNil: [TranslucentColor r: 0.0 g: 0.0 b: 0.8 alpha: 0.2]).
-
- self setProperty: #indicateKeyboardFocus toValue: #never.!
Item was removed:
- FileDirectoryWrapper subclass: #SuperSwikiDirectoryWrapper
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Explorer'!
-
- !SuperSwikiDirectoryWrapper commentStamp: '<historical>' prior: 0!
- The super swiki does not at present have subdirectories!
Item was removed:
- ----- Method: SuperSwikiDirectoryWrapper>>contents (in category 'accessing') -----
- contents
-
- ^#() "we have no sundirectories"!
Item was removed:
- ----- Method: SuperSwikiDirectoryWrapper>>hasContents (in category 'testing') -----
- hasContents
-
- ^false "we have no sundirectories"!
Item was removed:
- Morph subclass: #SystemProgressBarMorph
- instanceVariableNames: 'barSize barColor'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !SystemProgressBarMorph commentStamp: 'laza 4/9/2004 11:47' prior: 0!
- Instances of this morph get used by SystemProgressMoprh to quickly display a progress bar.!
Item was removed:
- ----- Method: SystemProgressBarMorph class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ super themeProperties, {
- { #borderColor. 'Colors'. 'Color of the progress bar''s border.' }.
- { #borderWidth. 'Borders'. 'Width of the progress bar''s border.' }.
- { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }.
- { #color. 'Colors'. 'Background color of the progress bar.' }.
- { #barColor. 'Colors'. 'Color of the progress bar''s bar.' }.
- }!
Item was removed:
- ----- Method: SystemProgressBarMorph>>applyUserInterfaceTheme (in category 'updating') -----
- applyUserInterfaceTheme
-
- super applyUserInterfaceTheme.
-
- self setDefaultParameters.!
Item was removed:
- ----- Method: SystemProgressBarMorph>>barColor (in category 'accessing') -----
- barColor
-
- ^ barColor!
Item was removed:
- ----- Method: SystemProgressBarMorph>>barColor: (in category 'accessing') -----
- barColor: aColor
-
- | cc fill |
- cc := aColor.
-
- MenuMorph gradientMenu
- ifFalse: [fill := SolidFillStyle color: cc]
- ifTrue: [
- fill := GradientFillStyle ramp: {
- 0.0 -> cc twiceLighter.
- 1 -> cc twiceDarker }].
-
- barColor := fill.
- self changed.!
Item was removed:
- ----- Method: SystemProgressBarMorph>>barSize (in category 'accessing') -----
- barSize
-
- ^ barSize!
Item was removed:
- ----- Method: SystemProgressBarMorph>>barSize: (in category 'accessing') -----
- barSize: anInteger
- barSize := anInteger.
- self changed.!
Item was removed:
- ----- Method: SystemProgressBarMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- | area fill |
- super drawOn: aCanvas.
-
- self barSize > 0 ifTrue: [
- area := self innerBounds.
- area := area origin extent: (self barSize min: area extent x)@area extent y.
-
- fill := self barColor isColor
- ifTrue: [SolidFillStyle color: self barColor]
- ifFalse: [self barColor].
- fill isGradientFill ifTrue: [
- fill origin: area origin.
- fill direction: 0@ area height].
-
- aCanvas
- frameAndFillRectangle: area
- fillStyle: fill
- borderStyle: (SimpleBorder new width: 1; color: fill asColor muchDarker).
- ].
- !
Item was removed:
- ----- Method: SystemProgressBarMorph>>initialize (in category 'initialization') -----
- initialize
- super initialize.
-
- self setDefaultParameters.
- barSize := 0.
- !
Item was removed:
- ----- Method: SystemProgressBarMorph>>setDefaultParameters (in category 'initialization') -----
- setDefaultParameters
- "change the receiver's appareance parameters"
-
- self
- color: (self userInterfaceTheme color ifNil: [Color r: 0.977 g: 0.977 b: 0.977]);
- borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle simple]) copy;
- borderColor: (self userInterfaceTheme borderColor ifNil: [Color transparent]);
- borderWidth: (self userInterfaceTheme borderWidth ifNil: [0]);
- barColor: (self userInterfaceTheme barColor ifNil: [Color r: 0.72 g: 0.72 b: 0.9]).!
Item was removed:
- Morph subclass: #SystemProgressMorph
- instanceVariableNames: 'activeSlots bars labels font lock requestedPosition textColor'
- classVariableNames: 'BarHeight BarWidth Inset UniqueInstance'
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !SystemProgressMorph commentStamp: '<historical>' prior: 0!
- An single instance of this morph class is used to display progress while the system is busy, eg. while it receives code updates or does a fileIn. To give the user progress information you don't deal directly with SystemProgressMorph. You keep on using the well established way of progress notification, that has been a long time in the system, is widely used and does not depend on the existence of SystemProgressMorph. For more information on this look at the example in this class or look at the comment of the method displayProgressAt:from:to:during: in class String.
-
- SystemProgressMorph is not meant to be used as a component inside other morphs.
-
- You can switch back to the old style of progress display by disabling the morphicProgressStyle setting in the morphic section of the preferences.!
Item was removed:
- ----- Method: SystemProgressMorph class>>applyUserInterfaceTheme (in category 'preferences') -----
- applyUserInterfaceTheme
-
- self initialize; reset.!
Item was removed:
- ----- Method: SystemProgressMorph class>>close: (in category 'instance creation') -----
- close: aBlock
- | slot |
- slot := aBlock value: SmallInteger maxVal. "This should prevent a redraw"
- aBlock receiver freeSlot: slot.
-
- !
Item was removed:
- ----- Method: SystemProgressMorph class>>example (in category 'examples') -----
- example
- "SystemProgressMorph example"
- 'Progress'
- displayProgressFrom: 0 to: 1000
- during: [:bar | 0 to: 1000 do: [:i | bar value: i. (Delay forMilliseconds: 2) wait]]
- !
Item was removed:
- ----- Method: SystemProgressMorph class>>exampleChangeLabel (in category 'examples') -----
- exampleChangeLabel
- "SystemProgressMorph exampleChangeLabel"
- | classes |
- classes := Smalltalk allClasses copyFrom: 1 to: 100.
- 'InitialLabel'
- displayProgressFrom: 0 to: classes size
- during: [:bar | 1 to: classes size do: [:i |
- bar value: i.
- bar value: i printString, '/', classes size printString, ' ', (classes at: i) printString.
- (Delay forMilliseconds: 100) wait]]
- !
Item was removed:
- ----- Method: SystemProgressMorph class>>exampleLabelOnly (in category 'examples') -----
- exampleLabelOnly
- "SystemProgressMorph exampleLabelOnly"
- | words |
- words := #(zero one two three four five six seven eight nine ten) reversed.
- UIManager default informUserDuring: [:bar |
- words do: [:each|
- bar value: 'Countdown: ', each.
- (Delay forSeconds: 1) wait]].!
Item was removed:
- ----- Method: SystemProgressMorph class>>informUserAt:during: (in category 'instance creation') -----
- informUserAt: aPoint during: workBlock
- ProgressInitiationException
- display: ' '
- at: aPoint
- from: 0
- to: 0
- during: workBlock!
Item was removed:
- ----- Method: SystemProgressMorph class>>initialize (in category 'class initialization') -----
- initialize
- "SystemProgressMorph initialize; reset"
-
- BarHeight := (8 * RealEstateAgent scaleFactor) rounded.
- BarWidth := (300 * RealEstateAgent scaleFactor) rounded.
- Inset := ((30 at 30) * RealEstateAgent scaleFactor) rounded.!
Item was removed:
- ----- Method: SystemProgressMorph class>>label:min:max: (in category 'instance creation') -----
- label: shortDescription min: minValue max: maxValue
- "This method is no longer used, but kept for a while longer to ensure no difficulties updating via the trunk."
- ^ self
- position: Display center
- label: shortDescription
- min: minValue
- max: maxValue!
Item was removed:
- ----- Method: SystemProgressMorph class>>new (in category 'instance creation') -----
- new
- ^self shouldNotImplement!
Item was removed:
- ----- Method: SystemProgressMorph class>>position:label:min:max: (in category 'instance creation') -----
- position: aPoint label: shortDescription min: minValue max: maxValue
- UniqueInstance ifNil: [ UniqueInstance := super new ].
- ^ UniqueInstance
- position: aPoint
- label: (shortDescription contractTo: 100)
- min: minValue asFloat
- max: maxValue asFloat!
Item was removed:
- ----- Method: SystemProgressMorph class>>reset (in category 'instance creation') -----
- reset
- "SystemProgressMorph reset"
- UniqueInstance ifNotNil: [UniqueInstance delete].
- UniqueInstance := nil.!
Item was removed:
- ----- Method: SystemProgressMorph class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ super themeProperties, {
- { #borderColor. 'Colors'. 'Color of the progress'' border.' }.
- { #borderWidth. 'Borders'. 'Width of the progress'' border.' }.
- { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }.
- { #color. 'Colors'. 'Background color of the progress.' }.
-
- { #font. 'Fonts'. 'Font for bar labels.' }.
- { #textColor. 'Colors'. 'Color for bar labels.' }.
- }!
Item was removed:
- ----- Method: SystemProgressMorph class>>uniqueInstance (in category 'instance creation') -----
- uniqueInstance
-
- ^ UniqueInstance ifNil: [UniqueInstance := super new]!
Item was removed:
- ----- Method: SystemProgressMorph>>activeSlots (in category 'accessing') -----
- activeSlots
-
- ^ activeSlots!
Item was removed:
- ----- Method: SystemProgressMorph>>activeSlots: (in category 'accessing') -----
- activeSlots: anObject
-
- activeSlots := anObject!
Item was removed:
- ----- Method: SystemProgressMorph>>applyUserInterfaceTheme (in category 'updating') -----
- applyUserInterfaceTheme
-
- super applyUserInterfaceTheme.
-
- self setDefaultParameters.!
Item was removed:
- ----- Method: SystemProgressMorph>>bars (in category 'accessing') -----
- bars
-
- ^ bars!
Item was removed:
- ----- Method: SystemProgressMorph>>bars: (in category 'accessing') -----
- bars: anObject
-
- bars := anObject!
Item was removed:
- ----- Method: SystemProgressMorph>>createProgressBar (in category 'private') -----
- createProgressBar
-
- ^ SystemProgressBarMorph new extent: BarWidth at BarHeight!
Item was removed:
- ----- Method: SystemProgressMorph>>createProgressLabel: (in category 'private') -----
- createProgressLabel: aString
-
- ^ (StringMorph contents: aString font: self font)
- color: self textColor;
- yourself!
Item was removed:
- ----- Method: SystemProgressMorph>>dismissViaHalo (in category 'submorphs - add/remove') -----
- dismissViaHalo
- self class reset!
Item was removed:
- ----- Method: SystemProgressMorph>>font (in category 'accessing') -----
- font
-
- ^ font!
Item was removed:
- ----- Method: SystemProgressMorph>>font: (in category 'accessing') -----
- font: anObject
-
- font := anObject.
- self labels select: [:ea | ea notNil] thenDo: [:ea | ea font: font].!
Item was removed:
- ----- Method: SystemProgressMorph>>freeSlot: (in category 'private') -----
- freeSlot: number
- number > 0 ifFalse: [^self].
- lock critical: [| label |
- label := self labels at: number.
- (label isNil or: [label owner isNil]) ifTrue: [^self]. "Has been freed before"
- label delete.
- (self bars at: number) delete.
- self activeSlots: self activeSlots - 1.
- self activeSlots = 0
- ifTrue: [self delete]
- ifFalse: [self reposition]]!
Item was removed:
- ----- Method: SystemProgressMorph>>initialize (in category 'initialization') -----
- initialize
- super initialize.
- activeSlots := 0.
- bars := Array new: 10.
- labels := Array new: 10.
- lock := Semaphore forMutualExclusion.
- self setDefaultParameters;
- morphicLayerNumber: self class progressLayer;
- layoutPolicy: TableLayout new;
- listDirection: #topToBottom;
- cellPositioning: #topCenter;
- cellGap: 5;
- listCentering: #center;
- hResizing: #shrinkWrap;
- vResizing: #shrinkWrap;
- layoutInset: Inset;
- minWidth: 150!
Item was removed:
- ----- Method: SystemProgressMorph>>label:min:max: (in category 'private') -----
- label: shortDescription min: minValue max: maxValue
- "For convenience. Do not change the current position."
-
- self
- position: self requestedPosition
- label: shortDescription
- min: minValue
- max: maxValue.
- !
Item was removed:
- ----- Method: SystemProgressMorph>>labelAt:put: (in category 'labelling') -----
- labelAt: progressBlock put: aString
- "Change the label for the given progressBlock to aString."
- progressBlock value: aString!
Item was removed:
- ----- Method: SystemProgressMorph>>labels (in category 'accessing') -----
- labels
-
- ^ labels!
Item was removed:
- ----- Method: SystemProgressMorph>>labels: (in category 'accessing') -----
- labels: anObject
-
- labels := anObject!
Item was removed:
- ----- Method: SystemProgressMorph>>nextSlotFor: (in category 'private') -----
- nextSlotFor: shortDescription
-
- lock critical: [ | label bar slots |
- slots := self labels size.
- self activeSlots = slots ifTrue: [^0].
- self activeSlots: self activeSlots + 1.
- 1 to: slots do: [:index |
- label := (self labels at: index).
- label ifNil: [
- bar := self bars at: index put: self createProgressBar.
- label := self labels at: index put: (self createProgressLabel: shortDescription).
- self
- addMorphBack: label;
- addMorphBack: bar.
- ^index].
- label owner ifNil: [
- bar := self bars at: index.
- label := self labels at: index.
- self
- addMorphBack: (label contents: shortDescription);
- addMorphBack: (bar barSize: 0).
- ^index]]]
- !
Item was removed:
- ----- Method: SystemProgressMorph>>position:label:min:max: (in category 'private') -----
- position: aPoint label: shortDescription min: minValue max: maxValue
- | slot range barSize lastRefresh |
- self requestedPosition: aPoint.
- ((range := maxValue - minValue) < 0 or: [(slot := self nextSlotFor: shortDescription) = 0])
- ifTrue: [^[:barVal| 0 ]].
- range <= 0 ifTrue: [self removeMorph: (self bars at: slot)].
- self reposition.
- self openInWorld.
- barSize := -1. "Enforces a inital draw of the morph"
- lastRefresh := 0.
- ^[:barVal | | newBarSize |
- barVal isString ifTrue: [
- self setLabel: barVal at: slot.
- self currentWorld displayWorld].
- (barVal isNumber and: [range >= 1 and: [barVal between: minValue and: maxValue]]) ifTrue: [
- newBarSize := (barVal - minValue / range * BarWidth) truncated.
- newBarSize = barSize ifFalse: [
- barSize := newBarSize.
- (self bars at: slot) barSize: barSize.
- Time utcMicrosecondClock - lastRefresh > 25000 ifTrue: [
- self refreshWorld.
- lastRefresh := Time utcMicrosecondClock]]].
- slot]!
Item was removed:
- ----- Method: SystemProgressMorph>>recenter (in category 'private') -----
- recenter
- | position |
- "This method is no longer used, but kept for a while longer to ensure no difficulties updating via the trunk."
- "Put ourself in the center of the display"
- self align: self fullBounds center with: Display boundingBox center.
- "Check to see if labels are wider than progress bars. In that case do
- a centered instead of the default left aligned layout."
- position := self width > (Inset x * 2 + (self borderWidth * 2) + BarWidth)
- ifTrue: [#topCenter]
- ifFalse: [#leftCenter].
- self cellPositioning: position!
Item was removed:
- ----- Method: SystemProgressMorph>>reposition (in category 'private') -----
- reposition
- "Put ourself in the requested position on the display, but ensure completely within the bounds of the display. Compute layout first via #fullBounds to get correct #center."
-
- self fullBounds.
- self bounds:
- ((self bounds
- align: self center
- with: (self requestedPosition ifNil: [ self center ]))
- translatedToBeWithin: self currentWorld bounds).
-
- "Check to see if labels are wider than progress bars. In that case do a centered instead of the default left aligned layout."
- self cellPositioning:
- (self layoutExtent x > BarWidth
- ifTrue: [ #topCenter ]
- ifFalse: [ #leftCenter ]).!
Item was removed:
- ----- Method: SystemProgressMorph>>requestedPosition (in category 'accessing') -----
- requestedPosition
-
- ^ requestedPosition!
Item was removed:
- ----- Method: SystemProgressMorph>>requestedPosition: (in category 'accessing') -----
- requestedPosition: anObject
- "only change the progress bar position if this is an occasion when the progress bar is opening with a single active bar. After that we don't want to change the position and leap around the screen"
- activeSlots < 1 ifTrue:[ requestedPosition := anObject]!
Item was removed:
- ----- Method: SystemProgressMorph>>setDefaultParameters (in category 'initialization') -----
- setDefaultParameters
- "change the receiver's appareance parameters"
-
- self
- color: (self userInterfaceTheme color ifNil: [Color r: 0.9 g: 0.9 b: 0.9]);
- borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle simple]) copy;
- borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]);
- borderWidth: ((self userInterfaceTheme borderWidth ifNil: [1]) * RealEstateAgent scaleFactor) truncated.
-
- Preferences menuAppearance3d ifTrue: [self addDropShadow].
-
- self
- font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]);
- textColor: (self userInterfaceTheme textColor ifNil: [Color black]).
-
- self
- updateColor: self
- color: self color
- intensity: 1.!
Item was removed:
- ----- Method: SystemProgressMorph>>setLabel:at: (in category 'labelling') -----
- setLabel: shortDescription at: slot
- (self labels at: slot) contents: (shortDescription ifNotNil: [
- self flag: #todo. "mt: Allow multi-line descriptions... Then see DialogWindow >> #message:."
- shortDescription truncateWithElipsisTo: 100]).
- self reposition!
Item was removed:
- ----- Method: SystemProgressMorph>>slideToTrash: (in category 'dropping/grabbing') -----
- slideToTrash: evt
- "If the user needs to dismiss a progress morph by hand, start with a
- fresh instance next time."
- self dismissViaHalo!
Item was removed:
- ----- Method: SystemProgressMorph>>textColor (in category 'accessing') -----
- textColor
-
- ^ textColor ifNil: [Color black]!
Item was removed:
- ----- Method: SystemProgressMorph>>textColor: (in category 'accessing') -----
- textColor: aColor
-
- textColor := aColor.
- self labels select: [:ea | ea notNil] thenDo: [:ea | ea color: textColor].!
Item was removed:
- ----- Method: SystemProgressMorph>>updateColor:color:intensity: (in category 'initialization') -----
- updateColor: aMorph color: aColor intensity: anInteger
- "update the apareance of aMorph"
- | fill cc |
- MenuMorph gradientMenu
- ifFalse: [^ self].
-
-
- cc := aColor adjustSaturation: -0.08 brightness: 0.4.
- fill := GradientFillStyle ramp: {
- 0.0 -> cc.
- 0.25 -> (aColor mixed: 0.5 with: cc).
- 1.0 -> aColor}.
-
- fill radial: false;
- origin: aMorph topLeft;
- direction: 0 @ aMorph height.
- aMorph fillStyle: fill!
Item was removed:
- ----- Method: SystemProgressMorph>>wantsRoundedCorners (in category 'rounding') -----
- wantsRoundedCorners
-
- ^ MenuMorph roundedMenuCorners or: [super wantsRoundedCorners]!
Item was removed:
- MorphicModel subclass: #SystemWindow
- instanceVariableNames: 'labelString stripes label closeBox collapseBox paneMorphs paneRects collapsedFrame fullFrame isCollapsed isActive isLookingFocused menuBox mustNotClose labelWidgetAllowance updatablePanes allowReframeHandles labelArea expandBox'
- classVariableNames: 'ClickOnLabelToEdit CloseBoxFrame CloseBoxImageFlat CloseBoxImageGradient CollapseBoxImageFlat CollapseBoxImageGradient DoubleClickOnLabelToExpand DragToEdges ExpandBoxFrame ExpandBoxImageFlat ExpandBoxImageGradient FocusFollowsMouse GradientWindow HideExpandButton MenuBoxFrame MenuBoxImageFlat MenuBoxImageGradient ResizeAlongEdges ReuseWindows RoundedWindowCorners TopWindow WindowTitleActiveOnFirstClick WindowsRaiseOnClick'
- poolDictionaries: ''
- category: 'Morphic-Windows'!
-
- !SystemWindow commentStamp: '<historical>' prior: 0!
- SystemWindow is the Morphic equivalent of StandardSystemView -- a labelled container for rectangular views, with iconic facilities for close, collapse/expand, and resizing.
-
- The attribute onlyActiveOnTop, if set to true (and any call to activate will set this), determines that only the top member of a collection of such windows on the screen shall be active. To be not active means that a mouse click in any region will only result in bringing the window to the top and then making it active.!
Item was removed:
- ----- Method: SystemWindow class>>borderWidth (in category 'initializing') -----
- borderWidth
-
- ^ AbstractResizerMorph gripThickness!
Item was removed:
- ----- Method: SystemWindow class>>boxExtent (in category 'preferences') -----
- boxExtent
- "answer the extent to use in all the buttons"
-
- ^ ((Preferences alternativeWindowBoxesLook
- ifTrue: [18 @ 18]
- ifFalse: [16 @ 16]) * RealEstateAgent scaleFactor) truncated!
Item was removed:
- ----- Method: SystemWindow class>>bringWindowUnderHandToFront (in category 'top window') -----
- bringWindowUnderHandToFront
- "This only works when All Windows Active is enabled."
- (self windowsIn: Project current world) do: [ : each | each isLookingFocused ifTrue: [ ^ each beKeyWindow ]]!
Item was removed:
- ----- Method: SystemWindow class>>classVersion (in category 'initializing') -----
- classVersion
- "Changed to 1 for SystemWindow Dec 2000 - see if this helps loading old ones"
- ^ 1!
Item was removed:
- ----- Method: SystemWindow class>>clearTopWindow (in category 'top window') -----
- clearTopWindow
-
- TopWindow := nil. "if leaving morphic to export from mvc, this ref could cause problems"!
Item was removed:
- ----- Method: SystemWindow class>>clickOnLabelToEdit (in category 'preferences') -----
- clickOnLabelToEdit
-
- <preference: 'Click On Label To Edit'
- category: 'windows'
- description: 'If true, a click on the label of a system window lets you edit it'
- type: #Boolean>
- ^ ClickOnLabelToEdit ifNil: [false].
- !
Item was removed:
- ----- Method: SystemWindow class>>clickOnLabelToEdit: (in category 'preferences') -----
- clickOnLabelToEdit: aBoolean
-
- ClickOnLabelToEdit := aBoolean.
- self refreshAllWindows.!
Item was removed:
- ----- Method: SystemWindow class>>closeBoxFrame (in category 'preferences') -----
- closeBoxFrame
-
- ^ CloseBoxFrame ifNil: [
- CloseBoxFrame := (LayoutFrame new
- leftFraction: 0;
- leftOffset: 2;
- topFraction: 0;
- topOffset: 0;
- yourself)]!
Item was removed:
- ----- Method: SystemWindow class>>closeBoxImage (in category 'initializing') -----
- closeBoxImage
-
- ^ self gradientWindow
- ifTrue: [self closeBoxImageGradient]
- ifFalse: [self closeBoxImageFlat].
- !
Item was removed:
- ----- Method: SystemWindow class>>closeBoxImageFlat (in category 'initializing') -----
- closeBoxImageFlat
-
- ^ CloseBoxImageFlat ifNil: [CloseBoxImageFlat := (Form
- extent: 12 at 12
- depth: 32
- fromArray: #( 0 0 552294233 2683000665 4025177945 4293613401 4293613401 4025177945 2683000665 552294233 0 0 0 1089165145 4025177945 4293613401 4293613401 4293613401 4293613401 4293613401 4293613401 4025177945 820729689 0 552294233 4025177945 4293613401 4293613401 4293613401 4293613401 4293613401 4293613401 4293613401 4293613401 4025177945 283858777 2683000665 4293613401 4293613401 4294492353 4294492353 4293613401 4293613401 4294492353 4294492353 4293613401 4293613401 2683000665 4025177945 4293613401 4293613401 4294492353 4294967295 4294492353 4294492353 4294967295 4294492353 4293613401 4293613401 4025177945 4293613401 4293613401 4293613401 4293613401 4294492353 4294967295 4294967295 4294492353 4293613401 4293613401 4293613401 4293613401 4293613401 4293613401 4293613401 4293613401 4294492353 4294967295 4294967295 4294492353 4293613401 4293613401 4293613401 4293613401 4025177945 4293613401 4293613401 4294492353 4294967295 4294492353 4294492353 4294967295 4294492353 4293613401 429361
3401 3756742489 2683000665 4293613401 4293613401 4294492353 4294492353 4293613401 4293613401 4294492353 4294492353 4293613401 4293613401 2162906969 552294233 4025177945 4293613401 4293613401 4293613401 4293613401 4293613401 4293613401 4293613401 4293613401 4025177945 283858777 0 820729689 4025177945 4293613401 4293613401 4293613401 4293613401 4293613401 4293613401 4025177945 820729689 0 0 0 283858777 2683000665 4025177945 4293613401 4293613401 3756742489 2162906969 283858777 0 0)
- offset: 0 at 0)]!
Item was removed:
- ----- Method: SystemWindow class>>closeBoxImageGradient (in category 'initializing') -----
- closeBoxImageGradient
-
- ^ CloseBoxImageGradient ifNil: [CloseBoxImageGradient := (Form
- extent: 14 at 14
- depth: 32
- fromArray: #(0 0 6032910 288687365 1550655006 2844865845 3450028610 3450028610 2828088372 1550655006 288687365 5967374 0 0 1377027 15091784 844830230 3063889984 4158092147 4294153621 4294681250 4294681250 4294153364 4158091376 3047046718 844764694 14763847 1376770 7742243 861541910 3585164870 4294282123 4294943908 4294943908 4294943651 4294943651 4294943908 4294943908 4294216330 3585099848 844764694 7676450 288098055 3047109684 4294211447 4294939539 4293757578 4293363848 4294939025 4294939282 4293954186 4293560456 4294939539 4294212732 3047110455 288031748 1584209695 4158081610 4294932343 4293753466 4291733929 4291802549 4293164156 4293884281 4291666594 4291670192 4293294457 4294933885 4158018130 1567432222 2861706541 4294136145 4294924376 4292761945 4292198592 4294704894 4292064950 4291403679 4294375158 4293057499 4291846497 4294925147 4294136659 2844863789 3483644980 4294660947 4294923605 4294857555 4292566879 4292658886 4294770173 4294704380 4293452000 4291981681 4294595154 429
4923605 4294660947 3466867764 3500422196 4294726483 4294923605 4294923605 4293742415 4291402908 4294836223 4294967295 4292198592 4292760660 4294923348 4294923605 4294660947 3483644980 2878484014 4294136145 4294923605 4293939794 4291728018 4294375158 4293452257 4292793042 4294704637 4292128944 4293154390 4294923605 4294136145 2878484014 1617830177 4174923591 4294923862 4292957011 4292000442 4293386721 4291915888 4292238685 4292659400 4292595406 4292303450 4294923605 4158146375 1617829920 305072650 3097572147 4294267217 4294923348 4292631901 4291781989 4294595154 4294857555 4292435036 4292238942 4294857812 4294267217 3097506611 305007114 8070437 912005658 3635624249 4294333010 4294923605 4294857555 4294923605 4294923605 4294923348 4294923348 4294333010 3635624249 895228442 8004901 1639428 16735838 912071451 3131126579 4191766343 4294267217 4294726740 4294726740 4294201681 4191766343 3131126579 895293978 16735067 1573892 0 0 6888733 322506254 1651515681 2945723950 3550885173 3550885173
2945723950 1651515681 322440718 6822940 0 0)
- offset: 0 at 0)]!
Item was removed:
- ----- Method: SystemWindow class>>closeTopWindow (in category 'top window') -----
- closeTopWindow
- "Try to close the top window. It may of course decline"
-
- TopWindow ifNotNil:
- [TopWindow delete]!
Item was removed:
- ----- Method: SystemWindow class>>collapseBoxImage (in category 'initializing') -----
- collapseBoxImage
-
- ^ self gradientWindow
- ifTrue: [self collapseBoxImageGradient]
- ifFalse: [self collapseBoxImageFlat].
- !
Item was removed:
- ----- Method: SystemWindow class>>collapseBoxImageFlat (in category 'initializing') -----
- collapseBoxImageFlat
-
- ^ CollapseBoxImageFlat ifNil: [CollapseBoxImageFlat := (Form
- extent: 12 at 12
- depth: 32
- fromArray: #( 0 0 552699410 2683405842 4025583122 4294018578 4294018578 4025583122 2683405842 552699410 0 0 0 1089570322 4025583122 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4025583122 821134866 0 552699410 4025583122 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4025583122 284263954 2683405842 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 2683405842 4025583122 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4025583122 4294018578 4294221118 4294762948 4294762948 4294762948 4294762948 4294762948 4294762948 4294762948 4294762948 4294221118 4294018578 4294018578 4294221118 4294762948 4294762948 4294762948 4294762948 4294762948 4294762948 4294762948 4294762948 4294221118 4294018578 4025583122 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 429401
8578 3757147666 2683405842 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 2163312146 552699410 4025583122 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4025583122 284263954 0 821134866 4025583122 4294018578 4294018578 4294018578 4294018578 4294018578 4294018578 4025583122 821134866 0 0 0 284263954 2683405842 4025583122 4294018578 4294018578 3757147666 2163312146 284263954 0 0)
- offset: 0 at 0)]!
Item was removed:
- ----- Method: SystemWindow class>>collapseBoxImageGradient (in category 'initializing') -----
- collapseBoxImageGradient
-
- ^ CollapseBoxImageGradient ifNil: [CollapseBoxImageGradient := (Form
- extent: 14 at 14
- depth: 32
- fromArray: #(0 768 5853184 288569344 1550537988 2844748052 3449976096 3449976096 2827970835 1550537731 288569600 5787392 768 0 1256960 15043082 844713216 3063837470 4158037328 4294162549 4294689156 4294689156 4294162292 4158036813 3046994460 844713216 14714890 1256704 7690756 861424896 3585112609 4294226279 4294952069 4294952069 4294951812 4294951812 4294952069 4294952068 4294226278 3585047331 844647680 7625220 287914752 3047058190 4294222924 4294949230 4294948716 4294948716 4294948716 4294948716 4294948716 4294948717 4294949231 4294223955 3047058707 287914240 1584092675 4158030361 4294944327 4294945619 4294945877 4294946134 4294946134 4294945877 4294945619 4294945102 4294944587 4294945360 4158031652 1567315202 2861589770 4294150937 4294938911 4294217252 4293955628 4294021937 4294021938 4294021421 4294020390 4293954079 4294084893 4294873892 4294151196 2844812298 3483593741 4294741530 4294478360 4291271017 4292461743 4292461485 4292461485 4292461485 4292461485 4292527535 4291340680
4293625630 4294807066 3466816525 3500370957 4294741530 4294347032 4291669904 4294112759 4294112244 4294112244 4294112244 4294112244 4294243831 4292200893 4293428769 4294807066 3483593741 2878432779 4294150937 4294806810 4292511536 4292382532 4292382531 4292382531 4292382531 4292382531 4292382532 4292249912 4294347548 4294216473 2878432523 1617712902 4174872597 4294938651 4294938393 4294938136 4294938136 4294938136 4294938136 4294938136 4294938136 4294938393 4294938651 4158095381 1617712902 304955136 3097520909 4294282265 4294938395 4294938395 4294938395 4294938395 4294938395 4294938395 4294938395 4294938395 4294282009 3097455373 304889600 7953671 911888388 3635573264 4294347801 4294938651 4294938395 4294938395 4294938395 4294938395 4294938651 4294347801 3635573264 895111172 7888135 1520128 16753431 911954180 3131075341 4191781141 4294216473 4294741530 4294741530 4294216473 4191781141 3131075341 895176964 16752406 1454592 0 3072 6708483 322388481 1651398919 2945607436 3550833934 355
0833934 2945607436 1651398919 322322945 6642947 2816 0)
- offset: 0 at 0)]!
Item was removed:
- ----- Method: SystemWindow class>>deleteTopWindow (in category 'top window') -----
- deleteTopWindow
- TopWindow ifNotNil: [ TopWindow delete ]!
Item was removed:
- ----- Method: SystemWindow class>>doubleClickOnLabelToExpand (in category 'preferences') -----
- doubleClickOnLabelToExpand
-
- <preference: 'Double-Click On Label To Expand'
- category: 'windows'
- description: 'Activates expansion through double-clicking on the window label area. This mimics the behavior in many current operating systems'
- type: #Boolean>
- ^ DoubleClickOnLabelToExpand ifNil: [true].
- !
Item was removed:
- ----- Method: SystemWindow class>>doubleClickOnLabelToExpand: (in category 'preferences') -----
- doubleClickOnLabelToExpand: aBoolean
-
- DoubleClickOnLabelToExpand := aBoolean.
- self refreshAllWindows.
- !
Item was removed:
- ----- Method: SystemWindow class>>dragToEdges (in category 'preferences') -----
- dragToEdges
- <preference: 'Drag To Edges'
- category: 'windows'
- description: 'When true, windows snap and resize to corners and edges of the Display.'
- type: #Boolean>
- ^DragToEdges ifNil: [false]!
Item was removed:
- ----- Method: SystemWindow class>>dragToEdges: (in category 'preferences') -----
- dragToEdges: aBoolean
- DragToEdges := aBoolean!
Item was removed:
- ----- Method: SystemWindow class>>expandBoxFrame (in category 'preferences') -----
- expandBoxFrame
-
- ^ ExpandBoxFrame ifNil: [
- ExpandBoxFrame := (LayoutFrame new
- leftFraction: 1;
- leftOffset: (self boxExtent x * 2 + 3) negated;
- topFraction: 0;
- topOffset: 0;
- yourself)]!
Item was removed:
- ----- Method: SystemWindow class>>expandBoxImage (in category 'initializing') -----
- expandBoxImage
-
- ^ self gradientWindow
- ifTrue: [self expandBoxImageGradient]
- ifFalse: [self expandBoxImageFlat].
- !
Item was removed:
- ----- Method: SystemWindow class>>expandBoxImageFlat (in category 'initializing') -----
- expandBoxImageFlat
-
- ^ ExpandBoxImageFlat ifNil: [ExpandBoxImageFlat := (Form
- extent: 12 at 12
- depth: 32
- fromArray: #( 0 0 542547506 2673253938 4015431218 4283866674 4283866674 4015431218 2673253938 542547506 0 0 0 1079418418 4015431218 4283866674 4283866674 4285968472 4285968472 4283866674 4283866674 4015431218 810982962 0 542547506 4015431218 4283866674 4283866674 4283866674 4292208588 4292208588 4283866674 4283866674 4283866674 4015431218 274112050 2673253938 4283866674 4283866674 4283866674 4283866674 4292208588 4292208588 4283866674 4283866674 4283866674 4283866674 2673253938 4015431218 4283866674 4283866674 4283866674 4283866674 4292208588 4292208588 4283866674 4283866674 4283866674 4283866674 4015431218 4283866674 4285968472 4292208588 4292208588 4292208588 4294244850 4294244850 4292208588 4292208588 4292208588 4285968472 4283866674 4283866674 4285968472 4292208588 4292208588 4292208588 4294244850 4294244850 4292208588 4292208588 4292208588 4285968472 4283866674 4015431218 4283866674 4283866674 4283866674 4283866674 4292208588 4292208588 4283866674 4283866674 4283866674 428386
6674 3746995762 2673253938 4283866674 4283866674 4283866674 4283866674 4292208588 4292208588 4283866674 4283866674 4283866674 4283866674 2153160242 542547506 4015431218 4283866674 4283866674 4283866674 4292208588 4292208588 4283866674 4283866674 4283866674 4015431218 274112050 0 810982962 4015431218 4283866674 4283866674 4285968472 4285968472 4283866674 4283866674 4015431218 810982962 0 0 0 274112050 2673253938 4015431218 4283866674 4283866674 3746995762 2153160242 274112050 0 0)
- offset: 0 at 0)]!
Item was removed:
- ----- Method: SystemWindow class>>expandBoxImageGradient (in category 'initializing') -----
- expandBoxImageGradient
-
- ^ ExpandBoxImageGradient ifNil: [ExpandBoxImageGradient := (Form
- extent: 14 at 14
- depth: 32
- fromArray: #(0 0 1058562 285544960 1545616142 2838976800 3443812652 3443812652 2822199328 1545550349 285610496 1058562 0 0 197889 5015843 840445449 3057804586 4151680347 4288134782 4288989580 4288989580 4288134525 4151549016 3040961576 840379656 4949796 132352 2441745 857222409 3578360366 4287543665 4289187213 4289121422 4288857993 4288792456 4289121421 4289121677 4287478128 3578491696 840445193 2375953 285740802 3040304923 4286295641 4288070777 4288004983 4287543410 4288524177 4289312671 4287344755 4288004983 4288136313 4286624095 3040502048 285543680 1579236111 4149118761 4286297173 4286822495 4286888545 4286426462 4291679432 4293717227 4286752873 4286560090 4286428504 4286691421 4149578546 1562393102 2855294231 4283865130 4284326448 4284325172 4284718907 4284716865 4291416516 4293651691 4285043786 4284061998 4283996461 4284523316 4283996461 2838517015 3476513307 4284063275 4283865386 4287341947 4290759608 4290693559 4293717483 4294572537 4291153599 4290759607 4288129929 4283864
876 4283997739 3459736090 3493290523 4284063275 4283799593 4289312927 4294243316 4294046193 4294769916 4294901502 4294177779 4294243316 4290364338 4283864621 4284063275 3476513306 2872071703 4283865130 4284063275 4284453693 4285176395 4285109069 4291811019 4293849070 4285962336 4285110602 4284585024 4283997227 4283799593 2872071447 1612856592 4165698852 4284195372 4284063786 4284064041 4283864620 4291285440 4293651690 4284782402 4283998248 4284063786 4284195372 4148921636 1612856336 302649860 3090571034 4283865642 4284129580 4284129580 4283930157 4289378465 4291218626 4284519486 4284064042 4284129580 4283865642 3090505498 302649604 2573587 907751437 3627904029 4283865642 4284195372 4284063275 4284060978 4284126260 4283996972 4284195372 4283865642 3627838237 890974221 2573330 263937 6533168 907817229 3124125722 4182476324 4283865386 4284063531 4284063531 4283865386 4182476324 3124125722 891040013 6335279 263937 0 0 1979406 319691015 1646476817 2939246103 3543687963 3543687963 2939246
103 1646476817 319691015 1979406 0 0)
- offset: 0 at 0) ]!
Item was removed:
- ----- Method: SystemWindow class>>gradientWindow (in category 'preferences') -----
- gradientWindow
-
- <preference: 'gradientWindow'
- category: 'windows'
- description: 'If true, windows will have a gradient look.'
- type: #Boolean>
- ^ GradientWindow ifNil: [true]
- !
Item was removed:
- ----- Method: SystemWindow class>>gradientWindow: (in category 'preferences') -----
- gradientWindow: aBoolean
-
- aBoolean = GradientWindow ifTrue: [^ self].
- GradientWindow := aBoolean.
- self refreshAllWindows.!
Item was removed:
- ----- Method: SystemWindow class>>hideExpandButton (in category 'preferences') -----
- hideExpandButton
-
- <preference: 'Hide Expand Button'
- category: 'windows'
- description: 'Hides the expand ( + ) button in all window titlebars'
- type: #Boolean>
- ^ HideExpandButton ifNil: [ false ]
- !
Item was removed:
- ----- Method: SystemWindow class>>hideExpandButton: (in category 'preferences') -----
- hideExpandButton: aBoolean
-
- HideExpandButton := aBoolean.
- "Have the menu button frame rebuilt accordingly"
- self moveMenuButtonRight: self moveMenuButtonRight.
- !
Item was removed:
- ----- Method: SystemWindow class>>includeInNewMorphMenu (in category 'new-morph participation') -----
- includeInNewMorphMenu
- "Include my subclasses but not me"
- ^ self ~~ SystemWindow!
Item was removed:
- ----- Method: SystemWindow class>>keyWindow (in category 'top window') -----
- keyWindow
- "Multiple windows may appear to be on top, especially on large screens. Only one window, however, can be the key window, which gets the programmers primary attention."
-
- ^ TopWindow!
Item was removed:
- ----- Method: SystemWindow class>>labelled: (in category 'instance creation') -----
- labelled: labelString
-
- ^ self basicNew
- initializeWithLabel: labelString;
- yourself!
Item was removed:
- ----- Method: SystemWindow class>>menuBoxFrame (in category 'preferences') -----
- menuBoxFrame
-
- ^ MenuBoxFrame ifNil: [
- MenuBoxFrame := (LayoutFrame new
- leftFraction: 0;
- leftOffset: self boxExtent x + 3;
- topFraction: 0;
- topOffset: 0;
- yourself)]!
Item was removed:
- ----- Method: SystemWindow class>>menuBoxImage (in category 'initializing') -----
- menuBoxImage
-
- ^ self gradientWindow
- ifTrue: [self menuBoxImageGradient]
- ifFalse: [self menuBoxImageFlat].
- !
Item was removed:
- ----- Method: SystemWindow class>>menuBoxImageFlat (in category 'initializing') -----
- menuBoxImageFlat
-
- ^ MenuBoxImageFlat ifNil: [MenuBoxImageFlat := (Form
- extent: 12 at 12
- depth: 32
- fromArray: #( 0 0 540831669 2671538101 4013715381 4282150837 4282150837 4013715381 2671538101 540831669 0 0 0 1077702581 4013715381 4282150837 4282150837 4282150837 4282150837 4282150837 4282150837 4013715381 809267125 0 540831669 4013715381 4282150837 4282150837 4282150837 4282150837 4282150837 4282150837 4282150837 4282150837 4013715381 272396213 2671538101 4282150837 4282150837 4282150837 4282150837 4282150837 4282150837 4282150837 4282150837 4282150837 4282150837 2671538101 4013715381 4282150837 4284582595 4288591834 4288591834 4288591834 4288591834 4288591834 4288591834 4283728318 4282150837 4013715381 4282150837 4282150837 4282939578 4292535537 4294967295 4294967295 4294967295 4294967295 4292535537 4282150837 4282150837 4282150837 4282150837 4282150837 4282150837 4284582595 4294967295 4294967295 4294967295 4294178554 4283728318 4282150837 4282150837 4282150837 4013715381 4282150837 4282150837 4282150837 4287737557 4294967295 4294967295 4286948817 4282150837 4282150837 428215
0837 3745279925 2671538101 4282150837 4282150837 4282150837 4282150837 4291746797 4290958056 4282150837 4282150837 4282150837 4282150837 2151444405 540831669 4013715381 4282150837 4282150837 4282150837 4282939578 4282939578 4282150837 4282150837 4282150837 4013715381 272396213 0 809267125 4013715381 4282150837 4282150837 4282150837 4282150837 4282150837 4282150837 4013715381 809267125 0 0 0 272396213 2671538101 4013715381 4282150837 4282150837 3745279925 2151444405 272396213 0 0)
- offset: 0 at 0)]!
Item was removed:
- ----- Method: SystemWindow class>>menuBoxImageGradient (in category 'initializing') -----
- menuBoxImageGradient
-
- ^ MenuBoxImageGradient ifNil: [MenuBoxImageGradient := (Form
- extent: 14 at 14
- depth: 32
- fromArray: #(0 0 7774 285216318 1544039783 2837267842 3442168720 3442168720 2820490625 1544039782 285216574 7774 0 0 2087 1532860 839001178 3056161165 4150166716 4286817494 4287738079 4287803615 4286751958 4150035131 3039252364 839001178 1467065 1831 668526 855712858 3576584601 4286029012 4287935459 4287935458 4287869666 4287869666 4287935458 4287869923 4285963476 3576715929 838935642 602733 285216827 3038463881 4284517582 4286621149 4286489564 4286489564 4286489564 4286489564 4286489564 4286489820 4286621149 4284911823 3038726794 285216058 1577594471 4147012271 4284387029 4284978391 4285043927 4285109719 4285109719 4285044183 4284978135 4284649685 4284518357 4284912599 4147603633 1560751463 2853453696 4281560257 4281888189 4283200687 4284186808 4284515256 4284515257 4284252600 4283858102 4283529653 4282740653 4282151359 4281757378 2836676480 3474606220 4281757894 4281559740 4285761703 4292993507 4293454315 4293388522 4293388522 4293454315 4292862177 4285432998 4281494205 42816921
02 3457829004 3491383436 4281757638 4281758153 4281953722 4288589251 4294835708 4294967295 4294967295 4294769659 4288194752 4281887931 4281823689 4281692102 3474606220 2870296704 4281560257 4281823689 4281758153 4282215861 4289838026 4294967294 4294967038 4289377991 4282084534 4281758153 4281823689 4281560257 2870296704 1611280232 4163592111 4281823946 4281823688 4281692360 4282740914 4291152852 4290758353 4282544051 4281692361 4281823688 4281823946 4146749358 1611214696 301994814 3088664202 4281626050 4281823689 4281823688 4281692103 4282937773 4282806447 4281692360 4281823688 4281823689 4281626050 3088664202 301994814 734577 906307420 3625930390 4281626050 4281823946 4281823689 4281692360 4281692360 4281823689 4281823946 4281626050 3625930390 889530204 734576 2347 2392036 906373213 3122218634 4180369583 4281560257 4281757638 4281757638 4281560257 4180369583 3122218634 889595997 2325471 2346 0 3 76907 318773060 1644834921 2937405569 3541780621 3541780621 2937405569 1644834921 31877
3059 76906 2 0)
- offset: 0 at 0)]!
Item was removed:
- ----- Method: SystemWindow class>>moveMenuButtonRight (in category 'preferences') -----
- moveMenuButtonRight
-
- <preference: 'Move Menu Button Right'
- category: 'windows'
- description: 'Moves the menu to the right side of the window label area, while traditionally it used to be on the left side'
- type: #Boolean>
- ^ self menuBoxFrame leftOffset negative
- !
Item was removed:
- ----- Method: SystemWindow class>>moveMenuButtonRight: (in category 'preferences') -----
- moveMenuButtonRight: aBooleanOrNil
-
- | absLeftOffset moveToRight |
- moveToRight := aBooleanOrNil ifNil: [true "default value"].
- absLeftOffset := ((self hideExpandButton and: [moveToRight])
- ifTrue: [absLeftOffset := self boxExtent x * 2]
- ifFalse: [absLeftOffset := self boxExtent x]) + 3.
- self menuBoxFrame leftOffset: (moveToRight
- ifTrue: [absLeftOffset negated]
- ifFalse: [absLeftOffset]).
- self refreshAllWindows.!
Item was removed:
- ----- Method: SystemWindow class>>noteTopWindowIn: (in category 'top window') -----
- noteTopWindowIn: aWorld
- "Look for a new top window in the given world. We have to reset the former top window because this is global state shared between all worlds."
-
- | newTopWindow |
- TopWindow := nil.
- newTopWindow := nil.
-
- aWorld ifNil: [^ self].
-
- aWorld submorphsDo: [:m |
- (m isSystemWindow and: [newTopWindow isNil])
- ifTrue: [newTopWindow := m].
-
- self flag: #refactor. "This really belongs in a special ProjWindow class"
- (m model isKindOf: Project)
- ifTrue: [m label ~= m model name ifTrue: [m setLabel: m model name]]].
-
- newTopWindow ifNotNil: [newTopWindow beKeyWindow].!
Item was removed:
- ----- Method: SystemWindow class>>reconfigureWindowsForFocus (in category 'private') -----
- reconfigureWindowsForFocus
-
- self allSubInstancesDo: [:window |
- window
- passivate;
- activate;
- unlockWindowDecorations;
- passivateIfNeeded].
- self topWindow ifNotNil: [:wnd | wnd activate].!
Item was removed:
- ----- Method: SystemWindow class>>refreshAllWindows (in category 'initializing') -----
- refreshAllWindows
- "If there is some prominent UI change, use this method to update all open windows."
-
- SystemWindow allSubInstances do: [:w |
- w
- replaceBoxes;
- setDefaultParameters;
- refreshWindowColor].!
Item was removed:
- ----- Method: SystemWindow class>>resizeAlongEdges (in category 'preferences') -----
- resizeAlongEdges
- <preference: 'Resize Windows along edges'
- category: 'Morphic'
- description: 'When true, windows can be resized along their edges as well as the corners'
- type: #Boolean>
- ^ResizeAlongEdges ifNil:[true]!
Item was removed:
- ----- Method: SystemWindow class>>resizeAlongEdges: (in category 'preferences') -----
- resizeAlongEdges: aBool
- "Preference setter"
- ResizeAlongEdges := aBool!
Item was removed:
- ----- Method: SystemWindow class>>reuseWindows (in category 'preferences') -----
- reuseWindows
-
- <preference: 'Reuse Windows'
- category: 'browsing'
- description: 'When enabled, before opening a new window check if there is any open window like it, and if there is, reuse it.'
- type: #Boolean>
- ^ReuseWindows ifNil: [ false ]
- !
Item was removed:
- ----- Method: SystemWindow class>>reuseWindows: (in category 'preferences') -----
- reuseWindows: aBoolean
-
- ReuseWindows := aBoolean!
Item was removed:
- ----- Method: SystemWindow class>>roundedWindowCorners (in category 'preferences') -----
- roundedWindowCorners
-
- <preference: 'Rounded Window Corners'
- category: 'windows'
- description: 'If true, windows will have rounded corners.'
- type: #Boolean>
- ^ RoundedWindowCorners ifNil: [false]!
Item was removed:
- ----- Method: SystemWindow class>>roundedWindowCorners: (in category 'preferences') -----
- roundedWindowCorners: aBoolean
-
- RoundedWindowCorners = aBoolean ifTrue: [^ self].
- RoundedWindowCorners := aBoolean.
- self refreshAllWindows.!
Item was removed:
- ----- Method: SystemWindow class>>sendTopWindowToBack (in category 'top window') -----
- sendTopWindowToBack
- "Send the top window of the world to the back, activating the one just beneath it"
-
- TopWindow ifNotNil:
- [TopWindow sendToBack]!
Item was removed:
- ----- Method: SystemWindow class>>themePriority (in category 'preferences') -----
- themePriority
-
- ^ 30!
Item was removed:
- ----- Method: SystemWindow class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ super themeProperties, {
- { #borderColorModifier. 'Colors'. 'How to derive the borderColor from the window color.' }.
- { #borderWidth. 'Borders'. 'Width of the window''s border.' }.
- { #titleFont. 'Fonts'. 'Font of the window title.' }.
-
- { #unfocusedWindowColorModifier. 'Colors'. 'A block with one argument that modifies a color to look unfocused.' }.
- { #unfocusedLabelColor. 'Colors'. 'Window title color when window has no focus.'}.
- { #focusedLabelColor. 'Colors'. 'Window title color when window has focus.'}.
-
- { #color. 'Colors'. 'Color to use if the model or the pane morphs do not provide one.' }.
-
- { #closeBoxImage. 'Icons'. 'Icon to click on to close the window.' }.
- { #collapseBoxImage. 'Icons'. 'Icon to click on to collapse the window.' }.
- { #expandBoxImage. 'Icons'. 'Icon to click on to expand the window.' }.
- { #menuBoxImage. 'Icons'. 'Icon to click on to show window/application menu.' }.
- }!
Item was removed:
- ----- Method: SystemWindow class>>topWindow (in category 'top window') -----
- topWindow
- ^ TopWindow!
Item was removed:
- ----- Method: SystemWindow class>>wakeUpTopWindowUponStartup (in category 'top window') -----
- wakeUpTopWindowUponStartup
- TopWindow ifNotNil:
- [TopWindow isCollapsed ifFalse:
- [TopWindow model ifNotNil:
- [TopWindow model modelWakeUpIn: TopWindow]]]!
Item was removed:
- ----- Method: SystemWindow class>>windowTitleActiveOnFirstClick (in category 'preferences') -----
- windowTitleActiveOnFirstClick
- <preference: 'Windows'' Controls Are Always Active'
- category: 'windows'
- description: '... except for grips and splitters. Those remain always active and an option to bring the window to the front.'
- type: #Boolean>
- ^ WindowTitleActiveOnFirstClick ifNil: [ true ]!
Item was removed:
- ----- Method: SystemWindow class>>windowTitleActiveOnFirstClick: (in category 'preferences') -----
- windowTitleActiveOnFirstClick: boolean
- WindowTitleActiveOnFirstClick := boolean.
- self reconfigureWindowsForFocus.!
Item was removed:
- ----- Method: SystemWindow class>>windowsIn: (in category 'top window') -----
- windowsIn: aWorld
-
- ^ self windowsIn: aWorld satisfying: [:window | true].!
Item was removed:
- ----- Method: SystemWindow class>>windowsIn:satisfying: (in category 'top window') -----
- windowsIn: aWorld satisfying: windowBlock
- | windows |
-
- windows := OrderedCollection new.
- aWorld ifNil: [^windows]. "opening MVC in Morphic - WOW!!"
- aWorld submorphs do:
- [:m | | s |
- ((m isSystemWindow) and: [windowBlock value: m])
- ifTrue: [windows addLast: m]
- ifFalse: [((m isKindOf: TransformationMorph) and: [m submorphs size = 1])
- ifTrue: [s := m firstSubmorph.
- ((s isSystemWindow) and: [windowBlock value: s])
- ifTrue: [windows addLast: s]]]].
- ^ windows!
Item was removed:
- ----- Method: SystemWindow class>>windowsRaiseOnClick (in category 'preferences') -----
- windowsRaiseOnClick
- <preference: 'Windows Raise On Any Click'
- category: 'windows'
- description: 'If false, windows only raise when clicking on window decorations.'
- type: #Boolean>
- ^ WindowsRaiseOnClick ifNil: [ true ]!
Item was removed:
- ----- Method: SystemWindow class>>windowsRaiseOnClick: (in category 'preferences') -----
- windowsRaiseOnClick: boolean
- WindowsRaiseOnClick := boolean.!
Item was removed:
- ----- Method: SystemWindow>>activate (in category 'focus') -----
- activate
- "An active window delegate user input events as usual to its contents such as buttons or lists. There is a preference to ensure that all windows stay active regardless of being focused or not. Also take a look at #passivate, #lookFocused, and #beKeyWindow."
-
- self isActive ifTrue: [self lookFocused. ^ self].
- self topRendererOrSelf owner ifNil: [^ self "avoid spurious activate when drop in trash"].
-
- self isActive: true.
-
- "Special handling for expanded windows."
- self isCollapsed ifFalse: [
- model modelWakeUpIn: self.
- self positionSubmorphs].
-
- self submorphsDo: [:each | each unlock].
-
- self lookFocused.!
Item was removed:
- ----- Method: SystemWindow>>addCloseBox (in category 'initialization') -----
- addCloseBox
- "If I have a labelArea, add a close box to it"
-
- labelArea ifNil: [^ self].
- mustNotClose == true ifTrue: [^ self].
- closeBox ifNotNil: [closeBox delete].
- closeBox := self createCloseBox.
- closeBox layoutFrame: self class closeBoxFrame.
- labelArea addMorphFront: closeBox!
Item was removed:
- ----- Method: SystemWindow>>addCustomMenuItems:hand: (in category 'menu') -----
- addCustomMenuItems: aCustomMenu hand: aHandMorph
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- "template..."
- aCustomMenu addLine.
- aCustomMenu add: 'edit label...' translated action: #relabel.
- !
Item was removed:
- ----- Method: SystemWindow>>addExpandBox (in category 'initialization') -----
- addExpandBox
- "If I have a labelArea, add a close box to it"
-
- labelArea ifNil: [^ self].
- self class hideExpandButton ifTrue: [^ self].
- expandBox ifNotNil: [expandBox delete].
- expandBox := self createExpandBox.
- expandBox layoutFrame: self class expandBoxFrame.
- labelArea addMorphBack: expandBox!
Item was removed:
- ----- Method: SystemWindow>>addGrips (in category 'initialization') -----
- addGrips
- "Only when enabled via preference, also add edge grips."
-
- self removeGrips.
-
- self addCornerGrips.
- self class resizeAlongEdges ifTrue:[self addEdgeGrips].!
Item was removed:
- ----- Method: SystemWindow>>addKeyboardShortcuts (in category 'initialization') -----
- addKeyboardShortcuts
- "Install an event capture filter to add shortcuts for window control operations."
-
- self addKeyboardCaptureFilter: self.!
Item was removed:
- ----- Method: SystemWindow>>addLabel (in category 'label') -----
- addLabel
-
- (labelArea isNil or: [label isNil]) ifTrue: [^ self].
- labelArea
- addMorphBack: (Morph new extent: self class borderWidth @ 0);
- addMorphBack: label.
- label on: #startDrag send: #startDragFromLabel: to: self.
- self class clickOnLabelToEdit
- ifTrue: [label on: #mouseUp send: #relabel to: self].
- self class doubleClickOnLabelToExpand
- ifTrue: [label on: #doubleClick send: #expandBoxHit to: self].!
Item was removed:
- ----- Method: SystemWindow>>addLabelArea (in category 'initialization') -----
- addLabelArea
-
- labelArea ifNotNil: [labelArea abandon].
- labelArea := (AlignmentMorph newSpacer: Color transparent)
- vResizing: #spaceFill;
- layoutPolicy: ProportionalLayout new.
- self addMorph: labelArea.!
Item was removed:
- ----- Method: SystemWindow>>addMenuControl (in category 'initialization') -----
- addMenuControl
- "If I have a label area, add a menu control to it."
-
- labelArea ifNil: [^ self].
- "No menu if no label area"
- menuBox ifNotNil: [menuBox delete].
- menuBox := self createMenuBox.
- menuBox layoutFrame: self class menuBoxFrame.
- labelArea addMorphBack: menuBox!
Item was removed:
- ----- Method: SystemWindow>>addMorph:frame: (in category 'panes') -----
- addMorph: aMorph frame: relFrame
- | frame |
- frame := LayoutFrame new.
- frame
- leftFraction: relFrame left;
- rightFraction: relFrame right;
- topFraction: relFrame top;
- bottomFraction: relFrame bottom.
- self addMorph: aMorph fullFrame: frame.
-
- !
Item was removed:
- ----- Method: SystemWindow>>addMorph:fullFrame: (in category 'panes') -----
- addMorph: aMorph fullFrame: aLayoutFrame
- "Overwritten to maintain custom paneMorphs cache."
-
- self removeCellGapFromLayoutFrames.
-
- aMorph layoutFrame: aLayoutFrame.
- aMorph hResizing: #spaceFill; vResizing: #spaceFill.
- self addMorph: aMorph.
-
- paneMorphs := paneMorphs copyReplaceFrom: 1 to: 0 with: (Array with: aMorph).
- aMorph isImageMorph ifFalse: [aMorph adoptPaneColor: self paneColor].
-
- self addCellGapToLayoutFrames.
-
- self wantsPaneSplitters ifTrue: [
- "Splitters and grips share a preference. Tweak via #resizeAlongEges."
- self addPaneSplitters.
- self addGrips].!
Item was removed:
- ----- Method: SystemWindow>>allowReframeHandles (in category 'resize/collapse') -----
- allowReframeHandles
-
- ^ allowReframeHandles!
Item was removed:
- ----- Method: SystemWindow>>allowReframeHandles: (in category 'resize/collapse') -----
- allowReframeHandles: aBoolean
-
- allowReframeHandles := aBoolean!
Item was removed:
- ----- Method: SystemWindow>>amendSteppingStatus (in category 'stepping') -----
- amendSteppingStatus
- "Circumstances having changed, find out whether stepping is wanted and assure that the new policy is carried out"
-
- self wantsSteps
- ifTrue:
- [self arrangeToStartStepping]
- ifFalse:
- [self stopStepping]!
Item was removed:
- ----- Method: SystemWindow>>anyOpenWindowLikeMeIn: (in category 'open/close') -----
- anyOpenWindowLikeMeIn: aPasteUpMorph
-
- | requestor context |
- self class reuseWindows ifFalse: [ ^ Array empty ].
- context := thisContext sender.
- [ context notNil and: [ requestor isNil ] ]
- whileTrue: "Search for the requesting window to ignore it later."
- [ | receiver window |
- ((receiver := context receiver) ~~ self
- and: [ receiver isMorph
- and: [ (window := receiver firstOwnerSuchThat: [ : m | m isSystemWindow ]) ~~ self
- and: [ window notNil ] ] ])
- ifTrue: [ requestor := window ]
- ifFalse: [ context := context sender ] ].
- ^ self class
- windowsIn: aPasteUpMorph
- satisfying:
- [ : each |
- each ~~ requestor
- and: [ each model class = self model class
- and: [ (each model respondsTo: #representsSameBrowseeAs:)
- and: [ each model representsSameBrowseeAs: self model ] ] ] ]
- !
Item was removed:
- ----- Method: SystemWindow>>applyModelExtent (in category 'initialization') -----
- applyModelExtent
- self extent: model initialExtent !
Item was removed:
- ----- Method: SystemWindow>>applyUserInterfaceTheme (in category 'user interface') -----
- applyUserInterfaceTheme
-
- super applyUserInterfaceTheme.
-
- self
- setDefaultParameters;
- replaceBoxes;
- refreshWindowColor.
-
- self isLookingFocused
- ifTrue: [self lookUnfocused; lookFocused]
- ifFalse: [self lookFocused; lookUnfocused].
-
- self isCollapsed ifTrue: [self setProperty: #applyTheme toValue: true].!
Item was removed:
- ----- Method: SystemWindow>>areasRemainingToFill: (in category 'drawing') -----
- areasRemainingToFill: aRectangle
- | areas |
- (areas := super areasRemainingToFill: aRectangle) isEmpty
- ifTrue: [^ areas "good news -- complete occlusion"].
- "Check for special case that this is scrollbar damage"
- ((bounds topLeft - (14 at 0) corner: bounds bottomRight) containsRect: aRectangle) ifTrue:
- [paneMorphs do: [:p | ((p isKindOf: ScrollPane) and: [p scrollBarFills: aRectangle])
- ifTrue: [^ Array new]]].
- ^ areas!
Item was removed:
- ----- Method: SystemWindow>>assureLabelAreaVisible (in category 'layout') -----
- assureLabelAreaVisible
- "Label should be visible to interact with."
-
- (RealEstateAgent maximumUsableAreaInWorld: self world) in: [:rect |
- self innerBounds top < rect top ifTrue: [self top: rect top]].!
Item was removed:
- ----- Method: SystemWindow>>beKeyWindow (in category 'top window') -----
- beKeyWindow
- "Let me be the most important window on the screen. I am at the top and I can have a shadow to get more attention by the user. I am the window that is responsible for window keyboard shortcuts. Also see #isKeyWindow, #activate, and #lookFocused."
-
- | oldKeyWindow |
- self isKeyWindow ifTrue: [^ self].
-
- oldKeyWindow := TopWindow.
- TopWindow := self.
-
- self
- unlockWindowDecorations; "here, because all windows might be active anyway"
- activate; "if not already active, activate now"
- comeToFront. "key windows are on top"
-
- "Change appearance to get noticed."
- self hasDropShadow: Preferences menuAppearance3d.
- (self valueOfProperty: #borderWidthWhenActive)
- ifNotNil: [:bw | self acquireBorderWidth: bw].
-
- oldKeyWindow ifNotNil: [:wnd |
- wnd passivateIfNeeded.
-
- "Change appearance to not look prettier than the new key window."
- wnd hasDropShadow: false.
- (wnd valueOfProperty: #borderWidthWhenInactive)
- ifNotNil: [:bw | wnd acquireBorderWidth: bw]].
-
- self currentEvent isKeyboard ifTrue: [
- self currentHand newKeyboardFocus: self defaultFocusMorph].
-
- "Synchronize focus look with position of current hand because any call could have made this window the new key window."
- self updateFocusLookAtHand.!
Item was removed:
- ----- Method: SystemWindow>>beKeyWindowIfNeeded: (in category 'top window') -----
- beKeyWindowIfNeeded: evt
- "Make me the new key window if needed. Ensure that the focus look matches the keyboard focus."
-
- (self isKeyWindow not
- and: [self class windowsRaiseOnClick
- or: [self windowDecorations anySatisfy: [:morph | morph bounds containsPoint: evt position]] ])
- ifFalse: [
- "Just ensure the correct look after the event."
- self updateFocusLookForKeyboardFocus]
- ifTrue: [
- "We are the new key window at the front etc."
- self beKeyWindow.
- "There may have been a pop-up menu spawned. We do not want to occlude that."
- evt hand mouseFocus ifNotNil: [:morph |
- morph owner = self world ifTrue: [morph comeToFront]].
- evt hand balloonHelpList do: [:morph |
- morph comeToFront]]!
Item was removed:
- ----- Method: SystemWindow>>boxExtent (in category 'initialization') -----
- boxExtent
- "the label height is used to be proportional to the fonts preferences"
-
- ^ self class boxExtent
- max: label height @ label height !
Item was removed:
- ----- Method: SystemWindow>>buildWindowMenu (in category 'menu') -----
- buildWindowMenu
- | aMenu |
- aMenu := MenuMorph new defaultTarget: self.
- aMenu add: 'change title...' translated action: #relabel.
- aMenu addLine.
- aMenu add: 'send to back' translated action: #sendToBack.
- aMenu add: 'make next-to-topmost' translated action: #makeSecondTopmost.
- aMenu addLine.
- self mustNotClose
- ifFalse:
- [aMenu add: 'make unclosable' translated action: #makeUnclosable]
- ifTrue:
- [aMenu add: 'make closable' translated action: #makeClosable].
- aMenu
- add: (self isSticky ifTrue: ['make draggable'] ifFalse: ['make undraggable']) translated
- action: #toggleStickiness.
- aMenu addLine.
- self unexpandedFrame
- ifNil: [aMenu add: 'full screen' translated action: #expandBoxHit]
- ifNotNil: [aMenu add: 'original size' translated action: #expandBoxHit].
- self isCollapsed ifFalse: [aMenu add: 'window color...' translated action: #setWindowColor].
- ^aMenu!
Item was removed:
- ----- Method: SystemWindow>>changeCellGapOfLayoutFrames: (in category 'layout') -----
- changeCellGapOfLayoutFrames: delta
- "Overwritten to adapt labelArea (not part of #paneMorphs), which has topFraction = 0 but still grows upwards. Thus, we have to negate the given delta."
-
- labelArea ifNotNil: [labelArea layoutFrame ifNotNil: [:frame |
- frame topOffset: frame topOffset - delta]].
-
- super changeCellGapOfLayoutFrames: delta.!
Item was removed:
- ----- Method: SystemWindow>>changeColor (in category 'menu') -----
- changeColor
- "Change the color of the receiver -- triggered, e.g. from a menu. This variant allows the recolor triggered from the window's halo recolor handle to have the same result as choosing change-window-color from the window-title menu"
- NewColorPickerMorph useIt
- ifTrue:
- [ (NewColorPickerMorph
- on: self
- originalColor: self color
- setColorSelector: #setWindowColor:) openNear: self fullBoundsInWorld ]
- ifFalse:
- [ ColorPickerMorph new
- choseModalityFromPreference ;
- sourceHand: self activeHand ;
- target: self ;
- selector: #setWindowColor: ;
- originalColor: self color ;
-
- putUpFor: self
- near: self fullBoundsInWorld ]!
Item was removed:
- ----- Method: SystemWindow>>closeBoxHit (in category 'open/close') -----
- closeBoxHit
- "The user clicked on the close-box control in the window title. For Mac users only, the Mac convention of option-click-on-close-box is obeyed if the mac option key is down."
-
- Preferences dismissAllOnOptionClose ifTrue:
- [self currentEvent optionKeyPressed ifTrue:
- [^ self world closeUnchangedWindows]].
- self delete
- !
Item was removed:
- ----- Method: SystemWindow>>collapse (in category 'resize/collapse') -----
- collapse
- self isCollapsed ifFalse:[self collapseOrExpand]!
Item was removed:
- ----- Method: SystemWindow>>collapseOrExpand (in category 'resize/collapse') -----
- collapseOrExpand
- "Collapse or expand the window, depending on existing state"
- | cf |
- isCollapsed
- ifTrue:
- ["Expand -- restore panes to morphics structure"
- isCollapsed := false.
- self beKeyWindow. "Bring to frint first"
- Preferences collapseWindowsInPlace
- ifTrue:
- [fullFrame := fullFrame align: fullFrame topLeft with: self getBoundsWithFlex topLeft]
- ifFalse:
- [collapsedFrame := self getBoundsWithFlex].
- collapseBox ifNotNil: [collapseBox setBalloonText: 'collapse this window' translated].
- self setBoundsWithFlex: fullFrame.
- paneMorphs reverseDo:
- [:m | self addMorph: m unlock.
- self world startSteppingSubmorphsOf: m].
- self addPaneSplitters.
- self addGrips.
- (self hasProperty: #applyTheme) ifTrue: [
- self removeProperty: #applyTheme.
- self userInterfaceTheme applyTo: self allMorphs]]
- ifFalse:
- ["Collapse -- remove panes from morphics structure"
- isCollapsed := true.
- fullFrame := self getBoundsWithFlex.
- "First save latest fullFrame"
- paneMorphs do: [:m | m delete; releaseCachedState].
- self removePaneSplitters.
- self removeGrips.
- model modelSleep.
- cf := self getCollapsedFrame.
- (collapsedFrame isNil and: [Preferences collapseWindowsInPlace not]) ifTrue:
- [collapsedFrame := cf].
- self setBoundsWithFlex: cf.
- collapseBox ifNotNil: [collapseBox setBalloonText: 'expand this window' translated ].
- expandBox ifNotNil: [expandBox setBalloonText: 'expand this window' translated ].
- self sendToBack].
- self layoutChanged!
Item was removed:
- ----- Method: SystemWindow>>collapsedFrame (in category 'resize/collapse') -----
- collapsedFrame
- ^ collapsedFrame!
Item was removed:
- ----- Method: SystemWindow>>colorForInsets (in category 'drawing') -----
- colorForInsets
- ^self paneColor colorForInsets!
Item was removed:
- ----- Method: SystemWindow>>comeToFront (in category 'top window') -----
- comeToFront
-
- "Modal windows: Walk along the modal owner chain, the bring all to top."
- self modalOwner ifNotNil: [:mo | mo isSystemWindow ifTrue: [
- ^ mo modalOwner
- ifNil: [mo comeToFrontModally]
- ifNotNil: [:omo | omo comeToFront]]].
- self modalChild ifNotNil: [^ self comeToFrontModally].
-
- "Now show me."
- super comeToFront.
-
- "Label should be visible to interact with."
- self assureLabelAreaVisible.
-
- "Handle historic companions. May be removed in the future."
- self extantSketchEditor ifNotNil: [:sketchEditor |
- sketchEditor comeToFront.
- (self world findA: PaintBoxMorph) ifNotNil: [:pal | pal comeToFront]].!
Item was removed:
- ----- Method: SystemWindow>>comeToFrontModally (in category 'top window') -----
- comeToFrontModally
- "If I am modal, bring along my modal owning window and my model child as well."
-
- super comeToFront.
-
- "Bring up my modal children in front of me."
- self modalChild ifNotNil: [:wnd |
- wnd comeToFrontModally.
- wnd modalChild ifNil: [wnd flash]].!
Item was removed:
- ----- Method: SystemWindow>>contractToOriginalSize (in category 'resize/collapse') -----
- contractToOriginalSize
- self bounds: self unexpandedFrame.
- self unexpandedFrame: nil.
- expandBox ifNotNil: [expandBox setBalloonText: 'expand this window' translated].!
Item was removed:
- ----- Method: SystemWindow>>convertAlignment (in category 'layout') -----
- convertAlignment
- "Primarily Jesse Welton's code to convert old system windows to ones with modern layout scheme"
-
- self layoutPolicy: ProportionalLayout new.
- (paneMorphs isNil
- or: [paneRects isNil or: [paneMorphs size ~= paneRects size]])
- ifFalse:
- [self addLabelArea.
- self putLabelItemsInLabelArea.
- self setFramesForLabelArea.
- paneMorphs with: paneRects
- do:
- [:m :r |
- | frame |
- frame := LayoutFrame new.
- frame
- leftFraction: r left;
- rightFraction: r right;
- topFraction: r top;
- bottomFraction: r bottom.
- m layoutFrame: frame.
- m
- hResizing: #spaceFill;
- vResizing: #spaceFill]].
- labelArea isNil
- ifTrue:
- [self addLabelArea.
- self putLabelItemsInLabelArea.
- self setFramesForLabelArea.
- paneMorphs ifNotNil:
- [paneMorphs do:
- [:m |
- | frame |
- frame := m layoutFrame ifNil: [LayoutFrame new].
- frame topOffset: (frame topOffset) - self labelHeight.
- frame bottomFraction ~= 1.0
- ifTrue:
- [frame bottomOffset: (frame bottomOffset) - self labelHeight]]]].
- label ifNotNil:
- [| frame |
- frame := LayoutFrame new.
- frame
- leftFraction: 0.5;
- topFraction: 0;
- leftOffset: label width negated // 2.
- label layoutFrame: frame].
- collapseBox ifNotNil:
- [| frame |
- frame := LayoutFrame new.
- frame
- rightFraction: 1;
- topFraction: 0;
- rightOffset: -1;
- topOffset: 1.
- collapseBox layoutFrame: frame].
- stripes ifNotNil:
- [| frame |
- frame := LayoutFrame new.
- frame
- leftFraction: 0;
- topFraction: 0;
- rightFraction: 1;
- leftOffset: 1;
- topOffset: 1;
- rightOffset: -1.
- stripes first layoutFrame: frame.
- stripes first height: self labelHeight - 2.
- stripes first hResizing: #spaceFill.
- frame := LayoutFrame new.
- frame
- leftFraction: 0;
- topFraction: 0;
- rightFraction: 1;
- leftOffset: 3;
- topOffset: 3;
- rightOffset: -3.
- stripes last layoutFrame: frame.
- stripes last height: self labelHeight - 6.
- stripes last hResizing: #spaceFill].
- menuBox ifNotNil:
- [| frame |
- frame := LayoutFrame new.
- frame
- leftFraction: 0;
- leftOffset: 19;
- topFraction: 0;
- topOffset: 1.
- menuBox layoutFrame: frame].
- closeBox ifNotNil:
- [| frame |
- frame := LayoutFrame new.
- frame
- leftFraction: 0;
- leftOffset: 4;
- topFraction: 0;
- topOffset: 1.
- closeBox layoutFrame: frame]!
Item was removed:
- ----- Method: SystemWindow>>convertToCurrentVersion:refStream: (in category 'object fileIn') -----
- convertToCurrentVersion: varDict refStream: smartRefStrm
-
- allowReframeHandles ifNil: [allowReframeHandles := true].
- self layoutPolicy ifNil: [self convertAlignment].
- labelArea ifNil: [self convertAlignment].
- ^super convertToCurrentVersion: varDict refStream: smartRefStrm.
-
- !
Item was removed:
- ----- Method: SystemWindow>>createBox: (in category 'initialization') -----
- createBox: aForm
- "create a button with a form to be used in the label area"
-
- | box |
- box := SystemWindowButton new.
- box color: Color transparent;
- target: self;
- useSquareCorners;
- borderWidth: 0;
- labelGraphic: aForm scaleIconToDisplay;
- extent: self boxExtent.
- ^ box!
Item was removed:
- ----- Method: SystemWindow>>createCloseBox (in category 'initialization') -----
- createCloseBox
- ^ (self createBox: (self userInterfaceTheme closeBoxImage ifNil: [self class closeBoxImage]))
- actionSelector: #closeBoxHit;
- setBalloonText: 'close this window' translated!
Item was removed:
- ----- Method: SystemWindow>>createCollapseBox (in category 'initialization') -----
- createCollapseBox
- ^ (self createBox: (self userInterfaceTheme collapseBoxImage ifNil: [self class collapseBoxImage]))
- actionSelector: #collapseOrExpand;
- setBalloonText: 'collapse this window' translated.
- !
Item was removed:
- ----- Method: SystemWindow>>createExpandBox (in category 'initialization') -----
- createExpandBox
- ^ (self createBox: (self userInterfaceTheme expandBoxImage ifNil: [self class expandBoxImage]))
- actionSelector: #expandBoxHit;
- setBalloonText: 'expand this window' translated!
Item was removed:
- ----- Method: SystemWindow>>createMenuBox (in category 'initialization') -----
- createMenuBox
- ^ (self createBox: (self userInterfaceTheme menuBoxImage ifNil: [self class menuBoxImage]))
- actionSelector: #offerWindowMenu;
- setBalloonText: 'window menu' translated;
- actWhen: #buttonDown;
- yourself!
Item was removed:
- ----- Method: SystemWindow>>defaultBounds (in category 'initialization') -----
- defaultBounds
-
- ^ 0 at 0 corner: 300 at 200!
Item was removed:
- ----- Method: SystemWindow>>defaultColor (in category 'initialization') -----
- defaultColor
-
- ^ self userInterfaceTheme color ifNil: [Color veryVeryLightGray]!
Item was removed:
- ----- Method: SystemWindow>>defaultFocusMorph (in category 'focus') -----
- defaultFocusMorph
-
- | predicate |
- predicate := (self hasProperty: #defaultFocusMorph)
- ifFalse: [ [:morph | morph isLocked not and: [morph wantsKeyboardFocus]] ]
- ifTrue: [ | anObject |
- anObject := (self valueOfProperty: #defaultFocusMorph) value.
- anObject isMorph ifTrue: [^ anObject].
- [:morph | morph knownName = anObject] ].
-
- self
- allMorphsBreadthFirstDo: [:morph | (predicate value: morph) ifTrue: [^ morph]]
- sorted: #top ascending, #left ascending.
-
- ^ nil!
Item was removed:
- ----- Method: SystemWindow>>defaultFocusMorph: (in category 'focus') -----
- defaultFocusMorph: aMorphOrBlockOrNameOrNil
-
- self setProperty: #defaultFocusMorph toValue: aMorphOrBlockOrNameOrNil.!
Item was removed:
- ----- Method: SystemWindow>>delete (in category 'open/close') -----
- delete
- | thisWorld sketchEditor aPaintBox |
- self mustNotClose ifTrue: [^self].
- model okToClose ifFalse: [^self].
- thisWorld := self world.
- sketchEditor := self extantSketchEditor.
-
- self activeHand removeKeyboardListener: self.
-
- self isFlexed
- ifTrue: [owner delete]
- ifFalse: [super delete].
- model windowIsClosing; release.
- model := nil.
- sketchEditor ifNotNil:
- [sketchEditor deleteSelfAndSubordinates.
- (thisWorld notNil
- and: [(aPaintBox := thisWorld paintBoxOrNil) notNil]) ifTrue:
- [aPaintBox delete]].
-
- SystemWindow noteTopWindowIn: thisWorld!
Item was removed:
- ----- Method: SystemWindow>>deleteCloseBox (in category 'menu') -----
- deleteCloseBox
- closeBox ifNotNil:
- [closeBox delete.
- closeBox := nil]!
Item was removed:
- ----- Method: SystemWindow>>dimWindowButtons (in category 'top window') -----
- dimWindowButtons
- {closeBox. collapseBox. menuBox. expandBox}
- do: [:b | b ifNotNil: [b dim]]!
Item was removed:
- ----- Method: SystemWindow>>displayScaleChangedBy: (in category 'layout') -----
- displayScaleChangedBy: factor
- "Overwritten to also update the label area and reset the #cellGap (and #splitters)."
-
- super displayScaleChangedBy: factor.
-
- self cellGap: ProportionalSplitterMorph gripThickness.
- self layoutInset: ProportionalSplitterMorph gripThickness.
-
- self setFramesForLabelArea.
- "self replaceBoxes."!
Item was removed:
- ----- Method: SystemWindow>>doFastFrameDrag: (in category 'events') -----
- doFastFrameDrag: grabPoint
- "Do fast frame dragging from the given point"
-
- | offset newBounds outerWorldBounds clearArea |
- outerWorldBounds := self boundsIn: nil.
- offset := outerWorldBounds origin - grabPoint.
- clearArea := self currentWorld clearArea.
- newBounds := outerWorldBounds newRectFrom: [:f |
- | p selector |
- p := Sensor cursorPoint.
- (self class dragToEdges and: [(selector := self dragToEdgesSelectorFor: p in: clearArea) notNil])
- ifTrue: [clearArea perform: selector]
- ifFalse: [p + offset extent: outerWorldBounds extent]].
- self bounds: newBounds; comeToFront!
Item was removed:
- ----- Method: SystemWindow>>dragToEdgeDistance (in category 'resize/collapse') -----
- dragToEdgeDistance
- ^10!
Item was removed:
- ----- Method: SystemWindow>>dragToEdgesSelectorFor:in: (in category 'resize/collapse') -----
- dragToEdgesSelectorFor: p in: a
- "answer first matching drag resize selector, if none is found, answer nil"
- #(isPoint:nearTopLeftOf: isPoint:nearTopRightOf: isPoint:nearBottomLeftOf: isPoint:nearBottomRightOf: isPoint:nearTopOf: isPoint:nearBottomOf: isPoint:nearLeftOf: isPoint:nearRightOf:)
- with: #(topLeftQuadrant topRightQuadrant bottomLeftQuadrant bottomRightQuadrant topHalf bottomHalf leftHalf rightHalf)
- do: [:predicate :selector |
- (self perform: predicate with: p with: a) ifTrue: [^selector]].
- ^nil!
Item was removed:
- ----- Method: SystemWindow>>existingPaneColor (in category 'colors') -----
- existingPaneColor
- "Answer the existing pane color for the window, obtaining it from the first paneMorph if any, and fall back on using the second stripe color if necessary."
-
- | aColor |
- aColor := self valueOfProperty: #paneColor.
- aColor ifNil: [self setProperty: #paneColor toValue: (aColor := self paneColor)].
- ^aColor.!
Item was removed:
- ----- Method: SystemWindow>>expand (in category 'resize/collapse') -----
- expand
- self isCollapsed ifTrue:[self collapseOrExpand]!
Item was removed:
- ----- Method: SystemWindow>>expandBoxHit (in category 'resize/collapse') -----
- expandBoxHit
- isCollapsed
- ifTrue: [self hide;
- collapseOrExpand;
- expandToFullScreen;
- show]
- ifFalse: [self unexpandedFrame
- ifNil: [self expandToFullScreen]
- ifNotNil: [self contractToOriginalSize]]!
Item was removed:
- ----- Method: SystemWindow>>expandToFullScreen (in category 'resize/collapse') -----
- expandToFullScreen
- self unexpandedFrame ifNil: [ self unexpandedFrame: fullFrame ].
- self fullScreen.
- expandBox ifNotNil: [expandBox setBalloonText: 'contract to original size' translated]!
Item was removed:
- ----- Method: SystemWindow>>extantSketchEditor (in category 'top window') -----
- extantSketchEditor
- "If my world has an extant SketchEditorMorph associated with anything
- in this window, return that SketchEditor, else return nil"
- | w sketchEditor pasteUp |
- (w := self world) isNil ifTrue: [^ nil].
- (sketchEditor := w sketchEditorOrNil) isNil ifTrue: [^ nil].
- (pasteUp := sketchEditor enclosingPasteUpMorph) isNil ifTrue: [^ nil].
- self findDeepSubmorphThat: [:m | m = pasteUp]
- ifAbsent: [^ nil].
- ^ sketchEditor!
Item was removed:
- ----- Method: SystemWindow>>extent: (in category 'geometry') -----
- extent: aPoint
- "Set the receiver's extent to value provided. Respect my minimumExtent."
-
- | newExtent |
- newExtent := self isCollapsed
- ifTrue: [aPoint]
- ifFalse: [aPoint max: self minimumExtent].
- newExtent = self extent ifTrue: [^ self].
-
- isCollapsed
- ifTrue: [super extent: newExtent x @ (self labelHeight + (self layoutInset * 2))]
- ifFalse: [super extent: newExtent].
- isCollapsed
- ifTrue: [collapsedFrame := self bounds]
- ifFalse: [fullFrame := self bounds]!
Item was removed:
- ----- Method: SystemWindow>>fastFramingOn (in category 'resize/collapse') -----
- fastFramingOn
-
- ^ Preferences fastDragWindowForMorphic and: [self isFlexed not]!
Item was removed:
- ----- Method: SystemWindow>>filterEvent:for: (in category 'events') -----
- filterEvent: aKeyboardEvent for: anObject
- "Provide keyboard shortcuts."
-
- aKeyboardEvent isKeystroke
- ifFalse: [^ aKeyboardEvent].
-
- aKeyboardEvent hand halo ifNotNil: [ : halo | halo target isSystemWindow ifTrue: [ aKeyboardEvent hand removeHalo ] ].
-
- aKeyboardEvent commandKeyPressed ifTrue: [
- aKeyboardEvent keyCharacter caseOf: {
- [$\] -> [self class sendTopWindowToBack].
- [Character escape] -> [self class deleteTopWindow].
- [$/] -> [self class bringWindowUnderHandToFront].
- } otherwise: [^ aKeyboardEvent "no hit"].
- ^ aKeyboardEvent ignore "hit!!"].
-
- aKeyboardEvent controlKeyPressed ifTrue: [
- aKeyboardEvent keyCharacter caseOf: {
- [Character escape] -> [self world findWindow: aKeyboardEvent].
- } otherwise: [^ aKeyboardEvent "no hit"].
- ^ aKeyboardEvent ignore "hit!!"].
-
- ^ aKeyboardEvent "no hit"!
Item was removed:
- ----- Method: SystemWindow>>fullFrame (in category 'resize/collapse') -----
- fullFrame
- ^ fullFrame!
Item was removed:
- ----- Method: SystemWindow>>fullScreen (in category 'menu') -----
- fullScreen
- "Zoom Window to full owner size, allowing for scroll bars and desk margins"
-
- | left right possibleBounds |
- left := right := 0.
- self paneMorphs
- do: [:pane | ((pane isKindOf: ScrollPane)
- and: [pane retractableScrollBar])
- ifTrue: [pane scrollBarOnLeft
- ifTrue: [left := left max: pane scrollBarThickness]
- ifFalse: [right := right max: pane scrollBarThickness]]].
- possibleBounds := (RealEstateAgent maximumUsableAreaInWorld: self owner)
- insetBy: (left @ 0 corner: right @ 0).
- Preferences fullScreenLeavesDeskMargins
- ifTrue: [possibleBounds := possibleBounds insetBy: 22].
- self bounds: possibleBounds!
Item was removed:
- ----- Method: SystemWindow>>fullScreenMaximumExtent (in category 'menu') -----
- fullScreenMaximumExtent
- "Zoom Window to Full World size with possible DeskMargins
- obey the maximum extent rules"
-
- | left right possibleBounds |
- left := right := 0.
- self paneMorphs
- do: [:pane | ((pane isKindOf: ScrollPane)
- and: [pane retractableScrollBar])
- ifTrue: [pane scrollBarOnLeft
- ifTrue: [left := left max: pane scrollBarThickness]
- ifFalse: [right := right max: pane scrollBarThickness]]].
- possibleBounds := self worldBounds
- insetBy: (left @ 0 corner: right @ 0).
-
- self maximumExtent ifNotNil:
- [possibleBounds := possibleBounds origin extent: ( self maximumExtent min: ( possibleBounds extent ))].
- ((Flaps sharedFlapsAllowed
- and: [Project current flapsSuppressed not])
- or: [Preferences fullScreenLeavesDeskMargins])
- ifTrue: [possibleBounds := possibleBounds insetBy: 22].
- self bounds: possibleBounds!
Item was removed:
- ----- Method: SystemWindow>>getBoundsWithFlex (in category 'resize/collapse') -----
- getBoundsWithFlex
- "Return the lastest bounds rectangle with origin forced to global coordinates"
-
- self isFlexed
- ifTrue: [^ ((owner transform localPointToGlobal: bounds topLeft)
- extent: bounds extent)]
- ifFalse: [^ self bounds].
- !
Item was removed:
- ----- Method: SystemWindow>>getCollapsedFrame (in category 'resize/collapse') -----
- getCollapsedFrame
-
- | tmp |
- ^Preferences collapseWindowsInPlace
- ifTrue:
- [tmp := self getBoundsWithFlex.
- tmp origin corner: (tmp corner x @ 18)]
- ifFalse:
- [RealEstateAgent assignCollapseFrameFor: self]!
Item was removed:
- ----- Method: SystemWindow>>getRawLabel (in category 'label') -----
- getRawLabel
- | contentsFit |
- contentsFit := label duplicate fitContents.
- contentsFit extent: (label extent x min: contentsFit extent x) @ contentsFit extent y.
-
- ^ contentsFit
- !
Item was removed:
- ----- Method: SystemWindow>>gradientWithColor: (in category 'colors') -----
- gradientWithColor: aColor
-
- | gradient cc |
- cc := aColor adjustSaturation: -0.08 brightness: 0.4.
- gradient := GradientFillStyle ramp: {
- 0.0 -> (self isKeyWindow ifTrue: [cc muchLighter] ifFalse: [cc]).
- 0.25 -> (aColor mixed: 0.5 with: cc).
- 1.0 -> aColor.
- }.
- gradient origin: self topLeft.
- gradient direction: 0 @ self labelHeight.
- ^gradient!
Item was removed:
- ----- Method: SystemWindow>>handleListenEvent: (in category 'events') -----
- handleListenEvent: aUserInputEvent
- "See #mouseEnterDragging:. Watch for finished drag-and-drop action and lock contents accordingly."
-
- (aUserInputEvent isMouse and: [ aUserInputEvent hand hasSubmorphs not ]) ifTrue:
- [ self isKeyWindow ifFalse: [ self passivateIfNeeded ].
- aUserInputEvent hand removeMouseListener: self ].!
Item was removed:
- ----- Method: SystemWindow>>handleMouseDown: (in category 'events') -----
- handleMouseDown: evt
-
- self beKeyWindowIfNeeded: evt.
- ^ super handleMouseDown: evt!
Item was removed:
- ----- Method: SystemWindow>>handleMouseUp: (in category 'events') -----
- handleMouseUp: evt
- "Some widgets grab the keyboard focus only on mouse-up. Hence, we need to update our looks."
-
- self updateFocusLookForKeyboardFocus.
- ^ super handleMouseUp: evt!
Item was removed:
- ----- Method: SystemWindow>>handlesMouseDown: (in category 'events') -----
- handlesMouseDown: evt
-
- ^ true!
Item was removed:
- ----- Method: SystemWindow>>handlesMouseOver: (in category 'events') -----
- handlesMouseOver: anEvent
- ^ true!
Item was removed:
- ----- Method: SystemWindow>>handlesMouseOverDragging: (in category 'events') -----
- handlesMouseOverDragging: evt
- ^true!
Item was removed:
- ----- Method: SystemWindow>>holdsTranscript (in category 'panes') -----
- holdsTranscript
- "ugh"
- | plug |
- ^ paneMorphs size = 1 and: [((plug := paneMorphs first) isKindOf: PluggableTextMorph) and: [plug model isKindOf: TranscriptStream]]!
Item was removed:
- ----- Method: SystemWindow>>icon (in category 'thumbnail') -----
- icon
- "Answer a form with an icon to represent the receiver"
- ^ MenuIcons windowIcon!
Item was removed:
- ----- Method: SystemWindow>>initialExtent (in category 'open/close') -----
- initialExtent
- "Ask the model for it's initial extent."
-
- ^ model initialExtent!
Item was removed:
- ----- Method: SystemWindow>>initialize (in category 'initialization') -----
- initialize
- "Initialize a system window. Add label, stripes, etc., if desired"
-
- super initialize.
-
- allowReframeHandles := true.
- isCollapsed := false.
- paneMorphs := Array new.
- mustNotClose := false.
- updatablePanes := Array new.
-
- self layoutPolicy: ProportionalLayout new.
-
- self wantsPaneSplitters: true.
- self wantsGrips: true.
- self layoutInset: ProportionalSplitterMorph gripThickness.
- self cellGap: ProportionalSplitterMorph gripThickness.
-
- self initializeLabelArea.
- self addGrips.
- self setDefaultParameters.
-
- self initializeKeyboardShortcuts.!
Item was removed:
- ----- Method: SystemWindow>>initializeKeyboardShortcuts (in category 'initialization') -----
- initializeKeyboardShortcuts
- "Install an event capture filter to add shortcuts for window control operations."
-
- PasteUpMorph globalCommandKeysEnabled
- ifTrue: [self addKeyboardShortcuts].!
Item was removed:
- ----- Method: SystemWindow>>initializeLabelArea (in category 'initialization') -----
- initializeLabelArea
- "Initialize the label area (titlebar) for the window."
-
- labelString ifNil: [labelString := 'Untitled Window'].
- label := StringMorph new
- contents: labelString;
- font: (self userInterfaceTheme titleFont ifNil: [TextStyle defaultFont]);
- yourself.
- "Add collapse box so #labelHeight will work"
- collapseBox := self createCollapseBox.
- stripes := Array
- with: (RectangleMorph newBounds: bounds)
- with: (RectangleMorph newBounds: bounds).
- "see extent:"
- self addLabelArea.
- self setLabelWidgetAllowance.
- self addCloseBox.
- self class moveMenuButtonRight
- ifTrue: [self addLabel. self addMenuControl]
- ifFalse: [self addMenuControl. self addLabel].
- self addExpandBox.
- labelArea addMorphBack: collapseBox.
- self setFramesForLabelArea.
- Preferences noviceMode
- ifTrue: [closeBox
- ifNotNil: [closeBox setBalloonText: 'close window'].
- menuBox
- ifNotNil: [menuBox setBalloonText: 'window menu'].
- collapseBox
- ifNotNil: [collapseBox setBalloonText: 'collapse/expand window']].
- !
Item was removed:
- ----- Method: SystemWindow>>initializeWithLabel: (in category 'initialization') -----
- initializeWithLabel: aString
-
- labelString := aString.
- self initialize.!
Item was removed:
- ----- Method: SystemWindow>>isActive (in category 'focus') -----
- isActive
-
- ^ isActive ifNil: [false]!
Item was removed:
- ----- Method: SystemWindow>>isActive: (in category 'focus') -----
- isActive: aBoolean
-
- isActive := aBoolean.!
Item was removed:
- ----- Method: SystemWindow>>isCollapsed (in category 'resize/collapse') -----
- isCollapsed
- ^ isCollapsed!
Item was removed:
- ----- Method: SystemWindow>>isKeyWindow (in category 'top window') -----
- isKeyWindow
- "The key window is the window with the user's main attention. It usually has a shadow or other visual hints to separate it from other windows. Usually, the key window is at the top of the screen. On large screens, however, many windows may appear at the top. Also see #beKeyWindow, #activate, and #lookFocused."
-
- ^ self == self class keyWindow!
Item was removed:
- ----- Method: SystemWindow>>isLookingFocused (in category 'focus') -----
- isLookingFocused
-
- ^ isLookingFocused ifNil: [false]!
Item was removed:
- ----- Method: SystemWindow>>isLookingFocused: (in category 'focus') -----
- isLookingFocused: aBoolean
-
- isLookingFocused := aBoolean.!
Item was removed:
- ----- Method: SystemWindow>>isPoint:nearBottomLeftOf: (in category 'resize/collapse') -----
- isPoint: p nearBottomLeftOf: a
- ^(self isPoint: p nearBottomOf: a) and: [self isPoint: p nearLeftOf: a]!
Item was removed:
- ----- Method: SystemWindow>>isPoint:nearBottomOf: (in category 'resize/collapse') -----
- isPoint: p nearBottomOf: a
- ^p y > (a bottom - self dragToEdgeDistance)!
Item was removed:
- ----- Method: SystemWindow>>isPoint:nearBottomRightOf: (in category 'resize/collapse') -----
- isPoint: p nearBottomRightOf: a
- ^(self isPoint: p nearBottomOf: a) and: [self isPoint: p nearRightOf: a]!
Item was removed:
- ----- Method: SystemWindow>>isPoint:nearLeftOf: (in category 'resize/collapse') -----
- isPoint: p nearLeftOf: a
- ^p x < (a left + self dragToEdgeDistance)!
Item was removed:
- ----- Method: SystemWindow>>isPoint:nearRightOf: (in category 'resize/collapse') -----
- isPoint: p nearRightOf: a
- ^p x > (a right - self dragToEdgeDistance)!
Item was removed:
- ----- Method: SystemWindow>>isPoint:nearTopLeftOf: (in category 'resize/collapse') -----
- isPoint: p nearTopLeftOf: a
- ^(self isPoint: p nearTopOf: a) and: [self isPoint: p nearLeftOf: a]!
Item was removed:
- ----- Method: SystemWindow>>isPoint:nearTopOf: (in category 'resize/collapse') -----
- isPoint: p nearTopOf: a
- ^p y < (a top + self dragToEdgeDistance)!
Item was removed:
- ----- Method: SystemWindow>>isPoint:nearTopRightOf: (in category 'resize/collapse') -----
- isPoint: p nearTopRightOf: a
- ^(self isPoint: p nearTopOf: a) and: [self isPoint: p nearRightOf: a]!
Item was removed:
- ----- Method: SystemWindow>>isSystemWindow (in category 'testing') -----
- isSystemWindow
- "answer whatever the receiver is a SystemWindow"
- ^ true!
Item was removed:
- ----- Method: SystemWindow>>isWindowForModel: (in category 'testing') -----
- isWindowForModel: aModel
- "Return true if the receiver acts as the window for the given model"
- ^aModel == self model!
Item was removed:
- ----- Method: SystemWindow>>justDroppedInto:event: (in category 'geometry') -----
- justDroppedInto: aMorph event: anEvent
-
- isCollapsed
- ifTrue: [self position: ((self position max: 0 at 0) grid: 8 at 8).
- collapsedFrame := self bounds]
- ifFalse: [fullFrame := self bounds].
-
- self beKeyWindow.
- self hasDropShadow: Preferences menuAppearance3d. "See #startDragFromLabel:."
-
- aMorph == self world ifTrue: [self assureLabelAreaVisible].
-
- (Project uiManager openToolsAttachedToMouseCursor and: (self hasProperty: #initialDrop))
- ifTrue: [
- self removeProperty: #initialDrop.
- (self submorphs detect: [:m | m isKindOf: BottomRightGripMorph] ifNone: [])
- ifNotNil: [:grip |
- grip
- referencePoint: anEvent position - grip position;
- backupAndHideTargetDropShadows. "See MorphicToolBuilder >> #open:"
- self lookFocused.
- anEvent hand newMouseFocus: grip]].
-
- ^super justDroppedInto: aMorph event: anEvent!
Item was removed:
- ----- Method: SystemWindow>>knownName (in category 'label') -----
- knownName
-
- ^ self label!
Item was removed:
- ----- Method: SystemWindow>>label (in category 'label') -----
- label
- ^ labelString!
Item was removed:
- ----- Method: SystemWindow>>labelArea (in category 'label') -----
- labelArea
- ^ labelArea!
Item was removed:
- ----- Method: SystemWindow>>labelHeight (in category 'label') -----
- labelHeight
- "Answer the height for the window label. The standard behavior is at bottom; a hook is provided so that models can stipulate other heights, in support of various less-window-looking demos."
-
- | aHeight |
- (model notNil and: [model respondsTo: #desiredWindowLabelHeightIn:]) ifTrue:
- [(aHeight := model desiredWindowLabelHeightIn: self) ifNotNil: [^ aHeight]].
-
- ^ label ifNil: [0] ifNotNil:
- [(label height + self cellInset + self cellGap) max:
- (collapseBox ifNotNil: [collapseBox height] ifNil: [10])]!
Item was removed:
- ----- Method: SystemWindow>>labelRect (in category 'geometry') -----
- labelRect
- ^ self innerBounds withHeight: self labelHeight.
- !
Item was removed:
- ----- Method: SystemWindow>>labelWidgetAllowance (in category 'label') -----
- labelWidgetAllowance
- ^ labelWidgetAllowance ifNil: [self setLabelWidgetAllowance]!
Item was removed:
- ----- Method: SystemWindow>>layoutBounds (in category 'layout') -----
- layoutBounds
- "Bounds of pane area only."
- | box |
-
- box := super layoutBounds.
- ^box withTop: box top + self labelHeight!
Item was removed:
- ----- Method: SystemWindow>>lockWindowDecorations (in category 'focus') -----
- lockWindowDecorations
- "Lock all window decrations, that is grips, splitters, and title bar."
-
- self windowDecorations do: [:m | m lock].!
Item was removed:
- ----- Method: SystemWindow>>lockWindowTitle (in category 'focus') -----
- lockWindowTitle
-
- labelArea ifNotNil: [:m | m lock].!
Item was removed:
- ----- Method: SystemWindow>>lookFocused (in category 'focus') -----
- lookFocused
- "Some elements of windows change visually depending on the user input focus. This is property is orthogonal to being active or passive. Active windows can either look focused or unfocused. Passive windows will always look unfocused. Also see #lookUnfocused, #activate, #passivate, and #beKeyWindow."
-
- self isLookingFocused ifTrue: [^ self].
- self isLookingFocused: true.
-
- label ifNotNil: [ label color: (self userInterfaceTheme focusedLabelColor ifNil: [Color black]) ].
-
- (self isKeyWindow or: [self class windowTitleActiveOnFirstClick])
- ifTrue: [self undimWindowButtons].
-
- self paneColorToUse in: [ : col |
- self
- setStripeColorsFrom: col ;
- adoptPaneColor: col].!
Item was removed:
- ----- Method: SystemWindow>>lookUnfocused (in category 'focus') -----
- lookUnfocused
- "See #lookFocused, #activate, and #passivate."
-
- self isLookingFocused ifFalse: [^ self].
- self isLookingFocused: false.
-
- label ifNotNil: [ label color: (self userInterfaceTheme unfocusedLabelColor ifNil: [Color darkGray]) ].
- self dimWindowButtons.
- self paneColorToUseWhenNotActive in: [ : col |
- self
- setStripeColorsFrom: col ;
- adoptPaneColor: col ]!
Item was removed:
- ----- Method: SystemWindow>>makeClosable (in category 'menu') -----
- makeClosable
- mustNotClose := false.
- closeBox ifNil: [self addCloseBox]!
Item was removed:
- ----- Method: SystemWindow>>makeMeVisible (in category 'drawing') -----
- makeMeVisible
-
- self world extent > (0 at 0) ifFalse: [^ self].
-
- ((self world bounds insetBy: (0 at 0 corner: self labelHeight asPoint))
- containsPoint: self position) ifTrue: [^ self "OK -- at least my top left is visible"].
-
- "window not on screen (probably due to reframe) -- move it now"
- self isCollapsed
- ifTrue: [self position: (RealEstateAgent assignCollapsePointFor: self)]
- ifFalse: [self position: (RealEstateAgent initialFrameFor: self initialExtent: self extent world: self world) topLeft].
-
- !
Item was removed:
- ----- Method: SystemWindow>>makeSecondTopmost (in category 'menu') -----
- makeSecondTopmost
-
- | aWorld nextWindow |
- aWorld := self world.
- nextWindow := aWorld submorphs
- detect: [:m | (m isSystemWindow) and: [m ~~ self]]
- ifNone: [^self].
-
- self comeToFront.
- nextWindow beKeyWindow.!
Item was removed:
- ----- Method: SystemWindow>>makeUnclosable (in category 'menu') -----
- makeUnclosable
- mustNotClose := true.
- self deleteCloseBox!
Item was removed:
- ----- Method: SystemWindow>>maximumExtent (in category 'initialization') -----
- maximumExtent
- "This returns the maximum extent that the morph may be expanded to.
- Return nil if this property has not been set."
-
- ^ self valueOfProperty: #maximumExtent!
Item was removed:
- ----- Method: SystemWindow>>maximumExtent: (in category 'initialization') -----
- maximumExtent: aPoint
- "This returns the maximum extent that the morph may be expanded to.
- Return nil if this property has not been set."
-
- ^ self setProperty: #maximumExtent toValue: aPoint!
Item was removed:
- ----- Method: SystemWindow>>modalChild (in category 'polymorph') -----
- modalChild
- "Answer the modal child of the receiver, if any."
-
- ^self valueOfProperty: #modalChild!
Item was removed:
- ----- Method: SystemWindow>>modalLockTo: (in category 'polymorph') -----
- modalLockTo: aSystemWindow
- "Lock the receiver as a modal owner of the given window."
-
- aSystemWindow
- setProperty: #modalOwner toValue: self.
- self setProperty: #modalChild toValue: aSystemWindow!
Item was removed:
- ----- Method: SystemWindow>>modalOwner (in category 'polymorph') -----
- modalOwner
- "Answer the modal owner of the receiver, if any."
-
- ^self valueOfProperty: #modalOwner!
Item was removed:
- ----- Method: SystemWindow>>modalUnlockFrom: (in category 'polymorph') -----
- modalUnlockFrom: aSystemWindow
- "Unlock the receiver as a modal owner of the given window."
-
- aSystemWindow removeProperty: #modalOwner.
- self removeProperty: #modalChild.
- self beKeyWindow.!
Item was removed:
- ----- Method: SystemWindow>>model: (in category 'initialization') -----
- model: anObject
- super model: anObject.
- self paneColor: nil.!
Item was removed:
- ----- Method: SystemWindow>>mouseDown: (in category 'events') -----
- mouseDown: evt
-
- evt hand
- waitForClicksOrDrag: self
- event: evt
- selectors: { nil. nil. nil. #startDragFromLabel: }
- threshold: HandMorph dragThreshold.!
Item was removed:
- ----- Method: SystemWindow>>mouseEnter: (in category 'events') -----
- mouseEnter: anEvent
- "Handle a mouseEnter event, meaning the mouse just entered my bounds with no button pressed. The default response is to let my eventHandler, if any, handle it."
- super mouseEnter: anEvent.
-
- (self isActive and: [Preferences mouseOverForKeyboardFocus])
- ifTrue: [self lookFocused].!
Item was removed:
- ----- Method: SystemWindow>>mouseEnterDragging: (in category 'events') -----
- mouseEnterDragging: evt
- "unlock children for drop operations"
-
- self flag: #performance. "mt: There may be no need to change appearance if no widget wants the drop. As a trade-off, we avoid expensive visual updates if the user drags a system window and window-embedding in nested world morphs is not allowed."
- (evt hand hasSubmorphs
- and: [evt hand firstSubmorph isSystemWindow]
- and: [Preferences systemWindowEmbedOK not])
- ifTrue: [^ self].
-
- self isActive ifTrue: [self lookFocused].
-
- (self isActive not and: [evt hand hasSubmorphs]) ifTrue: [
- self activate. "unlock contents for drop"
- evt hand addMouseListener: self. "for drop completion on submorph"
- ].!
Item was removed:
- ----- Method: SystemWindow>>mouseLeave: (in category 'events') -----
- mouseLeave: anEvent
- "Handle a mouseEnter event, meaning the mouse just entered my bounds with no button pressed. The default response is to let my eventHandler, if any, handle it."
- super mouseLeave: anEvent.
-
- (model windowActiveOnFirstClick and: [Preferences mouseOverForKeyboardFocus
- or: [anEvent hand keyboardFocus notNil and: [anEvent hand keyboardFocus containingWindow ~= self]]])
- ifTrue: [self lookUnfocused].!
Item was removed:
- ----- Method: SystemWindow>>mouseLeaveDragging: (in category 'events') -----
- mouseLeaveDragging: evt
- "Passivate after drop operations if needed. Unfortunately, we get a leave-dragging event for the system window we want to drag. Watch out for it."
-
- ((model windowActiveOnFirstClick and: [(evt hand submorphs includes: self) not])
- or: [self isKeyWindow not])
- ifTrue: [self lookUnfocused].
-
- (self isKeyWindow not and: [evt hand hasSubmorphs]) ifTrue:[
- self passivateIfNeeded.
- evt hand removeMouseListener: self. "no more drop completion possible on submorph"
- ].!
Item was removed:
- ----- Method: SystemWindow>>mouseLeaveEvent:fromPane: (in category 'resize/collapse') -----
- mouseLeaveEvent: event fromPane: pane
- "For backward compatibility only. Not used by any newly created window"
- (pane isKindOf: ScrollPane) ifTrue: [pane mouseLeave: event].
- !
Item was removed:
- ----- Method: SystemWindow>>mustNotClose (in category 'open/close') -----
- mustNotClose
- ^ mustNotClose == true!
Item was removed:
- ----- Method: SystemWindow>>offerWindowMenu (in category 'menu') -----
- offerWindowMenu
- | aMenu |
- aMenu := self buildWindowMenu.
- model ifNotNil:
- [model addModelItemsToWindowMenu: aMenu].
- aMenu popUpEvent: self currentEvent in: self world!
Item was removed:
- ----- Method: SystemWindow>>openAsIs (in category 'open/close') -----
- openAsIs
- ^self openAsIsIn: self currentWorld
- !
Item was removed:
- ----- Method: SystemWindow>>openAsIsIn: (in category 'open/close') -----
- openAsIsIn: aWorld
- "This msg and its callees result in the window being activeOnlyOnTop"
- aWorld addMorph: self.
- self beKeyWindow.
- aWorld startSteppingSubmorphsOf: self.!
Item was removed:
- ----- Method: SystemWindow>>openInWorld: (in category 'open/close') -----
- openInWorld: aWorld
- "This msg and its callees result in the window being activeOnlyOnTop"
- ^ (self anyOpenWindowLikeMeIn: aWorld)
- ifEmpty:
- [ self
- bounds: (RealEstateAgent initialFrameFor: self world: aWorld) ;
- openAsIsIn: aWorld ]
- ifNotEmptyDo:
- [ : windows |
- windows anyOne
- expand ;
- beKeyWindow ;
- postAcceptBrowseFor: self ].!
Item was removed:
- ----- Method: SystemWindow>>openInWorld:extent: (in category 'open/close') -----
- openInWorld: aWorld extent: extent
- "This msg and its callees result in the window being activeOnlyOnTop"
- ^ (self anyOpenWindowLikeMeIn: aWorld)
- ifEmpty:
- [ self
- position: (RealEstateAgent initialFrameFor: self initialExtent: extent world: aWorld) topLeft ;
- extent: extent.
- self openAsIsIn: aWorld ]
- ifNotEmptyDo:
- [ : windows |
- windows anyOne
- expand ;
- beKeyWindow ;
- postAcceptBrowseFor: self ].!
Item was removed:
- ----- Method: SystemWindow>>openInWorldExtent: (in category 'open/close') -----
- openInWorldExtent: extent
- "This msg and its callees result in the window being activeOnlyOnTop"
- ^ self openInWorld: self currentWorld extent: extent!
Item was removed:
- ----- Method: SystemWindow>>paneColor (in category 'colors') -----
- paneColor
- | cc |
- (cc := self valueOfProperty: #paneColor) ifNotNil: [^cc].
- (model respondsTo: #windowColorToUse) ifTrue: [cc := model windowColorToUse].
- cc ifNil: [cc := paneMorphs isEmptyOrNil ifFalse: [paneMorphs first color]].
- cc ifNil: [cc := self defaultColor].
- self paneColor: cc.
- ^cc!
Item was removed:
- ----- Method: SystemWindow>>paneColor: (in category 'colors') -----
- paneColor: aColor
- self setProperty: #paneColor toValue: aColor.
-
- self adoptPaneColor: aColor.!
Item was removed:
- ----- Method: SystemWindow>>paneColorToUse (in category 'colors') -----
- paneColorToUse
- ^ Display depth <= 2
- ifTrue:
- [Color white]
- ifFalse:
- [self paneColor]!
Item was removed:
- ----- Method: SystemWindow>>paneColorToUseWhenNotActive (in category 'colors') -----
- paneColorToUseWhenNotActive
-
- ^ (self userInterfaceTheme unfocusedWindowColorModifier ifNil: [ [:color | color darker] ])
- value: self paneColorToUse!
Item was removed:
- ----- Method: SystemWindow>>paneMorphSatisfying: (in category 'panes') -----
- paneMorphSatisfying: aBlock
-
- ^paneMorphs detect: aBlock ifNone: [ nil ]!
Item was removed:
- ----- Method: SystemWindow>>paneMorphs (in category 'geometry') -----
- paneMorphs
- "Nominally private but a need for obtaining this from the outside arose"
- ^ paneMorphs!
Item was removed:
- ----- Method: SystemWindow>>paneTransition: (in category 'events') -----
- paneTransition: event
- "Mouse has entered or left a pane"!
Item was removed:
- ----- Method: SystemWindow>>paneWithLongestSide:near: (in category 'resize/collapse') -----
- paneWithLongestSide: sideBlock near: aPoint
- | thePane theSide theLen |
- theLen := 0.
- paneMorphs do:
- [:pane | | box |
- box := pane bounds.
- box forPoint: aPoint closestSideDistLen:
- [:side :dist :len |
- (dist <= 5 and: [len > theLen]) ifTrue:
- [thePane := pane.
- theSide := side.
- theLen := len]]].
- sideBlock value: theSide.
- ^ thePane!
Item was removed:
- ----- Method: SystemWindow>>panelRect (in category 'geometry') -----
- panelRect
- "Answer the area below the title bar which is devoted to panes."
-
- ^ self innerBounds insetBy: (0 @ self labelHeight corner: 0 @ 0)!
Item was removed:
- ----- Method: SystemWindow>>passivate (in category 'focus') -----
- passivate
- "A passive window's contents do not handle user input events until being activated, for example, by a single extra mouse click. There is a preference to configure whether windows can be passive at all. Also see #activate and #lookUnfocused."
-
- self isActive ifFalse: [^ self].
- self isActive: false.
-
- self isCollapsed ifFalse: [model modelSleep].
-
- self submorphsDo: [:each | each lock].
-
- self activeHand keyboardFocus ifNotNil: [:morph |
- morph containingWindow == self
- ifTrue: [self activeHand releaseKeyboardFocus]].
-
- self lookUnfocused.!
Item was removed:
- ----- Method: SystemWindow>>passivateIfNeeded (in category 'focus') -----
- passivateIfNeeded
-
- model windowActiveOnFirstClick
- ifFalse: [self passivate]
- ifTrue: [self lookUnfocused].
-
- self unlockWindowDecorations.
-
- self class windowTitleActiveOnFirstClick
- ifFalse: [self lockWindowTitle]
- ifTrue: [self unlockWindowTitle].!
Item was removed:
- ----- Method: SystemWindow>>position: (in category 'geometry') -----
- position: newPos
- super position: newPos.
- isCollapsed
- ifTrue: [collapsedFrame := self bounds]
- ifFalse: [fullFrame := self bounds].
- !
Item was removed:
- ----- Method: SystemWindow>>postAcceptBrowseFor: (in category 'open/close') -----
- postAcceptBrowseFor: anotherSystemWindow
- "If I am taking over browsing for anotherSystemWindow, sucblasses may override to, for example, position me to the object to be focused on."
- self model postAcceptBrowseFor: anotherSystemWindow model!
Item was removed:
- ----- Method: SystemWindow>>putLabelItemsInLabelArea (in category 'layout') -----
- putLabelItemsInLabelArea
- "Put label items into the label area, if there is one"
-
- labelArea ifNotNil:
- [stripes ifNotNil: [stripes do: [:stripe | labelArea addMorph: stripe]].
- closeBox ifNotNil: [labelArea addMorph: closeBox].
- menuBox ifNotNil: [labelArea addMorph: menuBox].
- collapseBox ifNotNil: [labelArea addMorph: collapseBox].
- label ifNotNil: [labelArea addMorph: label]]
-
- !
Item was removed:
- ----- Method: SystemWindow>>raisedColor (in category 'colors') -----
- raisedColor
- ^self paneColor raisedColor!
Item was removed:
- ----- Method: SystemWindow>>reframePanesAdjoining:along:to: (in category 'resize/collapse') -----
- reframePanesAdjoining: growingPane along: side to: aDisplayBox
- | delta newRect minDim theMin horiz |
- growingPane ifNil: [^ self]. "As from click outside"
- newRect := aDisplayBox.
- horiz := #(left right) includes: side.
- theMin := horiz ifTrue: [40] ifFalse: [20].
-
- "First check that this won't make any pane smaller than theMin screen dots"
- minDim := (((paneMorphs select: [:pane | pane bounds bordersOn: growingPane bounds along: side])
- collect: [:pane | pane bounds adjustTo: newRect along: side]) copyWith: aDisplayBox)
- inject: 999 into:
- [:was :rect | was min: (horiz ifTrue: [rect width] ifFalse: [rect height])].
- "If so, amend newRect as required"
- minDim > theMin ifFalse:
- [delta := minDim - theMin.
- newRect := newRect withSide: side setTo:
- ((newRect perform: side) > (growingPane bounds perform: side)
- ifTrue: [(newRect perform: side) + delta]
- ifFalse: [(newRect perform: side) - delta])].
-
- "Now adjust all adjoining panes for real"
- paneMorphs do:
- [:pane | (pane bounds bordersOn: growingPane bounds along: side) ifTrue:
- [pane bounds: (pane bounds adjustTo: newRect along: side)]].
- "And adjust the growing pane itself"
- growingPane bounds: newRect.
-
- "Finally force a recomposition of the whole window"
- self setPaneRectsFromBounds.
- self extent: self extent!
Item was removed:
- ----- Method: SystemWindow>>refreshWindowColor (in category 'colors') -----
- refreshWindowColor
- "For changing the underlying model's default window color"
- self setProperty: #paneColor toValue: nil.
- self setWindowColor: self paneColor.
-
- self isLookingFocused
- ifTrue: [self lookUnfocused; lookFocused]
- ifFalse: [self lookFocused; lookUnfocused].!
Item was removed:
- ----- Method: SystemWindow>>relabel (in category 'label') -----
- relabel
-
- (Project uiManager
- request: 'New title for this window' translated
- initialAnswer: labelString)
- ifNotEmpty: [:newLabel | self setLabel: newLabel].!
Item was removed:
- ----- Method: SystemWindow>>relabelEvent: (in category 'label') -----
- relabelEvent: evt
- "No longer used, but may be referred to by old eventHandlers"
-
- ^ Preferences clickOnLabelToEdit
- ifFalse: [self mouseDown: evt]
- ifTrue: [self relabel]!
Item was removed:
- ----- Method: SystemWindow>>rememberedKeyboardFocus (in category 'polymorph') -----
- rememberedKeyboardFocus
- "Answer the remembered keyboard focus for the receiver."
-
- ^self valueOfProperty: #rememberedFocus!
Item was removed:
- ----- Method: SystemWindow>>removeKeyboardShortcuts (in category 'initialization') -----
- removeKeyboardShortcuts
-
- self removeKeyboardCaptureFilter: self.!
Item was removed:
- ----- Method: SystemWindow>>removeMenuBox (in category 'geometry') -----
- removeMenuBox
- menuBox ifNotNil:
- [menuBox delete.
- menuBox := nil].
- !
Item was removed:
- ----- Method: SystemWindow>>replaceBoxes (in category 'initialization') -----
- replaceBoxes
- "Rebuild the various boxes."
- self setLabelWidgetAllowance.
- label ifNotNil: [label delete].
- labelArea ifNotNil: [labelArea delete].
- self initializeLabelArea.
- self setFramesForLabelArea.
- self setWindowColor: self paneColor.
- self isActive
- ifTrue: [self passivate; activate]
- ifFalse: [self activate; passivate].!
Item was removed:
- ----- Method: SystemWindow>>replacePane:with: (in category 'panes') -----
- replacePane: oldPane with: newPane
- "Make newPane exactly occupy the position and extent of oldPane"
-
- | aLayoutFrame hadDep |
- hadDep := model dependents includes: oldPane.
- oldPane owner replaceSubmorph: oldPane by: newPane.
- newPane
- position: oldPane position;
- extent: oldPane extent.
- aLayoutFrame := oldPane layoutFrame.
- paneMorphs := paneMorphs collect:
- [:each |
- each == oldPane ifTrue: [newPane] ifFalse: [each]].
- aLayoutFrame ifNotNil: [newPane layoutFrame: aLayoutFrame].
- hadDep ifTrue: [model removeDependent: oldPane. model addDependent: newPane].
-
- self changed
-
- !
Item was removed:
- ----- Method: SystemWindow>>restoreDefaultPaneColor (in category 'colors') -----
- restoreDefaultPaneColor
- "Useful when changing from monochrome to color display"
-
- self setStripeColorsFrom: self paneColor.!
Item was removed:
- ----- Method: SystemWindow>>secondaryPaneTransition:divider: (in category 'events') -----
- secondaryPaneTransition: event divider: aMorph
- "Mouse has entered or left a pane"!
Item was removed:
- ----- Method: SystemWindow>>sendToBack (in category 'menu') -----
- sendToBack
- | aWorld nextWindow |
- aWorld := self world.
- nextWindow := aWorld submorphs
- detect: [:m | (m isSystemWindow) and: [m ~~ self]]
- ifNone: [^self].
- nextWindow beKeyWindow.
- aWorld addMorphNearBack: self!
Item was removed:
- ----- Method: SystemWindow>>setBoundsWithFlex: (in category 'resize/collapse') -----
- setBoundsWithFlex: newFrame
- "Set bounds from newFrame with origin preserved from global coordinates"
-
- self isFlexed
- ifTrue: [super bounds: ((owner transform globalPointToLocal: newFrame topLeft)
- extent: newFrame extent)]
- ifFalse: [super bounds: newFrame].!
Item was removed:
- ----- Method: SystemWindow>>setDefaultParameters (in category 'initialization') -----
- setDefaultParameters
-
- Preferences menuAppearance3d
- ifFalse: [self hasDropShadow: false]
- ifTrue: [
- self addDropShadow.
- self hasDropShadow: self isKeyWindow. "maybe turn off again"].
-
- self borderWidth: ((self userInterfaceTheme borderWidth ifNil: [1]) * RealEstateAgent scaleFactor) truncated.
- label font: (self userInterfaceTheme titleFont ifNil: [TextStyle defaultFont]).!
Item was removed:
- ----- Method: SystemWindow>>setFramesForLabelArea (in category 'initialization') -----
- setFramesForLabelArea
- "an aid to converting old instances, but then I found
- convertAlignment (jesse welton's note)"
- | frame |
- labelArea ifNil: [^ self].
- labelArea
- layoutPolicy: TableLayout new;
- listDirection: #leftToRight;
- hResizing: #spaceFill;
- layoutInset: 0.
- label hResizing: #spaceFill.
- {closeBox. menuBox. expandBox. collapseBox} do: [:box |
- box ifNotNil: [box extent: self boxExtent]].
- frame := LayoutFrame new.
- frame leftFraction: 0;
- topFraction: 0;
- rightFraction: 1;
- bottomFraction: 0;
- topOffset: self labelHeight negated.
- labelArea layoutFrame: frame!
Item was removed:
- ----- Method: SystemWindow>>setLabel: (in category 'label') -----
- setLabel: aString
- | frame |
- (model windowReqNewLabel: aString) ifFalse: [^ self].
- labelString := aString.
- label ifNil: [^ self].
- label contents: (aString ifNil: ['']).
- self labelWidgetAllowance. "Sets it if not already"
- self isCollapsed
- ifTrue: [self extent: (label width + labelWidgetAllowance) @ (self labelHeight + 2)]
- ifFalse: [label fitContents; setWidth: (label width min: self width - labelWidgetAllowance).
- label align: label bounds topCenter with: self topCenter + (0 at self borderWidth).
- collapsedFrame ifNotNil:
- [collapsedFrame := collapsedFrame withWidth: label width + labelWidgetAllowance]].
- frame := LayoutFrame new.
- frame leftFraction: 0.5;
- topFraction: 0.5;
- leftOffset: label width negated // 2;
- topOffset: label height negated // 2.
- label layoutFrame: frame.
- !
Item was removed:
- ----- Method: SystemWindow>>setLabelWidgetAllowance (in category 'label') -----
- setLabelWidgetAllowance
- ^ labelWidgetAllowance := (self boxExtent x * 4) + 19!
Item was removed:
- ----- Method: SystemWindow>>setPaneRectsFromBounds (in category 'geometry') -----
- setPaneRectsFromBounds
- "Reset proportional specs from actual bounds, eg, after reframing panes"
- | layoutBounds |
- layoutBounds := self layoutBounds.
- paneMorphs do:[:m| | box left bottom top frame right |
- frame := m layoutFrame.
- box := m bounds.
- frame ifNotNil:[
- left := box left - layoutBounds left - frame leftOffset.
- right := box right - layoutBounds left - frame rightOffset.
- top := box top - layoutBounds top - frame topOffset.
- bottom := box bottom - layoutBounds top - frame bottomOffset.
- frame leftFraction: (left / layoutBounds width asFloat).
- frame rightFraction: (right / layoutBounds width asFloat).
- frame topFraction: (top / layoutBounds height asFloat).
- frame bottomFraction: (bottom / layoutBounds height asFloat).
- ].
- ].!
Item was removed:
- ----- Method: SystemWindow>>setStripeColorsFrom: (in category 'colors') -----
- setStripeColorsFrom: paneColor
- "Set the stripe color based on the given paneColor"
-
- labelArea ifNotNil: [labelArea color: Color transparent].
- self updateBoxesColor: paneColor.
- stripes ifNil: [^self].
-
- self borderColor: ((self userInterfaceTheme borderColorModifier ifNil: [ [:c | c adjustBrightness: -0.3] ])
- value: paneColor).
-
- self class gradientWindow
- ifTrue: [self fillStyle: (self gradientWithColor: paneColor)]
- ifFalse: [self color: paneColor].!
Item was removed:
- ----- Method: SystemWindow>>setUpdatablePanesFrom: (in category 'panes') -----
- setUpdatablePanesFrom: getSelectors
- | aList possibles |
- "Set my updatablePanes inst var to the list of panes which are list panes with the given get-list selectors. Order is important here!! Note that the method is robust in the face of panes not found, but a warning is printed in the transcript in each such case"
-
- aList := OrderedCollection new.
- possibles := OrderedCollection new.
- self allMorphsDo: [ :pane |
- (pane isKindOf: PluggableListMorph) ifTrue: [
- possibles add: pane.
- ].
- ].
-
- getSelectors do: [:sel | | aPane |
- aPane := possibles detect: [ :pane | pane getListSelector == sel] ifNone: [nil].
- aPane
- ifNotNil:
- [aList add: aPane]
- ifNil:
- [Transcript cr; show: 'Warning: pane ', sel, ' not found.']].
- updatablePanes := aList asArray!
Item was removed:
- ----- Method: SystemWindow>>setWindowColor (in category 'menu') -----
- setWindowColor
- "Allow the user to select a new basic color for the window"
- NewColorPickerMorph useIt
- ifTrue:
- [ (NewColorPickerMorph
- on: self
- originalColor: self paneColorToUse
- setColorSelector: #setWindowColor:) openNear: self fullBounds ]
- ifFalse:
- [ ColorPickerMorph new
- choseModalityFromPreference ;
- sourceHand: self activeHand ;
- target: self ;
- selector: #setWindowColor: ;
- originalColor: self paneColorToUse ;
-
- putUpFor: self
- near: self fullBounds ]!
Item was removed:
- ----- Method: SystemWindow>>setWindowColor: (in category 'colors') -----
- setWindowColor: incomingColor
- | existingColor aColor |
- incomingColor ifNil: [^ self]. "it happens"
- aColor := incomingColor.
- (aColor = ColorPickerMorph perniciousBorderColor
- or: [aColor = Color black]) ifTrue: [^ self].
- existingColor := self paneColorToUse.
- existingColor ifNil: [^ Beeper beep].
- self paneColor: aColor.
- self setStripeColorsFrom: aColor.
- self changed.!
Item was removed:
- ----- Method: SystemWindow>>shouldDropOnMouseUp (in category 'testing') -----
- shouldDropOnMouseUp
- "Return true for consistency with fastdrag"
- ^true!
Item was removed:
- ----- Method: SystemWindow>>startDragFromLabel: (in category 'events') -----
- startDragFromLabel: evt
- "When label events are active, we need to pass dragging to the window explicitely
- The window only recognizes a drag with an offset of more than 3 pixels"
-
- self isSticky ifTrue: [^ self].
- self fastFramingOn
- ifTrue: [self doFastFrameDrag: evt cursorPoint]
- ifFalse: [
- self hasDropShadow: false.
- evt hand grabMorph: self topRendererOrSelf]
- !
Item was removed:
- ----- Method: SystemWindow>>stepAt: (in category 'stepping') -----
- stepAt: millisecondClockValue
- "If the receiver is not collapsed, step it, after first stepping the model."
-
- (isCollapsed not or: [self wantsStepsWhenCollapsed]) ifTrue:
- [model ifNotNil: [model stepAt: millisecondClockValue in: self].
- super stepAt: millisecondClockValue "let player, if any, step"]
-
- "Since this method ends up calling step, the model-stepping logic should not be duplicated there."!
Item was removed:
- ----- Method: SystemWindow>>stepTime (in category 'stepping') -----
- stepTime
- ^ model
- ifNotNil:
- [model stepTimeIn: self]
- ifNil:
- [200] "milliseconds"!
Item was removed:
- ----- Method: SystemWindow>>takeOutOfWindow (in category 'menu') -----
- takeOutOfWindow
- "Take the receiver's pane morph out the window and place it, naked, where once the window was"
- | aMorph |
- paneMorphs size = 1 ifFalse: [^ Beeper beep].
- aMorph := paneMorphs first.
- owner addMorphFront: aMorph.
- self delete!
Item was removed:
- ----- Method: SystemWindow>>titleAndPaneText (in category 'panes') -----
- titleAndPaneText
- "If the receiver represents a workspace, return an Association between the title and that text, else return nil"
- (paneMorphs size ~= 1 or: [(paneMorphs first isKindOf: PluggableTextMorph) not])
- ifTrue: [^ nil].
- ^ labelString -> paneMorphs first text
-
- !
Item was removed:
- ----- Method: SystemWindow>>tryToRenameTo: (in category 'label') -----
- tryToRenameTo: newLabel
- "Triggered eg by typing a new name in the halo"
-
- newLabel ifNotEmpty: [self setLabel: newLabel].
- !
Item was removed:
- ----- Method: SystemWindow>>undimWindowButtons (in category 'top window') -----
- undimWindowButtons
- {closeBox. collapseBox. menuBox. expandBox}
- do: [:b | b ifNotNil: [b undim]]!
Item was removed:
- ----- Method: SystemWindow>>unexpandedFrame (in category 'resize/collapse') -----
- unexpandedFrame
- "Return the frame size of an unexpanded window"
-
- ^ self valueOfProperty: #unexpandedFrame!
Item was removed:
- ----- Method: SystemWindow>>unexpandedFrame: (in category 'resize/collapse') -----
- unexpandedFrame: aRectangle
- "Set the frame size of an unexpanded window"
-
- ^ self setProperty: #unexpandedFrame toValue: aRectangle!
Item was removed:
- ----- Method: SystemWindow>>unlockWindowDecorations (in category 'focus') -----
- unlockWindowDecorations
- "Unlock all window decrations, that is grips, splitters, and title bar."
-
- self windowDecorations do: [:m | m unlock].
-
- "Migrate old window instances. Can be removed in the future."
- labelArea ifNotNil: [:m | m submorphsDo: [:sm | sm unlock]].!
Item was removed:
- ----- Method: SystemWindow>>unlockWindowTitle (in category 'focus') -----
- unlockWindowTitle
-
- labelArea ifNotNil: [:m | m unlock].!
Item was removed:
- ----- Method: SystemWindow>>updatablePanes (in category 'panes') -----
- updatablePanes
- "Answer the list of panes, in order, which should be sent the #verifyContents message"
- ^ updatablePanes ifNil: [updatablePanes := #()]!
Item was removed:
- ----- Method: SystemWindow>>update: (in category 'label') -----
- update: aSymbol
- aSymbol = #relabel
- ifTrue: [^ model ifNotNil: [ self setLabel: model labelString ] ].
- aSymbol = #close
- ifTrue: [self delete]!
Item was removed:
- ----- Method: SystemWindow>>updateBox:color: (in category 'panes') -----
- updateBox: anIconMorph color: aColor
-
- | fill |
- anIconMorph isNil
- ifTrue: [^ self].
- anIconMorph
- extent: self boxExtent;
- useRoundedCorners.
-
- SystemWindow gradientWindow
- ifFalse: [anIconMorph color: aColor]
- ifTrue: [
- fill := GradientFillStyle ramp: {
- 0.0 -> aColor muchLighter muchLighter.
- 1.0 -> aColor twiceDarker}.
- fill origin: anIconMorph topLeft + (5 @ 5).
- fill direction: anIconMorph extent.
- anIconMorph fillStyle: fill].
-
- anIconMorph
- borderWidth: (Preferences alternativeWindowBoxesLook
- ifTrue: [1]
- ifFalse: [0]);
- borderColor: aColor darker.!
Item was removed:
- ----- Method: SystemWindow>>updateBoxesColor: (in category 'panes') -----
- updateBoxesColor: aColor
- | opaqueColor |
- aColor isNil
- ifTrue: [^ self].
- Preferences alternativeWindowBoxesLook ifFalse:[^ self].
-
- opaqueColor := aColor asNontranslucentColor.
-
- self
- updateBox: closeBox
- color: (opaqueColor alphaMixed: 0.5 with: Color red).
- self updateBox: menuBox color: opaqueColor.
- self updateBox: expandBox color: opaqueColor.
- self updateBox: collapseBox color: opaqueColor!
Item was removed:
- ----- Method: SystemWindow>>updateFocusLookAtHand (in category 'focus') -----
- updateFocusLookAtHand
- "If there is more than one active window, look for the mouse cursor and update the window focus look accordingly. This method is not on the class-side because we need our world and some active hand."
-
- (model windowActiveOnFirstClick and: [Preferences mouseOverForKeyboardFocus])
- ifFalse: [self updateFocusLookForKeyboardFocus]
- ifTrue: [
- ((self class windowsIn: self world)
- do: [:window | window lookUnfocused];
- select: [:window | window bounds containsPoint: self activeHand position])
- ifNotEmpty: [:windowsPointed | windowsPointed first lookFocused "only to foremost window"]].!
Item was removed:
- ----- Method: SystemWindow>>updateFocusLookForKeyboardFocus (in category 'focus') -----
- updateFocusLookForKeyboardFocus
- "Ensure that the window holding the current keyboard focus looks focused. Note that the focus window is not necessarily the receiver of this message."
-
- | f w |
- (((f := self activeHand keyboardFocus) notNil and: [(w := f containingWindow) notNil])
- and: [w isActive])
- ifTrue: [
- (self class windowsIn: self world) do: [:window |
- w ~~ window ifTrue: [window lookUnfocused]].
- w lookFocused]!
Item was removed:
- ----- Method: SystemWindow>>updatePaneColors (in category 'colors') -----
- updatePaneColors
- "Useful when changing from monochrome to color display"
-
- self setStripeColorsFrom: self paneColorToUse.!
Item was removed:
- ----- Method: SystemWindow>>updatePanesFromSubmorphs (in category 'top window') -----
- updatePanesFromSubmorphs
- "Having removed some submorphs, make sure this is reflected in my paneMorphs."
- paneMorphs := paneMorphs select: [ :pane | submorphs includes: pane ].!
Item was removed:
- ----- Method: SystemWindow>>wantsExpandBox (in category 'resize/collapse') -----
- wantsExpandBox
- "Answer whether I'd like an expand box"
-
- ^ Preferences alwaysHideExpandButton not!
Item was removed:
- ----- Method: SystemWindow>>wantsHalo (in category 'events') -----
- wantsHalo
- ^ false!
Item was removed:
- ----- Method: SystemWindow>>wantsRoundedCorners (in category 'drawing') -----
- wantsRoundedCorners
-
- ^ (self hasProperty: #cornerStyle)
- ifTrue: [super wantsRoundedCorners]
- ifFalse: [self class roundedWindowCorners]!
Item was removed:
- ----- Method: SystemWindow>>wantsSteps (in category 'stepping') -----
- wantsSteps
- "Return true if the model wants its view to be stepped. For an open system window, we give the model to offer an opinion"
-
- self isPartsDonor ifTrue: [^ false].
- self player wantsSteps ifTrue: [^ true].
- ^ isCollapsed not and: [model wantsStepsIn: self]!
Item was removed:
- ----- Method: SystemWindow>>wantsStepsWhenCollapsed (in category 'stepping') -----
- wantsStepsWhenCollapsed
- "Default is not to bother updating collapsed windows"
-
- ^ false!
Item was removed:
- ----- Method: SystemWindow>>wantsToBeCachedByHand (in category 'testing') -----
- wantsToBeCachedByHand
- "Return true if the receiver wants to be cached by the hand when it is dragged around."
- self hasTranslucentColor ifTrue:[^false].
- self bounds = self fullBounds ifTrue:[^true].
- self submorphsDo:[:m|
- (self bounds containsRect: m fullBounds) ifFalse:[
- m wantsToBeCachedByHand ifFalse:[^false].
- ].
- ].
- ^true!
Item was removed:
- ----- Method: SystemWindow>>wantsToBeDroppedInto: (in category 'events') -----
- wantsToBeDroppedInto: aMorph
- "Return true if it's okay to drop the receiver into aMorph"
- ^ (aMorph isWorldMorph or:[Preferences systemWindowEmbedOK])
- and: [aMorph isDockingBar not]!
Item was removed:
- ----- Method: SystemWindow>>wantsYellowButtonMenu (in category 'menu') -----
- wantsYellowButtonMenu
- "Answer true if the receiver wants a yellow button menu"
- ^ false!
Item was removed:
- ----- Method: SystemWindow>>widthOfFullLabelText (in category 'label') -----
- widthOfFullLabelText
- ^Preferences windowTitleFont widthOfString: labelString!
Item was removed:
- ----- Method: SystemWindow>>windowDecorations (in category 'focus') -----
- windowDecorations
-
- ^ self submorphs copyWithoutAll: self paneMorphs!
Item was removed:
- IconicButton subclass: #SystemWindowButton
- instanceVariableNames: 'dimmed dimmedForm highlightedForm'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
Item was removed:
- ----- Method: SystemWindowButton>>dim (in category 'visual properties') -----
- dim
- dimmed := true.
- self restoreImage.!
Item was removed:
- ----- Method: SystemWindowButton>>dimmedForm (in category 'visual properties') -----
- dimmedForm
- ^ dimmedForm ifNil: [ dimmedForm := self firstSubmorph baseGraphic dimmed ]!
Item was removed:
- ----- Method: SystemWindowButton>>handlesMouseOver: (in category 'visual properties') -----
- handlesMouseOver: evt
-
- ^ true
- !
Item was removed:
- ----- Method: SystemWindowButton>>highlight (in category 'visual properties') -----
- highlight
-
- self firstSubmorph form: self highlightedForm
- !
Item was removed:
- ----- Method: SystemWindowButton>>highlightedForm (in category 'visual properties') -----
- highlightedForm
- ^ highlightedForm ifNil: [ highlightedForm := self firstSubmorph baseGraphic lighter ]!
Item was removed:
- ----- Method: SystemWindowButton>>lock (in category 'accessing') -----
- lock
- self firstSubmorph form: self dimmedForm.
- super lock!
Item was removed:
- ----- Method: SystemWindowButton>>mouseEnter: (in category 'visual properties') -----
- mouseEnter: evt
-
- self highlight.
- !
Item was removed:
- ----- Method: SystemWindowButton>>mouseLeave: (in category 'visual properties') -----
- mouseLeave: evt
-
- self restoreImage.
- !
Item was removed:
- ----- Method: SystemWindowButton>>restoreImage (in category 'visual properties') -----
- restoreImage
- dimmed == true
- ifTrue: [self firstSubmorph form: self dimmedForm]
- ifFalse: [super restoreImage]
- !
Item was removed:
- ----- Method: SystemWindowButton>>undim (in category 'visual properties') -----
- undim
- dimmed := false..
- self isLocked ifFalse: [self restoreImage].!
Item was removed:
- ----- Method: SystemWindowButton>>unlock (in category 'accessing') -----
- unlock
- self restoreImage.
- super unlock!
Item was removed:
- ----- Method: SystemWindowButton>>updateVisualState: (in category 'visual properties') -----
- updateVisualState: evt
-
- (self containsPoint: evt cursorPoint)
- ifTrue: [self darken]
- ifFalse: [self restoreImage].
- !
Item was removed:
- SystemWindow subclass: #SystemWindowWithButton
- instanceVariableNames: 'buttonInTitle'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
-
- !SystemWindowWithButton commentStamp: '<historical>' prior: 0!
- A SystemWindow with a single extra button in its title bar.!
Item was removed:
- ----- Method: SystemWindowWithButton class>>hideExpandButton (in category 'preferences') -----
- hideExpandButton
-
- ^ true!
Item was removed:
- ----- Method: SystemWindowWithButton>>adjustExtraButton (in category 'geometry') -----
- adjustExtraButton
- | leftMargin |
- buttonInTitle ifNil: [^ self].
- leftMargin := self boxExtent x + 3.
- self class moveMenuButtonRight ifTrue: [leftMargin := leftMargin * 2].
- buttonInTitle align: buttonInTitle topRight with: self innerBounds topRight - (leftMargin at 0)!
Item was removed:
- ----- Method: SystemWindowWithButton>>buttonInTitle: (in category 'label') -----
- buttonInTitle: aButton
- buttonInTitle := aButton.
- self addMorphFront: aButton!
Item was removed:
- ----- Method: SystemWindowWithButton>>extent: (in category 'geometry') -----
- extent: newExtent
- super extent: (newExtent max: 120 @ 50).
- self adjustExtraButton!
Item was removed:
- ----- Method: SystemWindowWithButton>>setLabelWidgetAllowance (in category 'label') -----
- setLabelWidgetAllowance
- ^ labelWidgetAllowance := 115!
Item was removed:
- ----- Method: SystemWindowWithButton>>wantsExpandBox (in category 'resize/collapse') -----
- wantsExpandBox
- "Answer whether I'd like an expand box"
-
- ^ false!
Item was removed:
- ----- Method: TTFontDescription>>asMorph (in category '*Morphic-TrueType') -----
- asMorph
-
- ^ self asHandle font
- browseAllGlyphs;
- browseAllGlyphsByCategory;
- browseAllSymbols;
- yourself.
-
- "^TTSampleFontMorph font: self"!
Item was removed:
- BorderedMorph subclass: #TTSampleFontMorph
- instanceVariableNames: 'font transform smoothing'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-TrueType'!
-
- !TTSampleFontMorph commentStamp: '<historical>' prior: 0!
- An example for using TrueType fonts.!
Item was removed:
- ----- Method: TTSampleFontMorph class>>font: (in category 'instance creation') -----
- font: aTTFontDescription
- ^self new font: aTTFontDescription!
Item was removed:
- ----- Method: TTSampleFontMorph class>>fontWithoutString: (in category 'connectors') -----
- fontWithoutString: aTTFontDescription
- ^self new fontWithoutString: aTTFontDescription!
Item was removed:
- ----- Method: TTSampleFontMorph>>addCustomMenuItems:hand: (in category 'menus') -----
- addCustomMenuItems: aCustomMenu hand: aHandMorph
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- aCustomMenu addUpdating: #getSmoothingLevel action: #nextSmoothingLevel.!
Item was removed:
- ----- Method: TTSampleFontMorph>>addOptionalHandlesTo:box: (in category 'halos and balloon help') -----
- addOptionalHandlesTo: aHalo box: box
- aHalo addHandleAt: box center color: Color magenta icon: nil on: #mouseDown send: #createSample to: self.!
Item was removed:
- ----- Method: TTSampleFontMorph>>areasRemainingToFill: (in category 'drawing') -----
- areasRemainingToFill: aRectangle
- ^ Array with: aRectangle!
Item was removed:
- ----- Method: TTSampleFontMorph>>balloonHelpTextForHandle: (in category 'halos and balloon help') -----
- balloonHelpTextForHandle: aHandle
- aHandle eventHandler firstMouseSelector == #createSample
- ifTrue:[^'Create a sample string'].
- ^super balloonHelpTextForHandle: aHandle!
Item was removed:
- ----- Method: TTSampleFontMorph>>canDrawBorder: (in category 'testing') -----
- canDrawBorder: aBorderStyle
- ^aBorderStyle style == #simple!
Item was removed:
- ----- Method: TTSampleFontMorph>>changed (in category 'updating') -----
- changed
- self invalidRect: (self fullBounds expandBy: 1)!
Item was removed:
- ----- Method: TTSampleFontMorph>>computeTransform (in category 'private') -----
- computeTransform
- | fullExtent scale |
- fullExtent := font bounds extent * 16.
- scale := self extent asFloatPoint / fullExtent asFloatPoint.
- transform := MatrixTransform2x3 withScale: scale.
- transform := transform composedWithGlobal: (MatrixTransform2x3 withOffset: self position).
- ^transform!
Item was removed:
- ----- Method: TTSampleFontMorph>>createSample (in category 'menu') -----
- createSample
- self world primaryHand attachMorph: (TTSampleStringMorph font: font)!
Item was removed:
- ----- Method: TTSampleFontMorph>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- "answer the default border width for the receiver"
- ^ 1!
Item was removed:
- ----- Method: TTSampleFontMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color black!
Item was removed:
- ----- Method: TTSampleFontMorph>>drawCharactersOn: (in category 'drawing') -----
- drawCharactersOn: aCanvas
- | glyph origin r offset cy m |
- 0 to: 255 do: [:i |
- glyph := font at: i.
- origin := font bounds extent * ((i \\ 16) @ (i // 16)).
- r := origin extent: font bounds extent.
- offset := r center - glyph bounds center.
- cy := glyph bounds center y.
- m := MatrixTransform2x3 withOffset: 0 at cy.
- m := m composedWithLocal: (MatrixTransform2x3 withScale: 1 @ -1).
- m := m composedWithLocal: (MatrixTransform2x3 withOffset: 0 @ cy negated).
- m := m composedWithGlobal: (MatrixTransform2x3 withOffset: offset).
- aCanvas asBalloonCanvas preserveStateDuring: [:balloonCanvas |
- balloonCanvas transformBy: m.
- balloonCanvas drawGeneralBezierShape: glyph contours
- color: color
- borderWidth: 0
- borderColor: Color black.
- ].
- ].!
Item was removed:
- ----- Method: TTSampleFontMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- | origin extent offset |
- (font isNil)
- ifTrue:[^aCanvas frameRectangle: self bounds color: Color black].
- origin := self position asIntegerPoint.
- extent := self extent asIntegerPoint.
- 0 to: 16 do:[:i|
- offset := (extent x * i // 16) @ (extent y * i // 16).
- aCanvas line: origin x @ (origin y + offset y)
- to: (origin x + extent x) @ (origin y + offset y)
- width: self borderWidth color: self borderColor.
- aCanvas line: (origin x + offset x) @ origin y
- to: (origin x + offset x) @ (origin y + extent y)
- width: self borderWidth color: self borderColor.
- ].
- aCanvas asBalloonCanvas preserveStateDuring:[:balloonCanvas|
- balloonCanvas transformBy: self transform.
- balloonCanvas aaLevel: self smoothing.
- self drawCharactersOn: balloonCanvas.
- ].!
Item was removed:
- ----- Method: TTSampleFontMorph>>extent: (in category 'geometry') -----
- extent: extentPoint
- super extent: extentPoint.
- transform := nil.!
Item was removed:
- ----- Method: TTSampleFontMorph>>font (in category 'accessing') -----
- font
- ^ font!
Item was removed:
- ----- Method: TTSampleFontMorph>>font: (in category 'accessing') -----
- font: aTTFontDescription
- | morph |
- font := aTTFontDescription.
- morph := (TTSampleStringMorph font: font).
- morph extent: morph extent * 2.
- morph color: Color magenta.
- self addMorphCentered: morph.
- morph position: morph position x @ (self bounds bottom + 10).
- self privateFullMoveBy: self fullBounds origin negated.!
Item was removed:
- ----- Method: TTSampleFontMorph>>fontWithoutString: (in category 'connectors') -----
- fontWithoutString: aTTFontDescription
- font := aTTFontDescription.
- !
Item was removed:
- ----- Method: TTSampleFontMorph>>getSmoothingLevel (in category 'menu') -----
- getSmoothingLevel
- "Menu support"
- smoothing = 1
- ifTrue: [^ 'turn on smoothing' translated].
- smoothing = 2
- ifTrue: [^ 'more smoothing' translated].
- smoothing = 4
- ifTrue: [^ 'turn off smoothing' translated]!
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>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- smoothing := 4.
- self extent: 300 @ 300!
Item was removed:
- ----- Method: TTSampleFontMorph>>newTransformationMorph (in category 'rotate scale and flex') -----
- newTransformationMorph
- ^MatrixTransformMorph new!
Item was removed:
- ----- Method: TTSampleFontMorph>>nextSmoothingLevel (in category 'menu') -----
- nextSmoothingLevel
- smoothing = 1
- ifTrue: [smoothing := 2]
- ifFalse: [smoothing = 2
- ifTrue: [smoothing := 4]
- ifFalse: [smoothing = 4
- ifTrue: [smoothing := 1]]].
- self changed!
Item was removed:
- ----- Method: TTSampleFontMorph>>open (in category 'initialize') -----
- open
- ^self openInWorld!
Item was removed:
- ----- Method: TTSampleFontMorph>>openInWorld (in category 'initialization') -----
- openInWorld
- HandMorph attach: self!
Item was removed:
- ----- Method: TTSampleFontMorph>>position: (in category 'geometry') -----
- position: pos
- super position: pos.
- transform := nil.!
Item was removed:
- ----- Method: TTSampleFontMorph>>printOn: (in category 'connectors') -----
- printOn: aStream
- aStream nextPutAll: 'TTSampleFont(';
- nextPutAll: font familyName;
- nextPut: $)!
Item was removed:
- ----- Method: TTSampleFontMorph>>privateMoveBy: (in category 'private') -----
- privateMoveBy: delta
- super privateMoveBy: delta.
- transform := nil.!
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: TTSampleFontMorph>>smoothing (in category 'accessing') -----
- smoothing
- ^ smoothing!
Item was removed:
- ----- Method: TTSampleFontMorph>>smoothing: (in category 'accessing') -----
- smoothing: aNumber
- smoothing := aNumber.
- self changed!
Item was removed:
- ----- Method: TTSampleFontMorph>>transform (in category 'accessing') -----
- transform
- ^transform ifNil:[self computeTransform].!
Item was removed:
- ----- Method: TTSampleFontMorph>>veryDeepFixupWith: (in category 'copying') -----
- veryDeepFixupWith: deepCopier
- "If fields were weakly copied, fix them here. If they were in the
- tree being copied, fix them up, otherwise point to the originals!!!!"
-
- super veryDeepFixupWith: deepCopier.
- font := deepCopier references at: font ifAbsent: [font]!
Item was removed:
- ----- Method: TTSampleFontMorph>>veryDeepInner: (in category 'copying') -----
- veryDeepInner: deepCopier
- "Copy all of my instance variables. Some need to be not copied at all,
- but shared. Warning!!!! Every instance variable defined in this class
- must be handled. We must also implement veryDeepFixupWith:.
- See DeepCopier class comment."
-
- super veryDeepInner: deepCopier.
- "font := font"
- transform := transform veryDeepCopyWith: deepCopier.
- smoothing := smoothing veryDeepCopyWith: deepCopier!
Item was removed:
- TTSampleFontMorph subclass: #TTSampleStringMorph
- instanceVariableNames: 'string ttBounds'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-TrueType'!
-
- !TTSampleStringMorph commentStamp: '<historical>' prior: 0!
- I allow the display of a string in a TrueType font as a stand-alone morph.
-
- Morph's color changes the inside of the characters.
- Morph's borderColor changes the outline.
-
- Many free fonts are stored at www.FontGuy.com.
- Use a normal web browser (not our Scamper) and go there.
- Choose 'categories' and browse to a font you like.
- Hold the mouse down on the example text in that font.
- When the menu comes up, choose "Copy this link location".
- Come back into Squeak, choose "load font from web..."
- from my menu, and paste in the url.!
Item was removed:
- ----- Method: TTSampleStringMorph class>>descriptionForPartsBin (in category 'parts bin') -----
- descriptionForPartsBin
- ^ self partName: 'TrueType banner' translatedNoop
- categories: #()
- documentation: 'A short text in a beautiful font. Use the resize handle to change size.' translatedNoop!
Item was removed:
- ----- Method: TTSampleStringMorph>>addCustomMenuItems:hand: (in category 'menus') -----
- addCustomMenuItems: aCustomMenu hand: aHandMorph
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- aCustomMenu add: 'edit contents...' translated action: #edit.
- aCustomMenu add: 'how to find more fonts...' translated action: #howTo.
- aCustomMenu add: 'load font from web...' translated action: #loadFromURL.!
Item was removed:
- ----- Method: TTSampleStringMorph>>addOptionalHandlesTo:box: (in category 'halos and balloon help') -----
- addOptionalHandlesTo: aHalo box: box!
Item was removed:
- ----- Method: TTSampleStringMorph>>computeTransform (in category 'private') -----
- computeTransform
- | cy |
- cy := bounds origin y + bounds corner y * 0.5.
- transform := MatrixTransform2x3
- transformFromLocal: (ttBounds insetBy: self borderWidth negated)
- toGlobal: bounds.
- transform := transform composedWithGlobal:(MatrixTransform2x3 withOffset: 0 @ cy negated).
- transform := transform composedWithGlobal:(MatrixTransform2x3 withScale: 1.0 @ -1.0).
- transform := transform composedWithGlobal:(MatrixTransform2x3 withOffset: 0 @ cy).
- ^transform!
Item was removed:
- ----- Method: TTSampleStringMorph>>containsPoint: (in category 'geometry testing') -----
- containsPoint: aPoint
- "^ super containsPoint: aPoint"
-
- "so much faster..."
-
- | picker |
- (self bounds containsPoint: aPoint) ifFalse: [^false].
- picker := BalloonCanvas on: (Form extent: 1 @ 1 depth: 32).
- picker transformBy: (MatrixTransform2x3 withOffset: aPoint negated).
- self drawOn: picker.
- ^(picker form bits first) ~= 0!
Item was removed:
- ----- Method: TTSampleStringMorph>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- "answer the default border width for the receiver"
- ^ 0!
Item was removed:
- ----- Method: TTSampleStringMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ {Color magenta. Color yellow. Color orange. Color lightGray} atRandom!
Item was removed:
- ----- Method: TTSampleStringMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- | xStart |
- (font isNil or:[string isNil or:[string isEmpty]])
- ifTrue:[^aCanvas frameRectangle: self bounds color: Color black].
- xStart := 0.
- aCanvas asBalloonCanvas preserveStateDuring:[:balloonCanvas|
- balloonCanvas transformBy: self transform.
- balloonCanvas aaLevel: self smoothing.
- string do:[:char| | glyph |
- glyph := font at: char.
- balloonCanvas preserveStateDuring:[:subCanvas|
- subCanvas transformBy: (MatrixTransform2x3 withOffset: xStart at 0).
- subCanvas
- drawGeneralBezierShape: glyph contours
- color: self color
- borderWidth: self borderWidth
- borderColor: self borderColor].
- xStart := xStart + glyph advanceWidth.
- ].
- ].!
Item was removed:
- ----- Method: TTSampleStringMorph>>edit (in category 'menus') -----
- edit
- "Allow the user to change the text in a crude way"
-
- | str |
- str := FillInTheBlankMorph request: 'Type in new text for this TrueType displayer.'
- initialAnswer: 'some text'.
- str isEmpty ifTrue: [^ self].
- self string: str.
- !
Item was removed:
- ----- Method: TTSampleStringMorph>>font: (in category 'accessing') -----
- font: aTTFontDescription
- font := aTTFontDescription.
- string ifNil: [self string: aTTFontDescription fullName]
- ifNotNil: [self initializeString].!
Item was removed:
- ----- Method: TTSampleStringMorph>>howTo (in category 'menus') -----
- howTo
-
- self inform: 'Many free fonts are stored at www.FontGuy.com.
- Use a normal web browser (not our Scamper) and go there.
- Choose ''categories'' and browse to a font you like.
- Hold the mouse down on the example text in that font.
- When the menu comes up, choose "Copy this link location".
- Come back into Squeak, choose "load font from web..."
- from this menu, and paste in the url.'!
Item was removed:
- ----- Method: TTSampleStringMorph>>initializeString (in category 'initialize') -----
- initializeString
- | xStart char glyph |
- (font isNil or: [string isNil]) ifTrue: [^ self].
- xStart := 0.
- ttBounds := 0 at 0 corner: 0 at 0.
- 1 to: string size do:
- [:i |
- char := string at: i.
- glyph := font at: char.
- ttBounds := ttBounds quickMerge: (glyph bounds translateBy: xStart at 0).
- xStart := xStart + glyph advanceWidth.
- ].
- self extent: ttBounds extent // 40.
- self borderWidth: ttBounds height // 40!
Item was removed:
- ----- Method: TTSampleStringMorph>>initializeToStandAlone (in category 'parts bin') -----
- initializeToStandAlone
- "Make me into an example"
-
- | dd |
- dd := TTFontDescription default.
- dd ifNil: [^ RectangleMorph initializeToStandAlone]. "not available"
-
- super initializeToStandAlone.
- self font: dd; color: (TranslucentColor r: 1.0 g: 0.097 b: 1.0 alpha: 0.6).
- self string: 'TrueType fonts are beautiful'.
- !
Item was removed:
- ----- Method: TTSampleStringMorph>>loadFromURL (in category 'menus') -----
- loadFromURL
- "Allow the user to change the text in a crude way"
-
- | url |
- url := FillInTheBlankMorph request: ' Type in the url for a TrueType font on the web. '
- initialAnswer: 'http://www.fontguy.com/download.asp?fontid=1494'.
- url isEmpty ifTrue: [^ self].
- self loadFromURL: url.
- !
Item was removed:
- ----- Method: TTSampleStringMorph>>loadFromURL: (in category 'menus') -----
- loadFromURL: urlString
- "Fetch the file, unarchive, unzip, and use as my font."
-
- | rawStrm |
- rawStrm := HTTPSocket httpGet: urlString. "Later use an HttpURL?"
- self font: (TTFontReader readFrom: rawStrm asUnZippedStream).
- !
Item was removed:
- ----- Method: TTSampleStringMorph>>printOn: (in category 'printing') -----
- printOn: aStream
- aStream nextPutAll: 'TTSampleString(';
- nextPutAll: font familyName;
- nextPut: $)!
Item was removed:
- ----- Method: TTSampleStringMorph>>string (in category 'accessing') -----
- string
- ^ string!
Item was removed:
- ----- Method: TTSampleStringMorph>>string: (in category 'accessing') -----
- string: aString
- string := aString.
- self initializeString.!
Item was removed:
- LayoutPolicy subclass: #TableLayout
- instanceVariableNames: 'properties minExtentCache'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Layouts'!
-
- !TableLayout commentStamp: '<historical>' prior: 0!
- The layout process:
- For computing the new layout for the children of any morph, we start with an initial rectangle which is provided as a reference.
-
- Step 1: The first step of layout computation is to compute the minimum extent each of our children can have. The minimum extent is mapped through both the local layout frame of the morph (for relative positioning) and the global layout frame (for insets, such as cursor indication) to obtain the minimal size required for each cell.
-
- Step 2: Based on the cell sizes, the number of cells we can put into each row and column is computed. For equal spacing, the maximum size of the cells is taken into account here.
-
- Step 3: Based on the row/column sizes, we compute the extra space which should be added to each row/column. For
- #leftFlush/#topFlush - we add all extra space add the end
- #rightFlush/#bottomFlush - we add all extra space at the start
- #centering - we add 1/2 of the extra space at start and end
- #justified - we distribute the space evenly between the morphs
- [NOTE: If any #spaceFill morphs are encountered during this step, #justified is implied and the space is exclusively and equally distributed between those #spaceFill morphs. This is for backward compatibility and should *never* be necessary in the new regime].
-
- Step 4: The morphs are placed in the computed cells and the extra space is distributed as necessary. Placing the submorphs is done by mapping through the global and the local layout frame as requested.
-
- Start point:
- => bounds: new rectangle for the morph.
-
- Compute basic arrangement of morphs:
- => For each submorph compute minExtent
- - if global layout frame inset in global layout frame
- - if local layout frame inset in local layout frame
- => Compute number of morphs per, width and height of row/column
- - if equal spacing based on max size
- => Compute extra space per row/column
- - if centering = #justified; distribute space equally
- - if centering #leftFlush/#topFlush (-1) add start extra
- - if centering #rightFlush/#bottomFlush (1) add end extra
- - if centering #centered add 1/2 extra to start/end
- <extra space must be float and rounded accordingly!!>
- => Place morphs in appropriate cells
- - if global layout frame inset in global layout frame
- - if local layout frame inset in local layout frame
- <will likely cause #layoutChanged by submorphs>
-
- Distribute morphs in row/column:
-
- => Compute the max length of each row/column
- !
Item was removed:
- ----- Method: TableLayout>>computeCellArrangement:in:horizontal:target: (in category 'layout') -----
- computeCellArrangement: cellHolder in: newBounds horizontal: aBool target: aMorph
- "Compute number of cells we can put in each row/column. The returned array contains a list of all the cells we can put into the row/column at each level.
- Note: The arrangement is so that the 'x' value of each cell advances along the list direction and the 'y' value along the wrap direction. The returned arrangement has an extra cell at the start describing the width and height of the row."
-
- | cells wrap spacing output maxExtent n sum index max cell first last w cellMax maxCell hFill vFill gap |
- maxCell := cellHolder key.
- cells := cellHolder value.
- properties wrapDirection == #none
- ifTrue: [wrap := SmallInteger maxVal]
- ifFalse:
- [wrap := aBool ifTrue: [newBounds width] ifFalse: [newBounds height].
- wrap := wrap max: (maxCell x)].
- spacing := properties cellSpacing.
- (spacing == #globalRect or: [spacing = #globalSquare])
- ifTrue:
- ["Globally equal spacing is a very special case here, so get out fast and easy"
-
- ^self
- computeGlobalCellArrangement: cells
- in: newBounds
- horizontal: aBool
- wrap: wrap
- spacing: spacing].
- output := WriteStream on: Array new.
- gap := properties cellGap asPoint.
- aBool ifFalse: [gap := gap transposed].
- first := last := nil.
- maxExtent := 0 @ 0.
- sum := 0.
- index := 1.
- n := 0.
- hFill := vFill := false.
- [index <= cells size] whileTrue:
- [w := sum.
- cell := cells at: index.
- cellMax := maxExtent max: cell cellSize. "e.g., minSize"
- sum := (spacing == #localRect or: [spacing == #localSquare])
- ifTrue:
- ["Recompute entire size of current row"
-
- max := spacing == #localSquare
- ifTrue: [cellMax x max: cellMax y]
- ifFalse: [cellMax x].
- (n + 1) * max]
- ifFalse: [sum + cell cellSize x].
- (sum + (n * gap x) > wrap and: [first notNil])
- ifTrue:
- ["It doesn't fit and we're now starting a new line"
-
- (spacing == #localSquare or: [spacing == #localRect])
- ifTrue:
- [spacing == #localSquare
- ifTrue: [maxExtent := (maxExtent x max: maxExtent y) asPoint].
- first do: [:c | c cellSize: maxExtent]].
- w := w + ((n - 1) * gap x).
- "redistribute extra space"
- first nextCell
- ifNotNil: [first nextCell do: [:c | c addExtraSpace: gap x @ 0]].
- last := LayoutCell new.
- last cellSize: w @ maxExtent y.
- last hSpaceFill: hFill.
- last vSpaceFill: vFill.
- last nextCell: first.
- output position = 0 ifFalse: [last addExtraSpace: 0 @ gap y].
- output nextPut: last.
- first := nil.
- maxExtent := 0 @ 0.
- sum := 0.
- n := 0.
- hFill := vFill := false]
- ifFalse:
- ["It did fit; use next item from input"
-
- first ifNil: [first := last := cell]
- ifNotNil:
- [last nextCell: cell.
- last := cell].
- index := index + 1.
- n := n + 1.
- maxExtent := cellMax.
- hFill := hFill or: [cell hSpaceFill].
- vFill := vFill or: [cell vSpaceFill]]].
- first ifNotNil:
- [last := LayoutCell new.
- sum := sum + ((n - 1) * gap x).
- first nextCell
- ifNotNil: [first nextCell do: [:c | c addExtraSpace: gap x @ 0]].
- last cellSize: sum @ maxExtent y.
- last hSpaceFill: hFill.
- last vSpaceFill: vFill.
- last nextCell: first.
- output position = 0 ifFalse: [last addExtraSpace: 0 @ gap y].
- output nextPut: last].
- output := output contents.
- properties listSpacing == #equal
- ifTrue:
- ["Make all the heights equal"
-
- max := output inject: 0 into: [:size :c | size max: c cellSize y].
- output do: [:c | c cellSize: c cellSize x @ max]].
- ^output!
Item was removed:
- ----- Method: TableLayout>>computeCellSizes:in:horizontal: (in category 'layout') -----
- computeCellSizes: aMorph in: newBounds horizontal: aBool
- "Step 1: Compute the minimum extent for all the children of aMorph"
- | cells block minSize maxSize maxCell insetExtra |
- cells := WriteStream on: (Array new: aMorph submorphCount).
- minSize := properties minCellSize asPoint.
- maxSize := properties maxCellSize asPoint.
- aBool ifTrue:[
- minSize := minSize transposed.
- maxSize := maxSize transposed].
- maxCell := 0 at 0.
- insetExtra := properties cellInset.
- insetExtra isRectangle
- ifTrue: [insetExtra := insetExtra left + insetExtra right @ (insetExtra top + insetExtra bottom)]
- ifFalse: [insetExtra := insetExtra*2 asPoint].
- block := [:m| | size cell |
- m disableTableLayout ifFalse:[
- size := m minExtent asIntegerPoint + insetExtra.
- cell := LayoutCell new target: m.
- aBool ifTrue:[
- cell hSpaceFill: m hResizing == #spaceFill.
- cell vSpaceFill: m vResizing == #spaceFill.
- ] ifFalse:[
- cell hSpaceFill: m vResizing == #spaceFill.
- cell vSpaceFill: m hResizing == #spaceFill.
- size := size transposed.
- ].
- size := (size min: maxSize) max: minSize.
- cell cellSize: size.
- maxCell := maxCell max: size.
- cells nextPut: cell]].
- properties reverseTableCells
- ifTrue:[aMorph submorphsReverseDo: block]
- ifFalse:[aMorph submorphsDo: block].
- ^maxCell -> cells contents!
Item was removed:
- ----- Method: TableLayout>>computeExtraSpacing:in:horizontal:target: (in category 'layout') -----
- computeExtraSpacing: arrangement in: newBounds horizontal: aBool target: aMorph
- "Compute the required extra spacing for laying out the cells"
-
- "match newBounds extent with arrangement's orientation"
-
- | extent extra centering n extraPerCell cell last hFill vFill max amount allow |
- extent := newBounds extent.
- aBool ifFalse: [extent := extent transposed].
-
- "figure out if we have any horizontal or vertical space fillers"
- hFill := vFill := false.
- max := 0 @ 0.
- arrangement do:
- [:c |
- max := (max x max: c cellSize x) @ (max y + c cellSize y).
- max := max max: c cellSize.
- hFill := hFill or: [c hSpaceFill].
- vFill := vFill or: [c vSpaceFill]].
-
- "Take client's shrink wrap constraints into account.
- Note: these are only honored when there are no #spaceFill children,
- or when #rubberBandCells is set."
- allow := properties rubberBandCells not.
- aMorph hResizing == #shrinkWrap
- ifTrue:
- [aBool
- ifTrue: [allow & hFill ifFalse: [extent := max x @ (max y max: extent y)]]
- ifFalse: [allow & vFill ifFalse: [extent := (max x max: extent x) @ max y]]].
- aMorph vResizing == #shrinkWrap
- ifTrue:
- [aBool
- ifFalse: [allow & hFill ifFalse: [extent := max x @ (max y max: extent y)]]
- ifTrue: [allow & vFill ifFalse: [extent := (max x max: extent x) @ max y]]].
-
- "Now compute the extra v space"
- extra := extent y
- - (arrangement inject: 0 into: [:sum :c | sum + c cellSize y]).
- extra > 0
- ifTrue:
- ["Check if we have any #spaceFillers"
-
- vFill
- ifTrue:
- ["use only #spaceFillers"
-
- n := arrangement inject: 0
- into: [:sum :c | c vSpaceFill ifTrue: [sum + 1] ifFalse: [sum]].
- n isZero ifFalse: [extraPerCell := extra asFloat / n asFloat].
- extra := last := 0.
- arrangement do:
- [:c |
- c vSpaceFill
- ifTrue:
- [extra := (last := extra) + extraPerCell.
- amount := 0 @ (extra truncated - last truncated).
- c do: [:cc | cc cellSize: cc cellSize + amount]]]]
- ifFalse:
- ["no #spaceFillers; distribute regularly"
-
- centering := properties wrapCentering.
- "centering == #topLeft ifTrue:[]." "add all extra space to the last cell; e.g., do nothing"
- centering == #bottomRight
- ifTrue:
- ["add all extra space to the first cell"
-
- arrangement ifNotEmpty: [arrangement first addExtraSpace: 0 @ extra]].
- centering == #center
- ifTrue:
- ["add 1/2 extra space to the first and last cell"
-
- arrangement ifNotEmpty: [arrangement first addExtraSpace: 0 @ (extra // 2)]].
- centering == #justified
- ifTrue:
- ["add extra space equally distributed to each cell"
-
- n := arrangement size - 1 max: 1.
- extraPerCell := extra asFloat / n asFloat.
- extra := last := 0.
- arrangement do:
- [:c |
- c addExtraSpace: 0 @ (extra truncated - last truncated).
- extra := (last := extra) + extraPerCell]]]].
-
- "Now compute the extra space for the primary direction"
- centering := properties listCentering.
- 1 to: arrangement size
- do:
- [:i |
- cell := arrangement at: i.
- extra := extent x - cell cellSize x.
- extra > 0
- ifTrue:
- ["Check if we have any #spaceFillers"
- cell := cell nextCell.
- cell hSpaceFill
- ifTrue:
- ["use only #spaceFillers"
-
-
- n := cell inject: 0
- into: [:sum :c | c hSpaceFill ifTrue: [sum + c target spaceFillWeight] ifFalse: [sum]].
- n isZero ifFalse: [extraPerCell := extra asFloat / n asFloat].
- extra := last := 0.
- cell do:
- [:c |
- c hSpaceFill
- ifTrue:
- [extra := (last := extra) + (extraPerCell * c target spaceFillWeight).
- amount := extra truncated - last truncated.
- c cellSize: c cellSize + (amount @ 0)]]]
- ifFalse:
- ["no #spaceFiller; distribute regularly"
-
-
- "centering == #topLeft ifTrue:[]" "add all extra space to the last cell; e.g., do nothing"
- centering == #bottomRight
- ifTrue:
- ["add all extra space to the first cell"
-
- cell addExtraSpace: extra @ 0].
- centering == #center
- ifTrue:
- ["add 1/2 extra space to the first and last cell"
-
- cell addExtraSpace: (extra // 2) @ 0].
- centering == #justified
- ifTrue:
- ["add extra space equally distributed to each cell"
-
- n := cell size - 1 max: 1.
- extraPerCell := extra asFloat / n asFloat.
- extra := last := 0.
- cell do:
- [:c |
- c addExtraSpace: (extra truncated - last truncated) @ 0.
- extra := (last := extra) + extraPerCell]]]]]!
Item was removed:
- ----- Method: TableLayout>>computeGlobalCellArrangement:in:horizontal:wrap:spacing: (in category 'layout') -----
- computeGlobalCellArrangement: cells in: newBounds horizontal: aBool wrap: wrap spacing: spacing
- "Compute number of cells we can put in each row/column. The returned array contains a list of all the cells we can put into the row/column at each level.
- Note: The arrangement is so that the 'x' value of each cell advances along the list direction and the 'y' value along the wrap direction. The returned arrangement has an extra cell at the start describing the width and height of the row."
- | output maxExtent n cell first last hFill vFill gap |
- output := (WriteStream on: Array new).
- gap := properties cellGap asPoint.
- first := last := nil.
- maxExtent := cells inject: 0 at 0 into:[:size :c| size max: c cellSize "e.g., minSize"].
- spacing == #globalSquare ifTrue:[maxExtent := (maxExtent x max: maxExtent y) asPoint].
- n := ((wrap + gap x) // (maxExtent x + gap x)) max: 1.
- hFill := vFill := false.
- 1 to: cells size do:[:i|
- cell := cells at: i.
- hFill := hFill or:[cell hSpaceFill].
- vFill := vFill or:[cell vSpaceFill].
- cell cellSize: maxExtent.
- first ifNil:[first := last := cell] ifNotNil:[last nextCell: cell. last := cell].
- (i \\ n) = 0 ifTrue:[ "It doesn't fit and we're now starting a new line"
- "redistribute extra space"
- first nextCell ifNotNil: [first nextCell do: [:c | c addExtraSpace: gap x @ 0]].
- last := LayoutCell new.
- last cellSize: (maxExtent x * n) @ (maxExtent y).
- last hSpaceFill: hFill.
- last vSpaceFill: vFill.
- hFill := vFill := false.
- last nextCell: first.
- output position = 0 ifFalse: [last addExtraSpace: 0 @ gap y].
- output nextPut: last.
- first := nil]].
- first ifNotNil:[
- last := LayoutCell new.
- first nextCell ifNotNil: [first nextCell do: [:c | c addExtraSpace: gap x @ 0]].
- last cellSize: (maxExtent x * n) @ (maxExtent y). self flag: #arNote."@@@: n is not correct!!"
- last nextCell: first.
- output position = 0 ifFalse: [last addExtraSpace: 0 @ gap y].
- output nextPut: last].
- ^output contents!
Item was removed:
- ----- Method: TableLayout>>flushLayoutCache (in category 'layout') -----
- flushLayoutCache
- "Flush any cached information associated with the receiver"
- minExtentCache := nil.!
Item was removed:
- ----- Method: TableLayout>>indexForInserting:at:in: (in category 'utilities') -----
- indexForInserting: aMorph at: aPoint in: owner
- "Return the insertion index based on the layout strategy defined for some morph. Used for drop insertion."
-
- | horizontal morphList index |
- owner hasSubmorphs ifFalse: [^1].
- aMorph disableTableLayout ifTrue: [^1].
- horizontal := (owner listDirection == #topToBottom
- or: [owner listDirection == #bottomToTop]) not .
- morphList := owner submorphs.
- owner reverseTableCells ifTrue: [morphList := morphList reversed].
- index := self
- indexForInserting: aPoint
- inList: morphList
- horizontal: horizontal
- target: owner.
- owner reverseTableCells ifTrue: [index := morphList size - index + 2].
- ^index ifNil: [1]!
Item was removed:
- ----- Method: TableLayout>>indexForInserting:inList:horizontal:target: (in category 'utilities') -----
- indexForInserting: aPoint inList: morphList horizontal: aBool target: aMorph
- | cmp1 cmp2 cmp3 noWrap |
- properties := aMorph layoutProperties.
- noWrap := properties wrapDirection == #none.
- aBool
- ifTrue:
- ["horizontal"
-
- properties listDirection == #rightToLeft
- ifTrue: [cmp1 := [:rect | aPoint x > rect left]]
- ifFalse: [cmp1 := [:rect | aPoint x < rect right]].
- properties wrapDirection == #bottomToTop
- ifTrue:
- [cmp2 := [:rect | aPoint y > rect top].
- cmp3 := [:rect | aPoint y > rect bottom]]
- ifFalse:
- [cmp2 := [:rect | aPoint y < rect bottom].
- cmp3 := [:rect | aPoint y < rect top]]]
- ifFalse:
- ["vertical"
-
- properties listDirection == #bottomToTop
- ifTrue: [cmp1 := [:rect | aPoint y > rect top]]
- ifFalse: [cmp1 := [:rect | aPoint y < rect bottom]].
- properties wrapDirection == #rightToLeft
- ifTrue:
- [cmp2 := [:rect | aPoint x > rect left].
- cmp3 := [:rect | aPoint x > rect right]]
- ifFalse:
- [cmp2 := [:rect | aPoint x < rect right].
- cmp3 := [:rect | aPoint x < rect left]]].
- morphList keysAndValuesDo:
- [:index :m | | box |
- self flag: #arNote. "it is not quite clear if we can really use #fullBounds here..."
- box := m fullBounds.
- noWrap
- ifTrue:
- ["Only in one direction"
-
- (cmp1 value: box) ifTrue: [^index]]
- ifFalse:
- ["Check for inserting before current row"
-
- (cmp3 value: box) ifTrue: [^index].
- "Check for inserting before current cell"
- ((cmp1 value: box) and: [cmp2 value: box]) ifTrue: [^index]]].
- ^morphList size + 1!
Item was removed:
- ----- Method: TableLayout>>isTableLayout (in category 'testing') -----
- isTableLayout
- ^true!
Item was removed:
- ----- Method: TableLayout>>layout:in: (in category 'layout') -----
- layout: aMorph in: box
- "Compute the layout for the given morph based on the new bounds"
-
- | cells arrangement horizontal newBounds |
- aMorph hasSubmorphs ifFalse: [^self].
- properties := aMorph assureTableLayoutProperties.
- newBounds := box origin asIntegerPoint corner: box corner asIntegerPoint.
- (properties wrapDirection == #none and: [properties cellSpacing == #none])
- ifTrue:
- ["get into the fast lane"
-
- properties listCentering == #justified
- ifFalse:
- ["can't deal with that"
-
- properties listDirection == #leftToRight
- ifTrue: [^self layoutLeftToRight: aMorph in: newBounds].
- properties listDirection == #topToBottom
- ifTrue: [^self layoutTopToBottom: aMorph in: newBounds]]].
- horizontal := (properties listDirection == #topToBottom
- or: [properties listDirection == #bottomToTop]) not.
- "Step 1: Compute the minimum extent for all the children of aMorph"
- cells := self
- computeCellSizes: aMorph
- in: (0 @ 0 corner: newBounds extent)
- horizontal: horizontal.
- "Step 2: Compute the arrangement of the cells for each row and column"
- arrangement := self
- computeCellArrangement: cells
- in: newBounds
- horizontal: horizontal
- target: aMorph.
- "Step 3: Compute the extra spacing for each cell"
- self
- computeExtraSpacing: arrangement
- in: newBounds
- horizontal: horizontal
- target: aMorph.
- "Step 4: Place the children within the cells accordingly"
- self
- placeCells: arrangement
- in: newBounds
- horizontal: horizontal
- target: aMorph!
Item was removed:
- ----- Method: TableLayout>>layoutLeftToRight:in: (in category 'optimized') -----
- layoutLeftToRight: aMorph in: newBounds
- "An optimized left-to-right list layout"
-
- | inset insetExtra gap extent block posX posY centering extraPerCell amount minX minY maxX maxY n width extra last cell size height sum vFill first cellRect |
- size := properties minCellSize asPoint.
- minX := size x.
- minY := size y.
- size := properties maxCellSize asPoint.
- maxX := size x.
- maxY := size y.
- inset := properties cellInset.
- insetExtra := inset isRectangle
- ifTrue: [insetExtra := inset left + inset right @ (inset top + inset bottom)]
- ifFalse: [insetExtra := inset*2 asPoint].
- (inset isNumber and: [inset isZero]) ifTrue: [inset := nil].
- gap := properties cellGap asPoint x.
- extent := newBounds extent.
- n := 0.
- vFill := false.
- sum := 0.
- width := height := 0.
- first := last := nil.
- block :=
- [:m | | sizeX props sizeY |
- props := m layoutProperties ifNil: [m].
- props disableTableLayout
- ifFalse:
- [n := n + 1.
- cell := LayoutCell new target: m.
- props hResizing == #spaceFill
- ifTrue:
- [cell hSpaceFill: true.
- extra := m spaceFillWeight.
- cell extraSpace: extra.
- sum := sum + extra]
- ifFalse: [cell hSpaceFill: false].
- props vResizing == #spaceFill ifTrue: [vFill := true].
- size := m minExtent + insetExtra.
- sizeX := size x.
- sizeY := size y.
- sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX].
- sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY].
- cell cellSize: sizeX.
- last ifNil: [first := cell] ifNotNil: [last nextCell: cell].
- last := cell.
- width := width + sizeX.
- sizeY > height ifTrue: [height := sizeY]]].
- properties reverseTableCells
- ifTrue: [aMorph submorphsReverseDo: block]
- ifFalse: [aMorph submorphsDo: block].
- n > 1 ifTrue: [width := width + ((n - 1) * gap)].
- (properties hResizing == #shrinkWrap
- and: [properties rubberBandCells or: [sum isZero]])
- ifTrue: [extent := width @ (extent y max: height)].
- (properties vResizing == #shrinkWrap
- and: [properties rubberBandCells or: [vFill not]])
- ifTrue: [extent := (extent x max: width) @ height].
- posX := newBounds left.
- posY := newBounds top.
-
- "Compute extra vertical space"
- extra := extent y - height.
- extra := extra max: 0.
- extra > 0
- ifTrue:
- [vFill
- ifTrue: [height := extent y]
- ifFalse:
- [centering := properties wrapCentering.
- centering == #bottomRight ifTrue: [posY := posY + extra].
- centering == #center ifTrue: [posY := posY + (extra // 2)]]].
-
-
- "Compute extra horizontal space"
- extra := extent x - width.
- extra := extra max: 0.
- extraPerCell := 0.
- extra > 0
- ifTrue:
- [sum isZero
- ifTrue:
- ["extra space but no #spaceFillers"
-
- centering := properties listCentering.
- centering == #bottomRight ifTrue: [posX := posX + extra].
- centering == #center ifTrue: [posX := posX + (extra // 2)]]
- ifFalse: [extraPerCell := extra asFloat / sum asFloat]].
- n := 0.
- extra := last := 0.
- cell := first.
- [cell isNil] whileFalse:
- [n := n + 1.
- width := cell cellSize.
- (extraPerCell > 0 and: [cell hSpaceFill])
- ifTrue:
- [extra := (last := extra) + (extraPerCell * cell extraSpace).
- amount := extra truncated - last truncated.
- width := width + amount].
- cellRect := (posX @ posY extent: width @ height).
- inset ifNotNil: [cellRect := cellRect insetBy: inset].
- cell target
- layoutInBounds: cellRect
- positioning: properties cellPositioning.
- posX := posX + width + gap.
- cell := cell nextCell]!
Item was removed:
- ----- Method: TableLayout>>layoutTopToBottom:in: (in category 'optimized') -----
- layoutTopToBottom: aMorph in: newBounds
- "An optimized top-to-bottom list layout"
-
- | inset insetExtra gap extent block posX posY centering extraPerCell amount minX minY maxX maxY n height extra last cell size width sum vFill first cellRect |
- size := properties minCellSize asPoint.
- minX := size x.
- minY := size y.
- size := properties maxCellSize asPoint.
- maxX := size x.
- maxY := size y.
- inset := properties cellInset.
- insetExtra := inset isRectangle
- ifTrue: [insetExtra := inset left + inset right @ (inset top + inset bottom)]
- ifFalse: [insetExtra := inset*2 asPoint].
- (inset isNumber and: [inset isZero]) ifTrue: [inset := nil].
- gap := properties cellGap asPoint y.
- extent := newBounds extent.
- n := 0.
- vFill := false.
- sum := 0.
- width := height := 0.
- first := last := nil.
- block :=
- [:m | | sizeY sizeX props |
- props := m layoutProperties ifNil: [m].
- props disableTableLayout
- ifFalse:
- [n := n + 1.
- cell := LayoutCell new target: m.
- props vResizing == #spaceFill
- ifTrue:
- [cell vSpaceFill: true.
- extra := m spaceFillWeight.
- cell extraSpace: extra.
- sum := sum + extra]
- ifFalse: [cell vSpaceFill: false].
- props hResizing == #spaceFill ifTrue: [vFill := true].
- size := m minExtent + insetExtra.
- sizeX := size x.
- sizeY := size y.
- sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX].
- sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY].
- cell cellSize: sizeY.
- first ifNil: [first := cell] ifNotNil: [last nextCell: cell].
- last := cell.
- height := height + sizeY.
- sizeX > width ifTrue: [width := sizeX]]].
- properties reverseTableCells
- ifTrue: [aMorph submorphsReverseDo: block]
- ifFalse: [aMorph submorphsDo: block].
- n > 1 ifTrue: [height := height + ((n - 1) * gap)].
- (properties vResizing == #shrinkWrap
- and: [properties rubberBandCells or: [sum isZero]])
- ifTrue: [extent := (extent x max: width) @ height].
- (properties hResizing == #shrinkWrap
- and: [properties rubberBandCells or: [vFill not]])
- ifTrue: [extent := width @ (extent y max: height)].
- posX := newBounds left.
- posY := newBounds top.
-
- "Compute extra horizontal space"
- extra := extent x - width.
- extra := extra max: 0.
- extra > 0
- ifTrue:
- [vFill
- ifTrue: [width := extent x]
- ifFalse:
- [centering := properties wrapCentering.
- centering == #bottomRight ifTrue: [posX := posX + extra].
- centering == #center ifTrue: [posX := posX + (extra // 2)]]].
-
-
- "Compute extra vertical space"
- extra := extent y - height.
- extra := extra max: 0.
- extraPerCell := 0.
- extra > 0
- ifTrue:
- [sum isZero
- ifTrue:
- ["extra space but no #spaceFillers"
-
- centering := properties listCentering.
- centering == #bottomRight ifTrue: [posY := posY + extra].
- centering == #center ifTrue: [posY := posY + (extra // 2)]]
- ifFalse: [extraPerCell := extra asFloat / sum asFloat]].
- n := 0.
- extra := last := 0.
- cell := first.
- [cell isNil] whileFalse:
- [n := n + 1.
- height := cell cellSize.
- (extraPerCell > 0 and: [cell vSpaceFill])
- ifTrue:
- [extra := (last := extra) + (extraPerCell * cell extraSpace).
- amount := extra truncated - last truncated.
- height := height + amount].
- cellRect := (posX @ posY extent: width @ height).
- inset ifNotNil: [cellRect := cellRect insetBy: inset].
- cell target
- layoutInBounds: cellRect
- positioning: properties cellPositioning.
- posY := posY + height + gap.
- cell := cell nextCell]!
Item was removed:
- ----- Method: TableLayout>>minExtentHorizontal: (in category 'optimized') -----
- minExtentHorizontal: aMorph
- "Return the minimal size aMorph's children would require given the new bounds"
-
- | insetExtra gap minX minY maxX maxY n size width height |
- size := properties minCellSize asPoint.
- minX := size x.
- minY := size y.
- size := properties maxCellSize asPoint.
- maxX := size x.
- maxY := size y.
- insetExtra := properties cellInset.
- insetExtra isRectangle
- ifTrue: [insetExtra := insetExtra left + insetExtra right @ (insetExtra top + insetExtra bottom)]
- ifFalse: [insetExtra := insetExtra*2 asPoint].
- gap := properties cellGap asPoint.
- n := 0.
- width := height := 0.
- aMorph submorphsDo:
- [:m | | sizeX sizeY |
- m disableTableLayout
- ifFalse:
- [n := n + 1.
- size := m minExtent + insetExtra.
- sizeX := size x.
- sizeY := size y.
- sizeX < minX
- ifTrue: [sizeX := minX]
- ifFalse: [sizeX := sizeX min: maxX].
- sizeY < minY
- ifTrue: [sizeY := minY]
- ifFalse: [sizeY := sizeY min: maxY].
- width := width + sizeX.
- sizeY > height ifTrue: [height := sizeY]]].
- n > 1 ifTrue: [width := width + ((n - 1) * gap x)].
- ^minExtentCache := width @ height!
Item was removed:
- ----- Method: TableLayout>>minExtentOf:in: (in category 'layout') -----
- minExtentOf: aMorph in: box
- "Return the minimal size aMorph's children would require given the new bounds"
-
- | cells arrangement horizontal newBounds minX minY dir |
- minExtentCache isNil ifFalse: [^minExtentCache].
- aMorph hasSubmorphs ifFalse: [^0 @ 0].
- properties := aMorph assureTableLayoutProperties.
- (properties wrapDirection == #none and: [properties cellSpacing == #none])
- ifTrue:
- ["Get into the fast lane"
-
- dir := properties listDirection.
- (dir == #leftToRight or: [dir == #rightToLeft])
- ifTrue: [^self minExtentHorizontal: aMorph].
- (dir == #topToBottom or: [dir == #bottomToTop])
- ifTrue: [^self minExtentVertical: aMorph]].
- newBounds := box origin asIntegerPoint corner: box corner asIntegerPoint.
- horizontal := (properties listDirection == #topToBottom
- or: [properties listDirection == #bottomToTop]) not.
- "Step 1: Compute the minimum extent for all the children of aMorph"
- cells := self
- computeCellSizes: aMorph
- in: (0 @ 0 corner: newBounds extent)
- horizontal: horizontal.
- "Step 2: Compute the arrangement of the cells for each row and column"
- arrangement := self
- computeCellArrangement: cells
- in: newBounds
- horizontal: horizontal
- target: aMorph.
- "Step 3: Extract the minimum size out of the arrangement"
- minX := minY := 0.
- arrangement do:
- [:cell |
- minX := minX max: cell cellSize x + cell extraSpace x.
- minY := minY + cell cellSize y + cell extraSpace y].
- minExtentCache := horizontal ifTrue: [minX @ minY] ifFalse: [minY @ minX].
- ^minExtentCache!
Item was removed:
- ----- Method: TableLayout>>minExtentVertical: (in category 'optimized') -----
- minExtentVertical: aMorph
- "Return the minimal size aMorph's children would require given the new bounds"
-
- | insetExtra gap minX minY maxX maxY n size width height |
- size := properties minCellSize asPoint.
- minX := size x.
- minY := size y.
- size := properties maxCellSize asPoint.
- maxX := size x.
- maxY := size y.
- insetExtra := properties cellInset.
- insetExtra isRectangle
- ifTrue: [insetExtra := insetExtra left + insetExtra right @ (insetExtra top + insetExtra bottom)]
- ifFalse: [insetExtra := insetExtra*2 asPoint].
- gap := properties cellGap asPoint.
- n := 0.
- width := height := 0.
- aMorph submorphsDo:
- [:m | | sizeY sizeX |
- m disableTableLayout
- ifFalse:
- [n := n + 1.
- size := m minExtent + insetExtra.
- sizeX := size x.
- sizeY := size y.
- sizeX < minX
- ifTrue: [sizeX := minX]
- ifFalse: [sizeX := sizeX min: maxX].
- sizeY < minY
- ifTrue: [sizeY := minY]
- ifFalse: [sizeY := sizeY min: maxY].
- height := height + sizeY.
- sizeX > width ifTrue: [width := sizeX]]].
- n > 1 ifTrue: [height := height + ((n - 1) * gap y)].
- ^minExtentCache := width @ height!
Item was removed:
- ----- Method: TableLayout>>placeCells:in:horizontal:target: (in category 'layout') -----
- placeCells: arrangement in: newBounds horizontal: aBool target: aMorph
- "Place the morphs within the cells accordingly"
-
- | xDir yDir anchor yDist place cell xDist cellRect corner inset |
- inset := properties cellInset.
- (inset isNumber and: [inset isZero]) ifTrue: [inset := nil].
- aBool
- ifTrue:
- ["horizontal layout"
-
- properties listDirection == #rightToLeft
- ifTrue:
- [xDir := -1 @ 0.
- properties wrapDirection == #bottomToTop
- ifTrue:
- [yDir := 0 @ -1.
- anchor := newBounds bottomRight]
- ifFalse:
- [yDir := 0 @ 1.
- anchor := newBounds topRight]]
- ifFalse:
- [xDir := 1 @ 0.
- properties wrapDirection == #bottomToTop
- ifTrue:
- [yDir := 0 @ -1.
- anchor := newBounds bottomLeft]
- ifFalse:
- [yDir := 0 @ 1.
- anchor := newBounds topLeft]]]
- ifFalse:
- ["vertical layout"
-
- properties listDirection == #bottomToTop
- ifTrue:
- [xDir := 0 @ -1.
- properties wrapDirection == #rightToLeft
- ifTrue:
- [yDir := -1 @ 0.
- anchor := newBounds bottomRight]
- ifFalse:
- [yDir := 1 @ 0.
- anchor := newBounds bottomLeft]]
- ifFalse:
- [xDir := 0 @ 1.
- anchor := properties wrapDirection == #rightToLeft
- ifTrue:
- [yDir := -1 @ 0.
- newBounds topRight]
- ifFalse:
- [yDir := 1 @ 0.
- newBounds topLeft]]].
- 1 to: arrangement size
- do:
- [:i |
- cell := arrangement at: i.
- cell extraSpace ifNotNil: [anchor := anchor + (cell extraSpace y * yDir)].
- yDist := cell cellSize y * yDir. "secondary advance direction"
- place := anchor.
- cell := cell nextCell.
- [cell isNil] whileFalse:
- [cell extraSpace ifNotNil: [place := place + (cell extraSpace x * xDir)].
- xDist := cell cellSize x * xDir. "primary advance direction"
- corner := place + xDist + yDist.
- cellRect := Rectangle origin: (place min: corner)
- corner: (place max: corner).
- inset ifNotNil: [cellRect := cellRect insetBy: inset].
- cell target
- layoutInBounds: cellRect
- positioning: properties cellPositioning.
- place := place + xDist.
- cell := cell nextCell].
- anchor := anchor + yDist]!
Item was removed:
- LayoutProperties subclass: #TableLayoutProperties
- instanceVariableNames: 'cellInset cellPositioning cellSpacing cellGap layoutInset listCentering listDirection listSpacing reverseTableCells rubberBandCells wrapCentering wrapDirection minCellSize maxCellSize'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Layouts'!
Item was removed:
- ----- Method: TableLayoutProperties>>cellGap (in category 'accessing') -----
- cellGap
- "ifNil is just for migration of old instances."
- ^ cellGap ifNil: [0]!
Item was removed:
- ----- Method: TableLayoutProperties>>cellGap: (in category 'accessing') -----
- cellGap: aNumber
- cellGap := aNumber!
Item was removed:
- ----- Method: TableLayoutProperties>>cellInset (in category 'accessing') -----
- cellInset
- ^cellInset!
Item was removed:
- ----- Method: TableLayoutProperties>>cellInset: (in category 'accessing') -----
- cellInset: aNumber
- cellInset := aNumber!
Item was removed:
- ----- Method: TableLayoutProperties>>cellPositioning (in category 'accessing') -----
- cellPositioning
- ^cellPositioning!
Item was removed:
- ----- Method: TableLayoutProperties>>cellPositioning: (in category 'accessing') -----
- cellPositioning: aSymbol
- cellPositioning := aSymbol!
Item was removed:
- ----- Method: TableLayoutProperties>>cellSpacing (in category 'accessing') -----
- cellSpacing
- ^cellSpacing!
Item was removed:
- ----- Method: TableLayoutProperties>>cellSpacing: (in category 'accessing') -----
- cellSpacing: aSymbol
- cellSpacing := aSymbol.!
Item was removed:
- ----- Method: TableLayoutProperties>>includesTableLayoutProperties (in category 'testing') -----
- includesTableLayoutProperties
-
- ^ true!
Item was removed:
- ----- Method: TableLayoutProperties>>initialize (in category 'initialize') -----
- initialize
- super initialize.
- cellSpacing := listSpacing := wrapDirection := #none.
- cellPositioning := #center.
- listCentering := wrapCentering := #topLeft.
- listDirection := #topToBottom.
- reverseTableCells := rubberBandCells := false.
- layoutInset := cellInset := minCellSize := cellGap := 0.
- maxCellSize := 1073741823. "SmallInteger maxVal"
- !
Item was removed:
- ----- Method: TableLayoutProperties>>layoutInset (in category 'accessing') -----
- layoutInset
-
- self flag: #todo. "mt: Move up to LayoutProperties. Maybe also #cellInset and #cellPositioning because those seem rather independent from the way cells as computed."
- ^ layoutInset!
Item was removed:
- ----- Method: TableLayoutProperties>>layoutInset: (in category 'accessing') -----
- layoutInset: aNumber
-
- self flag: #todo. "mt: Move up to LayoutProperties. Maybe also #cellInset and #cellPositioning because those seem rather independent from the way cells as computed."
- layoutInset := aNumber.!
Item was removed:
- ----- Method: TableLayoutProperties>>listCentering (in category 'accessing') -----
- listCentering
- ^listCentering!
Item was removed:
- ----- Method: TableLayoutProperties>>listCentering: (in category 'accessing') -----
- listCentering: aSymbol
- listCentering := aSymbol!
Item was removed:
- ----- Method: TableLayoutProperties>>listDirection (in category 'accessing') -----
- listDirection
- ^listDirection!
Item was removed:
- ----- Method: TableLayoutProperties>>listDirection: (in category 'accessing') -----
- listDirection: aSymbol
- listDirection := aSymbol.!
Item was removed:
- ----- Method: TableLayoutProperties>>listSpacing (in category 'accessing') -----
- listSpacing
- ^listSpacing!
Item was removed:
- ----- Method: TableLayoutProperties>>listSpacing: (in category 'accessing') -----
- listSpacing: aSymbol
- listSpacing := aSymbol!
Item was removed:
- ----- Method: TableLayoutProperties>>maxCellSize (in category 'accessing') -----
- maxCellSize
- ^maxCellSize!
Item was removed:
- ----- Method: TableLayoutProperties>>maxCellSize: (in category 'accessing') -----
- maxCellSize: aNumber
- maxCellSize := aNumber.!
Item was removed:
- ----- Method: TableLayoutProperties>>minCellSize (in category 'accessing') -----
- minCellSize
- ^minCellSize!
Item was removed:
- ----- Method: TableLayoutProperties>>minCellSize: (in category 'accessing') -----
- minCellSize: aNumber
- minCellSize := aNumber.!
Item was removed:
- ----- Method: TableLayoutProperties>>reverseTableCells (in category 'accessing') -----
- reverseTableCells
- ^reverseTableCells!
Item was removed:
- ----- Method: TableLayoutProperties>>reverseTableCells: (in category 'accessing') -----
- reverseTableCells: aBool
- reverseTableCells := aBool!
Item was removed:
- ----- Method: TableLayoutProperties>>rubberBandCells (in category 'accessing') -----
- rubberBandCells
- ^rubberBandCells!
Item was removed:
- ----- Method: TableLayoutProperties>>rubberBandCells: (in category 'accessing') -----
- rubberBandCells: aBool
- rubberBandCells := aBool.!
Item was removed:
- ----- Method: TableLayoutProperties>>wrapCentering (in category 'accessing') -----
- wrapCentering
- ^wrapCentering!
Item was removed:
- ----- Method: TableLayoutProperties>>wrapCentering: (in category 'accessing') -----
- wrapCentering: aSymbol
- wrapCentering := aSymbol!
Item was removed:
- ----- Method: TableLayoutProperties>>wrapDirection (in category 'accessing') -----
- wrapDirection
- ^wrapDirection!
Item was removed:
- ----- Method: TableLayoutProperties>>wrapDirection: (in category 'accessing') -----
- wrapDirection: aSymbol
- wrapDirection := aSymbol!
Item was removed:
- ----- Method: Text>>asMorph (in category '*Morphic-converting') -----
- asMorph
- ^ self asTextMorph!
Item was removed:
- ----- Method: Text>>asStringMorph (in category '*Morphic-converting') -----
- asStringMorph
- ^ StringMorph
- contents: self string
- font: (self fontAt: 1 withStyle: TextStyle default)
- emphasis: (self emphasisAt: 1)!
Item was removed:
- ----- Method: Text>>asTextMorph (in category '*Morphic-converting') -----
- asTextMorph
- "Install the receiver in a text morph. Derive an appropriate text style from the receiver's first-character attributes (e.g., to make tabs look correct)."
-
- ^ TextMorph new
- contentsAsIs: self;
- textStyle: (self fontAt: 1 withStyle: TextStyle default)
- asNewTextStyle;
- yourself!
Item was removed:
- ----- Method: Text>>embeddedMorphs (in category '*Morphic-Text Support') -----
- embeddedMorphs
- "return the list of morphs embedded in me"
-
- | morphs |
- morphs := IdentitySet new.
- runs withStartStopAndValueDo:
- [:start :stop :attribs |
- attribs
- do: [:attrib | attrib anchoredMorph ifNotNil: [morphs add: attrib anchoredMorph]]].
- ^morphs select: [:m | m isMorph]!
Item was removed:
- ----- Method: Text>>embeddedMorphsFrom:to: (in category '*Morphic-Text Support') -----
- embeddedMorphsFrom: start to: stop
- "return the list of morphs embedded in me"
-
- | morphs |
- morphs := IdentitySet new.
- runs
- runsFrom: start
- to: stop
- do:
- [:attribs |
- attribs
- do: [:attr | attr anchoredMorph ifNotNil: [morphs add: attr anchoredMorph]]].
- ^morphs select: [:m | m isMorph]!
Item was removed:
- ----- Method: Text>>explorerContents (in category '*Morphic-Explorer') -----
- explorerContents
-
- ^ (self class allInstVarNames asOrderedCollection withIndexCollect: [:each :index |
- ObjectExplorerWrapper
- with: (self instVarAt: index)
- name: each
- model: self])!
Item was removed:
- TextAttribute subclass: #TextAnchor
- instanceVariableNames: 'anchoredMorph'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Text Support'!
-
- !TextAnchor commentStamp: 'pre 10/4/2019 16:11' prior: 0!
- TextAnchors support anchoring of images in text. A TextAnchor exists as an attribute of text emphasis. Depending on whether its anchoredMorph is a Morph or a Form, it repositions the morph, or displays the form respectively. The coordination between composition, display, and selection can best be understood by browsing the various implementations of placeEmbeddedObjectFrom:.
-
- In the morphic world, you can embed any form or morph in text by adding a startOfHeader character and adding the TextAnchor attribute to it.
-
- Workspace new
- contents: (Text withAll: 'foo') , (Text string: Character startOfHeader asString attribute: (TextAnchor new anchoredMorph: MenuIcons confirmIcon)) , (Text withAll: 'bar');
- openLabel: 'Text with Form'.
-
- Workspace new
- contents: (Text withAll: 'foo') , (Text string: Character startOfHeader asString attribute: (TextAnchor new anchoredMorph: EllipseMorph new)) , (Text withAll: 'bar');
- openLabel: 'Text with Morph'.!
Item was removed:
- ----- Method: TextAnchor class>>alignmentExamples (in category 'examples') -----
- alignmentExamples
- "self alignmentExamples"
- | anchoredMorph textMorph text demoMorph |
- demoMorph := Morph new
- changeTableLayout;
- color: Color white;
- hResizing: #shrinkWrap;
- vResizing: #shrinkWrap;
- yourself.
- #(top center bottom) do: [:morphAlignment |
- #(top center baseline bottom) do: [:textAlignment |
- anchoredMorph := Morph new.
- anchoredMorph textAnchorProperties verticalAlignment: {morphAlignment . textAlignment}.
- anchoredMorph textAnchorProperties padding: (anchoredMorph textAnchorProperties padding top: 10).
- text := Text streamContents: [ :stream |
- stream
- nextPutAll: ('Here is an {1}, {2} example: ' translated format: {morphAlignment . textAlignment});
- nextPutAll: (Text
- string: Character startOfHeader asString
- attributes: {TextAnchor new anchoredMorph: anchoredMorph.
- TextColor color: Color transparent});
- nextPutAll: ' with the morph in the text.' translated].
- textMorph := text asMorph.
- textMorph height: 100.
- demoMorph addMorph: textMorph]].
- demoMorph openInWorld!
Item was removed:
- ----- Method: TextAnchor>>= (in category 'comparing') -----
- = other
- ^ (other class == self class)
- and: [other anchoredMorph == anchoredMorph]!
Item was removed:
- ----- Method: TextAnchor>>anchoredMorph (in category 'accessing') -----
- anchoredMorph
- ^ anchoredMorph!
Item was removed:
- ----- Method: TextAnchor>>anchoredMorph: (in category 'accessing') -----
- anchoredMorph: aMorph
- anchoredMorph := aMorph!
Item was removed:
- ----- Method: TextAnchor>>couldDeriveFromPrettyPrinting (in category 'accessing') -----
- couldDeriveFromPrettyPrinting
- ^ false!
Item was removed:
- ----- Method: TextAnchor>>emphasizeScanner: (in category 'visiting') -----
- emphasizeScanner: scanner
- "Do nothing for emphasizing the scanner - if the anchor is valid, a #embeddedObject will be encountered by the scanner and do the real thing"!
Item was removed:
- ----- Method: TextAnchor>>hash (in category 'comparing') -----
- hash
- "#hash is re-implemented because #= is re-implemented"
- ^anchoredMorph identityHash!
Item was removed:
- ----- Method: TextAnchor>>mayBeExtended (in category 'accessing') -----
- mayBeExtended
- "A textAnchor is designed to modify only a single character, and therefore must not be extended by the ParagraphEditor's emphasisHere facility"
- ^ false!
Item was removed:
- ----- Method: TextAnchor>>shoutShouldPreserve (in category 'testing') -----
- shoutShouldPreserve
-
- ^ true!
Item was removed:
- Object subclass: #TextAnchorProperties
- instanceVariableNames: 'padding verticalAlignmentLine verticalAlignmentMorph consumesHorizontalSpace relativePosition anchorLayout positionInDocument morphBaselineGetter'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Text Support'!
-
- !TextAnchorProperties commentStamp: 'pre 6/27/2019 18:29' prior: 0!
- A TextAnchorProperties describes the positioning of a morph in a text document included through a TextAnchor. The properties describe:
- - general alignment of the morph (e.g. within the line or relative to the document)
- - vertical alignment within a line
- - padding applied in addition to the vertical alignment
- - whether it consumes horizontal space when layouted inline
- !
Item was removed:
- ----- Method: TextAnchorProperties>>addTextAnchorMenuItems:hand:for: (in category 'menu') -----
- addTextAnchorMenuItems: topMenu hand: aHand for: aMorph
-
- | layoutTypeMenu anchorMenu morphAlignmentMenu lineAlignmentMenu |
- layoutTypeMenu := MenuMorph new defaultTarget: self.
- layoutTypeMenu
- addUpdating: #hasInlineAnchorString
- target: self
- selector: #toggleInlineAnchorIn:
- argumentList: {aMorph}.
- layoutTypeMenu
- addUpdating: #hasDocumentAnchorString
- target: self
- selector: #toggleDocumentAnchorIn:
- argumentList: {aMorph}.
-
- morphAlignmentMenu := MenuMorph new defaultTarget: self.
- #(morphAlignmentIsBottomString #bottom
- morphAlignmentIsBaselineString #baseline
- morphAlignmentIsCenterString #center
- morphAlignmentIsTopString #top) pairsDo: [:labelGetter :alignment |
- morphAlignmentMenu
- addUpdating: labelGetter
- target: self
- selector: #changeMorphAlignmentFor:to:
- argumentList: {aMorph . alignment}].
-
- lineAlignmentMenu := MenuMorph new defaultTarget: self.
- #(lineAlignmentIsBottomString #bottom
- lineAlignmentIsBaselineString #baseline
- lineAlignmentIsCenterString #center
- lineAlignmentIsTopString #top) pairsDo: [:labelGetter :alignment |
- lineAlignmentMenu
- addUpdating: labelGetter
- target: self
- selector: #changeLineAlignmentFor:to:
- argumentList: {aMorph . alignment}].
-
- anchorMenu := MenuMorph new defaultTarget: self.
- anchorMenu add: 'layout type' translated subMenu: layoutTypeMenu.
- anchorMenu add: 'morph vertical alignment' translated subMenu: morphAlignmentMenu.
- anchorMenu add: 'line vertical alignment' translated subMenu: lineAlignmentMenu.
-
- topMenu ifNotNil: [topMenu add: 'text anchor' translated subMenu: anchorMenu].
- ^ anchorMenu!
Item was removed:
- ----- Method: TextAnchorProperties>>anchorLayout (in category 'accessing') -----
- anchorLayout
- "See anchorLayout:"
-
- ^ anchorLayout ifNil: [self defaultAnchorLayout]!
Item was removed:
- ----- Method: TextAnchorProperties>>anchorLayout: (in category 'accessing') -----
- anchorLayout: aSymbolOrNil
- "Anchor layout determines how the morph is embedded into the text.
-
- document: The morph is placed relative to the complete document.
- The relative position is in relation to the document topLeft.
- inline: The moph is layouted inline. The position of the morph is
- determined through verticalAlignment and consumesHorizontalSpace."
-
- self assert: (#(document inline nil) includes: aSymbolOrNil).
- ^ anchorLayout := aSymbolOrNil!
Item was removed:
- ----- Method: TextAnchorProperties>>assertValidAlignment: (in category 'private') -----
- assertValidAlignment: aSymbol
- ^ #(top center baseline bottom) includes: aSymbol!
Item was removed:
- ----- Method: TextAnchorProperties>>changeLineAlignmentFor:to: (in category 'menu') -----
- changeLineAlignmentFor: aMorph to: aSymbol
-
- self verticalAlignmentLine: aSymbol.
- self updateOwnerOf: aMorph.!
Item was removed:
- ----- Method: TextAnchorProperties>>changeMorphAlignmentFor:to: (in category 'menu') -----
- changeMorphAlignmentFor: aMorph to: aSymbol
-
- self verticalAlignmentMorph: aSymbol.
- self updateOwnerOf: aMorph.!
Item was removed:
- ----- Method: TextAnchorProperties>>consumesHorizontalSpace (in category 'accessing') -----
- consumesHorizontalSpace
-
- ^ consumesHorizontalSpace ifNil: [true]!
Item was removed:
- ----- Method: TextAnchorProperties>>consumesHorizontalSpace: (in category 'accessing') -----
- consumesHorizontalSpace: aBoolean
-
- ^ consumesHorizontalSpace := aBoolean!
Item was removed:
- ----- Method: TextAnchorProperties>>defaultAnchorLayout (in category 'accessing') -----
- defaultAnchorLayout
-
- ^ #inline!
Item was removed:
- ----- Method: TextAnchorProperties>>defaultVerticalAlignment (in category 'default values') -----
- defaultVerticalAlignment
-
- ^ #(center center)!
Item was removed:
- ----- Method: TextAnchorProperties>>hasDocumentAnchorString (in category 'menu') -----
- hasDocumentAnchorString
-
- ^ (self anchorLayout == #document
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'document' translated!
Item was removed:
- ----- Method: TextAnchorProperties>>hasInlineAnchorString (in category 'menu') -----
- hasInlineAnchorString
-
- ^ (self anchorLayout == #inline
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'inline' translated!
Item was removed:
- ----- Method: TextAnchorProperties>>hasPositionInDocument (in category 'testing') -----
- hasPositionInDocument
-
- ^ self positionInDocument notNil!
Item was removed:
- ----- Method: TextAnchorProperties>>horizontalPadding (in category 'accessing - padding') -----
- horizontalPadding
-
- ^ self padding left + self padding right!
Item was removed:
- ----- Method: TextAnchorProperties>>lineAlignmentIsBaselineString (in category 'menu') -----
- lineAlignmentIsBaselineString
-
- ^ (self verticalAlignmentLine = #baseline
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'baseline' translated!
Item was removed:
- ----- Method: TextAnchorProperties>>lineAlignmentIsBottomString (in category 'menu') -----
- lineAlignmentIsBottomString
-
- ^ (self verticalAlignmentLine = #bottom
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'bottom' translated!
Item was removed:
- ----- Method: TextAnchorProperties>>lineAlignmentIsCenterString (in category 'menu') -----
- lineAlignmentIsCenterString
-
- ^ (self verticalAlignmentLine = #center
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'center' translated!
Item was removed:
- ----- Method: TextAnchorProperties>>lineAlignmentIsTopString (in category 'menu') -----
- lineAlignmentIsTopString
-
- ^ (self verticalAlignmentLine = #top
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'top' translated!
Item was removed:
- ----- Method: TextAnchorProperties>>morphAlignmentIsBaselineString (in category 'menu') -----
- morphAlignmentIsBaselineString
-
- ^ (self verticalAlignmentMorph = #baseline
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'baseline' translated!
Item was removed:
- ----- Method: TextAnchorProperties>>morphAlignmentIsBottomString (in category 'menu') -----
- morphAlignmentIsBottomString
-
- ^ (self verticalAlignmentMorph = #bottom
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'bottom' translated!
Item was removed:
- ----- Method: TextAnchorProperties>>morphAlignmentIsCenterString (in category 'menu') -----
- morphAlignmentIsCenterString
-
- ^ (self verticalAlignmentMorph = #center
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'center' translated!
Item was removed:
- ----- Method: TextAnchorProperties>>morphAlignmentIsTopString (in category 'menu') -----
- morphAlignmentIsTopString
-
- ^ (self verticalAlignmentMorph = #top
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'top' translated!
Item was removed:
- ----- Method: TextAnchorProperties>>morphBaselineGetter (in category 'accessing') -----
- morphBaselineGetter
-
- ^ morphBaselineGetter!
Item was removed:
- ----- Method: TextAnchorProperties>>morphBaselineGetter: (in category 'accessing') -----
- morphBaselineGetter: aSymbol
- "This sets the callback send to the anchored morph to determine the baseline
- of the morph. The baseline should be the distance from the top of the anchored
- morph. This can be used, e.g. when having formula morphs inside a text."
-
- morphBaselineGetter := aSymbol!
Item was removed:
- ----- Method: TextAnchorProperties>>padding (in category 'accessing - padding') -----
- padding
-
- ^ padding ifNil: [0 at 0 corner: 0 at 0]!
Item was removed:
- ----- Method: TextAnchorProperties>>padding: (in category 'accessing - padding') -----
- padding: numberOrPointOrRectangle
-
- | newPadding |
- newPadding := numberOrPointOrRectangle.
- newPadding isPoint ifTrue: [
- newPadding := newPadding corner: newPadding].
- newPadding isNumber ifTrue: [
- newPadding := newPadding at newPadding corner: newPadding at newPadding].
- ^ padding := newPadding!
Item was removed:
- ----- Method: TextAnchorProperties>>positionInDocument (in category 'accessing') -----
- positionInDocument
-
- ^ positionInDocument!
Item was removed:
- ----- Method: TextAnchorProperties>>positionInDocument: (in category 'accessing') -----
- positionInDocument: aPoint
- "See anchorLayout:"
-
- ^ positionInDocument := aPoint!
Item was removed:
- ----- Method: TextAnchorProperties>>toggleDocumentAnchorIn: (in category 'menu') -----
- toggleDocumentAnchorIn: aMorph
- "Change the anchor from/to document anchoring"
-
- | newType |
- newType := self anchorLayout == #document
- ifTrue: [#inline]
- ifFalse: [ #document].
- self anchorLayout: newType.
- self updateOwnerOf: aMorph.
- !
Item was removed:
- ----- Method: TextAnchorProperties>>toggleInlineAnchorIn: (in category 'menu') -----
- toggleInlineAnchorIn: aMorph
- "Change the anchor from/to line anchoring"
-
- | newType |
- newType := self anchorLayout == #inline
- ifTrue: [#document]
- ifFalse: [#inline].
- self anchorLayout: newType.
- self updateOwnerOf: aMorph.!
Item was removed:
- ----- Method: TextAnchorProperties>>updateOwnerOf: (in category 'private') -----
- updateOwnerOf: aMorph
-
- aMorph owner isTextMorph ifTrue: [
- aMorph owner
- anchorMorph: aMorph
- at: aMorph position
- type: self anchorLayout] !
Item was removed:
- ----- Method: TextAnchorProperties>>verticalAlignment: (in category 'accessing') -----
- verticalAlignment: symbolOrTuple
- "This method accepts tuples in which the first element designates
- which part of the morph is aligned to which part of the text line which
- the second element designates.
-
- morph baseline allows for the morph to set its own baseline (see morphBaselineGetter:)"
- symbolOrTuple isSymbol
- ifTrue:
- [ self
- verticalAlignmentMorph: symbolOrTuple;
- verticalAlignmentLine: symbolOrTuple ]
- ifFalse:
- [ self
- verticalAlignmentMorph: symbolOrTuple first ;
- verticalAlignmentLine: symbolOrTuple second ]!
Item was removed:
- ----- Method: TextAnchorProperties>>verticalAlignmentLine (in category 'accessing') -----
- verticalAlignmentLine
- "The vertical position within the line of text where the anchor point of the morph, specified by #verticalAlignmentMorph, should be attached."
-
- ^ verticalAlignmentLine ifNil: [ #center ]!
Item was removed:
- ----- Method: TextAnchorProperties>>verticalAlignmentLine: (in category 'accessing') -----
- verticalAlignmentLine: aSymbol
- "The vertical position within the line of text where the anchor point of the morph, specified by #verticalAlignmentMorph, should be attached."
-
- self assertValidAlignment: aSymbol.
- verticalAlignmentLine := aSymbol!
Item was removed:
- ----- Method: TextAnchorProperties>>verticalAlignmentMorph (in category 'accessing') -----
- verticalAlignmentMorph
- "The vertical position of the embedded Morph where it anchors to a line of text, its position within that line specified by #verticalAlignmentLine.."
-
- ^ verticalAlignmentMorph ifNil: [ #center ]!
Item was removed:
- ----- Method: TextAnchorProperties>>verticalAlignmentMorph: (in category 'accessing') -----
- verticalAlignmentMorph: aSymbol
- "The vertical position of the embedded Morph where it anchors to a line of text, its position within that line specified by #verticalAlignmentLine.."
-
- self assertValidAlignment: aSymbol.
- verticalAlignmentMorph := aSymbol!
Item was removed:
- ----- Method: TextAnchorProperties>>verticalPadding (in category 'accessing - padding') -----
- verticalPadding
-
- self verticalAlignmentMorph = #top ifTrue: [^ self padding top].
- self verticalAlignmentMorph = #bottom ifTrue: [^ self padding bottom].
- ^ 0!
Item was removed:
- Object subclass: #TextContainer
- instanceVariableNames: 'textMorph shadowForm vertProfile minWidth rectangleCache fillsOwner avoidsOcclusions'
- classVariableNames: 'OuterMargin'
- poolDictionaries: ''
- category: 'Morphic-Text Support'!
-
- !TextContainer commentStamp: '<historical>' prior: 0!
- A TextContainer models the shape of an ownerMorph, possibly occluded by one or more occludingMorphs, and scans this shape to provide a list of rectangles suitable for layout of text. It does this by displaying the shadow of the ownerMorph in black, and any occludingMorphs in white, on its shadowForm. It then scans horizontal strips of appropriate height to find unbroken intervals of black, greater than minWidth in extent. Conputation of the rectangles is done on demand, and results are cached so that text can be redisplayed without having to recompute the rectangles.!
Item was removed:
- ----- Method: TextContainer class>>initialize (in category 'class initialization') -----
- initialize "TextContainer initialize"
- OuterMargin := 2!
Item was removed:
- ----- Method: TextContainer>>avoidsOcclusions (in category 'access') -----
- avoidsOcclusions
- ^ avoidsOcclusions ifNil: [false]!
Item was removed:
- ----- Method: TextContainer>>avoidsOcclusions: (in category 'access') -----
- avoidsOcclusions: aBoolean
- avoidsOcclusions := aBoolean.
- self releaseCachedState!
Item was removed:
- ----- Method: TextContainer>>bottom (in category 'container protocol') -----
- bottom
- "Note we should really check for contiguous pixels here"
- ^ (self vertProfile findLast: [:count | count >= minWidth])
- + shadowForm offset y!
Item was removed:
- ----- Method: TextContainer>>bounds (in category 'private') -----
- bounds
- | bounds theText |
- self fillsOwner ifFalse: [^ textMorph textBounds].
- theText := textMorph.
- bounds := theText owner innerBounds.
- bounds := bounds insetBy: (textMorph valueOfProperty: #margins ifAbsent: [1 at 1]).
- theText owner submorphsBehind: theText do:
- [:m | bounds swallow: m fullBounds].
- ^ bounds!
Item was removed:
- ----- Method: TextContainer>>computeShadow (in category 'private') -----
- computeShadow
- | canvas bounds theText |
- bounds := self bounds.
- theText := textMorph.
- canvas := (Display defaultCanvasClass extent: bounds extent depth: 1)
- shadowColor: Color black.
- canvas translateBy: bounds topLeft negated during:[:tempCanvas| | back |
- self fillsOwner
- ifTrue: [tempCanvas fullDrawMorph: (theText owner copyWithoutSubmorph: theText)]
- ifFalse: [tempCanvas fillRectangle: textMorph bounds color: Color black].
- self avoidsOcclusions ifTrue:
- [back := tempCanvas form deepCopy.
- tempCanvas form fillWhite.
- theText owner submorphsInFrontOf: theText do:
- [:m | (textMorph isLinkedTo: m)
- ifTrue: []
- ifFalse: [tempCanvas fullDrawMorph: m]].
- back displayOn: tempCanvas form at: 0 at 0 rule: Form reverse].
- ].
- shadowForm := canvas form offset: bounds topLeft.
- vertProfile := shadowForm yTallyPixelValue: 1 orNot: false.
- rectangleCache := Dictionary new.
- ^ shadowForm!
Item was removed:
- ----- Method: TextContainer>>fillsOwner (in category 'access') -----
- fillsOwner
- ^ fillsOwner ifNil: [true]!
Item was removed:
- ----- Method: TextContainer>>fillsOwner: (in category 'access') -----
- fillsOwner: aBoolean
- fillsOwner := aBoolean.
- self releaseCachedState!
Item was removed:
- ----- Method: TextContainer>>for:minWidth: (in category 'private') -----
- for: aTextMorph minWidth: wid
- textMorph := aTextMorph.
- minWidth := wid.
- fillsOwner := true.
- avoidsOcclusions := false.!
Item was removed:
- ----- Method: TextContainer>>left (in category 'container protocol') -----
- left
- ^ textMorph owner left!
Item was removed:
- ----- Method: TextContainer>>paragraphClass (in category 'access') -----
- paragraphClass
- ^ NewParagraph!
Item was removed:
- ----- Method: TextContainer>>rectanglesAt:height: (in category 'container protocol') -----
- rectanglesAt: lineY height: lineHeight
- "Return a list of rectangles that are at least minWidth wide
- in the specified horizontal strip of the shadowForm.
- Cache the results for later retrieval if the owner does not change."
-
- | hProfile rects thisWidth thisX count pair outerWidth lineRect lineForm |
- pair := Array with: lineY with: lineHeight.
- rects := rectangleCache at: pair ifAbsent: [nil].
- rects ifNotNil: [^rects].
- outerWidth := minWidth + (2 * OuterMargin).
- self shadowForm. "Compute the shape"
- lineRect := 0 @ (lineY - shadowForm offset y)
- extent: shadowForm width @ lineHeight.
- lineForm := shadowForm copy: lineRect.
-
- "Check for a full line -- frequent case"
- (lineForm tallyPixelValues second) = lineRect area
- ifTrue:
- [rects := Array with: (shadowForm offset x @ lineY extent: lineRect extent)]
- ifFalse:
- ["No such luck -- scan the horizontal profile for segments of minWidth"
-
- hProfile := lineForm xTallyPixelValue: 1 orNot: false.
- rects := OrderedCollection new.
- thisWidth := 0.
- thisX := 0.
- 1 to: hProfile size
- do:
- [:i |
- count := hProfile at: i.
- count >= lineHeight
- ifTrue: [thisWidth := thisWidth + 1]
- ifFalse:
- [thisWidth >= outerWidth
- ifTrue:
- [rects addLast: ((thisX + shadowForm offset x) @ lineY
- extent: thisWidth @ lineHeight)].
- thisWidth := 0.
- thisX := i]].
- thisWidth >= outerWidth
- ifTrue:
- [rects addLast: ((thisX + shadowForm offset x) @ lineY
- extent: thisWidth @ lineHeight)]].
- rects := rects collect: [:r | r insetBy: OuterMargin @ 0].
- rectangleCache at: pair put: rects.
- ^rects!
Item was removed:
- ----- Method: TextContainer>>releaseCachedState (in category 'access') -----
- releaseCachedState
-
- shadowForm := nil.
- vertProfile := nil.
- rectangleCache := Dictionary new.
- !
Item was removed:
- ----- Method: TextContainer>>shadowForm (in category 'private') -----
- shadowForm
- shadowForm ifNil: [self computeShadow].
- ^ shadowForm!
Item was removed:
- ----- Method: TextContainer>>textMorph (in category 'access') -----
- textMorph
- ^ textMorph!
Item was removed:
- ----- Method: TextContainer>>top (in category 'container protocol') -----
- top
- "Note we should really check for contiguous pixels here"
- | outerWidth |
- outerWidth := minWidth + (2*OuterMargin).
- ^ (self vertProfile findFirst: [:count | count >= outerWidth]) - 1
- + shadowForm offset y!
Item was removed:
- ----- Method: TextContainer>>topLeft (in category 'container protocol') -----
- topLeft "for compatibility"
- ^ textMorph owner topLeft!
Item was removed:
- ----- Method: TextContainer>>translateBy: (in category 'container protocol') -----
- translateBy: delta
- self releaseCachedState!
Item was removed:
- ----- Method: TextContainer>>vertProfile (in category 'private') -----
- vertProfile
- vertProfile ifNil: [self computeShadow].
- ^ vertProfile!
Item was removed:
- ----- Method: TextContainer>>width (in category 'container protocol') -----
- width "for compatibility"
- ^ textMorph owner width!
Item was removed:
- Editor subclass: #TextEditor
- instanceVariableNames: 'model paragraph markBlock pointBlock beginTypeInIndex emphasisHere lastParenLocation otherInterval oldInterval typeAhead history'
- classVariableNames: 'AutoEnclose AutoIndent ChangeText EncloseSelection FindText InteractivePrintIt'
- poolDictionaries: ''
- category: 'Morphic-Text Support'!
- TextEditor class
- instanceVariableNames: 'cmdActions shiftCmdActions yellowButtonMenu shiftedYellowButtonMenu'!
-
- !TextEditor commentStamp: '<historical>' prior: 0!
- See comment in Editor.
-
- My instances edit Text, this is, they support multiple lines and TextAttributes.
- They have no specific facilities for editing Smalltalk code. Those are found in SmalltalkEditor.!
- TextEditor class
- instanceVariableNames: 'cmdActions shiftCmdActions yellowButtonMenu shiftedYellowButtonMenu'!
Item was removed:
- ----- Method: TextEditor class>>abandonChangeText (in category 'class initialization') -----
- abandonChangeText
- "Call this to get out of the maddening situation in which the system keeps aggressively trying to do a replacement that you no longer wish to make, every time you make choose a new method in a list."
- ChangeText := FindText
-
- "
- TextEditor abandonChangeText
- "!
Item was removed:
- ----- Method: TextEditor class>>autoEnclose (in category 'preferences') -----
- autoEnclose
- <preference: 'Auto enclose brackets () {} []'
- categoryList: #('Morphic' 'editing')
- description: 'When true, typing an opening parenthesis, bracket or square-bracket will also add its corresponding closing character after the cursor so you can type within the bracket.'
- type: #Boolean>
-
- ^ AutoEnclose ifNil: [ true ]!
Item was removed:
- ----- Method: TextEditor class>>autoEnclose: (in category 'preferences') -----
- autoEnclose: aBoolean
- AutoEnclose := aBoolean!
Item was removed:
- ----- Method: TextEditor class>>autoIndent (in category 'preferences') -----
- autoIndent
- <preference: 'Auto indent on new line'
- categoryList: #('Morphic' 'editing')
- description: 'When true, tabs will be inserted after pressing Enter | Return such that the new line will be indented equally with the previous line.'
- type: #Boolean>
- ^ AutoIndent ifNil: [ true ]!
Item was removed:
- ----- Method: TextEditor class>>autoIndent: (in category 'preferences') -----
- autoIndent: aBoolean
- AutoIndent := aBoolean!
Item was removed:
- ----- Method: TextEditor class>>cleanUp (in category 'class initialization') -----
- cleanUp
-
- TextEditor allSubInstancesDo: [:editor |
- editor history ifNotNil: [:h |
- h current ifNotNil: [editor closeTypeIn].
- h reset]].!
Item was removed:
- ----- Method: TextEditor class>>cmdActions (in category 'accessing') -----
- cmdActions
- ^cmdActions!
Item was removed:
- ----- Method: TextEditor class>>encloseSelection (in category 'preferences') -----
- encloseSelection
- <preference: 'Enclose selection with brackets () {} [] '''' "" || <>'
- categoryList: #('Morphic' 'editing')
- description: 'When true, selecting text and typing an opening parenthesis, bracket, square-bracket, single quote, or double quote will add corresponding character around the selection without requiring a cmd key.'
- type: #Boolean>
-
- ^ EncloseSelection ifNil: [ true ]!
Item was removed:
- ----- Method: TextEditor class>>encloseSelection: (in category 'preferences') -----
- encloseSelection: boolean
-
- EncloseSelection := boolean.!
Item was removed:
- ----- Method: TextEditor class>>initialize (in category 'class initialization') -----
- initialize
- "Initialize the keyboard shortcut maps and the shared buffers
- for copying text across views and managing again and undo."
-
- "TextEditor initialize"
-
- FindText := ChangeText := Text new.
-
- self initializeCmdKeyShortcuts.
- self initializeShiftCmdKeyShortcuts.
- self initializeYellowButtonMenu.
- self initializeShiftedYellowButtonMenu!
Item was removed:
- ----- Method: TextEditor class>>initializeCmdKeyShortcuts (in category 'keyboard shortcut tables') -----
- initializeCmdKeyShortcuts
- "Initialize the (unshifted) command-key (or alt-key) shortcut table."
-
- "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest"
-
- "TextEditor initialize"
-
- | cmdMap cmds |
- cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash"
- cmdMap at: 1 + 1 put: #cursorHome:. "home key"
- cmdMap at: 4 + 1 put: #cursorEnd:. "end key"
- cmdMap at: 8 + 1 put: #backspace:. "ctrl-H or delete key"
- cmdMap at: 11 + 1 put: #cursorPageUp:. "page up key"
- cmdMap at: 12 + 1 put: #cursorPageDown:. "page down key"
- cmdMap at: 13 + 1 put: #crWithIndent:. "cmd-Return"
- cmdMap at: 27 + 1 put: #offerMenuFromEsc:. "escape key"
- cmdMap at: 28 + 1 put: #cursorLeft:. "left arrow key"
- cmdMap at: 29 + 1 put: #cursorRight:. "right arrow key"
- cmdMap at: 30 + 1 put: #cursorUp:. "up arrow key"
- cmdMap at: 31 + 1 put: #cursorDown:. "down arrow key"
- cmdMap at: 32 + 1 put: #selectWord:. "space bar key"
- cmdMap at: 127 + 1 put: #forwardDelete:. "del key"
-
- '0123456789'
- do: [:char | cmdMap at: char asciiValue + 1 put: #changeEmphasis:].
-
- cmds := #($a #selectAll: $c #copySelection: $e #exchange: $f #find: $g #findAgain: $j #doAgain: $k #offerFontMenu: $u #align: $v #paste: $w #backWord: $x #cut: $y #swapChars: $z #undo:).
- 1 to: cmds size
- by: 2
- do: [:i | cmdMap at: (cmds at: i) asciiValue + 1 put: (cmds at: i + 1)].
-
- cmdActions := cmdMap!
Item was removed:
- ----- Method: TextEditor class>>initializeShiftCmdKeyShortcuts (in category 'keyboard shortcut tables') -----
- initializeShiftCmdKeyShortcuts
- "Initialize the shift-command-key (or control-key) shortcut table."
- "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest"
- "wod 11/3/1998: Fix setting of cmdMap for shifted keys to actually use the
- capitalized versions of the letters.
- TPR 2/18/99: add the plain ascii values back in for those VMs that don't return the shifted values."
-
- "TextEditor initialize"
-
- | cmdMap cmds |
-
- "shift-command and control shortcuts"
- cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash"
- cmdMap at: ( 1 + 1) put: #cursorHome:. "home key"
- cmdMap at: ( 4 + 1) put: #cursorEnd:. "end key"
- cmdMap at: ( 8 + 1) put: #forwardDelete:. "ctrl-H or delete key"
- cmdMap at: (11 + 1) put: #cursorPageUp:. "page up key"
- cmdMap at: (12 + 1) put: #cursorPageDown:. "page down key"
- cmdMap at: (13 + 1) put: #crWithIndent:. "ctrl-Return"
- cmdMap at: (27 + 1) put: #offerMenuFromEsc:. "escape key"
- cmdMap at: (28 + 1) put: #cursorLeft:. "left arrow key"
- cmdMap at: (29 + 1) put: #cursorRight:. "right arrow key"
- cmdMap at: (30 + 1) put: #cursorUp:. "up arrow key"
- cmdMap at: (31 + 1) put: #cursorDown:. "down arrow key"
- cmdMap at: (32 + 1) put: #selectWord:. "space bar key"
- cmdMap at: (45 + 1) put: #changeEmphasis:. "cmd-sh-minus"
- cmdMap at: (61 + 1) put: #changeEmphasis:. "cmd-sh-plus"
- cmdMap at: (127 + 1) put: #forwardDelete:. "del key"
-
- cmds := #(
- $c compareToClipboard:
- $h cursorTopHome:
- $j doAgainUpToEnd:
- $k changeStyle:
- $m selectCurrentTypeIn:
- $s findAgain:
- $u changeLfToCr:
- $x makeLowercase:
- $y makeUppercase:
- $z redo: "makeCapitalized:"
- ).
- 1 to: cmds size by: 2 do: [ :i |
- cmdMap at: ((cmds at: i) asciiValue + 1) put: (cmds at: i + 1). "plain keys"
- cmdMap at: ((cmds at: i) asciiValue - 32 + 1) put: (cmds at: i + 1). "shifted keys"
- cmdMap at: ((cmds at: i) asciiValue - 96 + 1) put: (cmds at: i + 1). "ctrl keys"
- ].
- shiftCmdActions := cmdMap!
Item was removed:
- ----- Method: TextEditor class>>initializeShiftedYellowButtonMenu (in category 'keyboard shortcut tables') -----
- initializeShiftedYellowButtonMenu
- "Initialize the yellow button pop-up menu and corresponding messages."
-
- "TextEditor initialize"
- "
- shiftedYellowButtonMenu := {
- {'set font... (k)' translated. #offerFontMenu}.
- {'set style... (K)' translated. #changeStyle}.
- {'set alignment...' translated. #chooseAlignment}.
- #-.
- {'more...' translated. #yellowButtonActivity}.
- }
- "
- shiftedYellowButtonMenu := yellowButtonMenu!
Item was removed:
- ----- Method: TextEditor class>>initializeYellowButtonMenu (in category 'keyboard shortcut tables') -----
- initializeYellowButtonMenu
- "Initialize the yellow button pop-up menu and corresponding messages."
-
- "TextEditor initialize"
-
- yellowButtonMenu := MenuMorph fromArray: {
- {'find...(f)' translated. #find}.
- {'find again (g)' translated. #findAgain}.
- {'find and replace ...' translated. #findReplace}.
- {'do/replace again (j)' translated. #again}.
- #-.
- {'undo (z)' translated. #undo}.
- {'redo (Z)' translated. #redo}.
- #-.
- {'copy (c)' translated. #copySelection}.
- {'cut (x)' translated. #cut}.
- {'paste (v)' translated. #paste}.
- {'paste...' translated. #pasteRecent}.
- #-.
- {'set font... (k)' translated. #offerFontMenu}.
- {'set style... (K)' translated. #changeStyle}.
- {'set alignment...' translated. #chooseAlignment}.
- "
- #-.
- {'more...' translated. #shiftedTextPaneMenuRequest}.
- "
- }!
Item was removed:
- ----- Method: TextEditor class>>interactivePrintIt (in category 'preferences') -----
- interactivePrintIt
- <preference: 'Interactive print-it'
- categoryList: #('Tools' 'Morphic')
- description: 'When true, print-it styles the inserted printString to work as interactive link to an inspector. Just click on it.'
- type: #Boolean>
-
- ^ InteractivePrintIt ifNil: [ true ]!
Item was removed:
- ----- Method: TextEditor class>>interactivePrintIt: (in category 'preferences') -----
- interactivePrintIt: aBoolean
-
- InteractivePrintIt := aBoolean.!
Item was removed:
- ----- Method: TextEditor class>>resetAllHistory (in category 'class initialization') -----
- resetAllHistory
-
- TextEditor allSubInstances do: [:editor |
- editor history reset].
-
- !
Item was removed:
- ----- Method: TextEditor class>>shiftCmdActions (in category 'accessing') -----
- shiftCmdActions
- ^shiftCmdActions!
Item was removed:
- ----- Method: TextEditor class>>shiftedYellowButtonMenu (in category 'class initialization') -----
- shiftedYellowButtonMenu
- "Answer the menu to be presented when the yellow button is pressed while the shift key is down"
-
- ^ shiftedYellowButtonMenu!
Item was removed:
- ----- Method: TextEditor class>>yellowButtonMenu (in category 'class initialization') -----
- yellowButtonMenu
-
- ^ yellowButtonMenu!
Item was removed:
- ----- Method: TextEditor>>abandonChangeText (in category 'editing keys') -----
- abandonChangeText
- ^self class abandonChangeText!
Item was removed:
- ----- Method: TextEditor>>accept (in category 'menu messages') -----
- accept
- "Save the current text of the text being edited as the current acceptable version for purposes of canceling. Allow my morph to take appropriate action"
- morph acceptContents!
Item was removed:
- ----- Method: TextEditor>>addString: (in category 'typing support') -----
- addString: aString
-
- morph readOnly ifTrue: [^ self].
-
- "If we modifying the text like backward or forward delete, we have to finish that operation."
- (self isTypingIn and: [self history current type notNil])
- ifTrue: [self closeTypeIn].
-
- self typeAhead nextPutAll: aString.!
Item was removed:
- ----- Method: TextEditor>>addText:event: (in category 'editing dragdrop') -----
- addText: aText event: anEvent
- "Used for dropping/inserting text."
-
- | index |
- index := (paragraph characterBlockAtPoint: anEvent position) stringIndex.
- self closeTypeIn.
-
- self selectInvisiblyFrom: index to: index-1.
- self replaceSelectionWith: aText.!
Item was removed:
- ----- Method: TextEditor>>afterSelectionInsertAndSelect: (in category 'new selection') -----
- afterSelectionInsertAndSelect: aStringOrText
-
- self insertAndSelect: aStringOrText at: self stopIndex !
Item was removed:
- ----- Method: TextEditor>>again (in category 'menu messages') -----
- again
- "Do the same find/replace command again. Looks up the editor's own command history and uses the previous command to determine find string and replace string."
-
- self history hasReplacedSomething
- ifFalse: [morph flash. ^ false].
-
- self
- setSearchFromSelectionOrHistory;
- setReplacementFromHistory.
-
- "If we have no selection, give the user one to avoid annoying surprises."
- ^ self hasSelection
- ifTrue: [self findReplaceAgainNow]
- ifFalse: [self findAgainNow. false "see #againUpToEnd"]!
Item was removed:
- ----- Method: TextEditor>>againUpToEnd (in category 'menu messages') -----
- againUpToEnd
- "Find and replace until the end."
-
- | first |
- self again ifFalse: [^ self].
-
- first := self history previous.
-
- [self hasSelection] whileTrue: [
- self history previous
- isCompositeUndo: true;
- isCompositeRedo: true.
- self findReplaceAgainNow].
-
- first isCompositeUndo: false.
-
- self history previous isCompositeUndo: first ~~ self history previous.
- self history previous isCompositeRedo: false.!
Item was removed:
- ----- Method: TextEditor>>align (in category 'menu messages') -----
- align
- "Align text according to the next greater alignment value,
- cycling among leftFlush, rightFlush, center, and justified."
- self changeAlignment.
- self recomputeSelection!
Item was removed:
- ----- Method: TextEditor>>align: (in category 'editing keys') -----
- align: aKeyboardEvent
- "Triggered by Cmd-u; cycle through alignment alternatives. 8/11/96 sw"
-
- self align.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>applyAttribute: (in category 'private') -----
- applyAttribute: aTextAttribute
- "The user selected aTextAttribute via shortcut, menu or other means.
- If there is a selection, apply the attribute to the selection.
- In any case use the attribute for the user input (emphasisHere)"
- | interval |
-
- emphasisHere := Text addAttribute: aTextAttribute toArray: emphasisHere.
-
- interval := self selectionInterval.
- (interval isEmpty and: [ aTextAttribute isParagraphAttribute not ])
- ifTrue: [ ^self ].
-
- self text addAttribute: aTextAttribute from: interval first to: interval last.
- paragraph recomposeFrom: interval first to: interval last delta: 0.
- self recomputeSelection. "Needed so visible selection is updated to reflect new visual extent of selection"
- morph changed!
Item was removed:
- ----- Method: TextEditor>>argAdvance: (in category 'typing/selecting keys') -----
- argAdvance: aKeyboardEvent
- "Invoked by Ctrl-a or Shift+Command+A. Useful after Ctrl-q.
- Search forward from the end of the selection for a colon and place the caret after it. If no colon is found, do nothing."
- | start |
- self insertAndCloseTypeIn.
- start := paragraph text
- findString: ':'
- startingAt: self stopIndex.
- start isZero ifFalse: [ self selectAt: start + 1 ].
- ^ true!
Item was removed:
- ----- Method: TextEditor>>autoEncloseFor: (in category 'typing support') -----
- autoEncloseFor: typedChar
- "Answer whether typeChar was handled by auto-enclosure. Caller should call normalCharacter if not."
- | openers closers next |
- openers := '([{'.
- closers := ')]}'.
- next := self string at: self startIndex ifAbsent: nil.
- (closers includes: typedChar) ifTrue:
- [ | pos |
- (next isNil or: [next = typedChar]) ifFalse: [ ^ false ].
- self blinkPrevParen: typedChar.
- ((pos := self indexOfNextNonwhitespaceCharacter) notNil and: [ (paragraph string at: pos) = typedChar ])
- ifTrue:
- [ self
- moveCursor: [ : position | position + pos - pointBlock stringIndex + 1 ]
- forward: true
- select: false.
- ^ true ]
- ifFalse: [ ^ false ] ].
- (openers includes: typedChar) ifTrue:
- [ (self hasSelection or: [next isNil or: [next isSeparator or: [closers includes: next]]]) ifFalse: [ ^ false ].
- self
- openTypeIn;
- addString: typedChar asString;
- addString: (closers at: (openers indexOf: typedChar)) asString;
- insertAndCloseTypeIn;
-
- moveCursor: [ : position | position - 1 ]
- forward: false
- select: false.
- ^ true ].
- ^ false!
Item was removed:
- ----- Method: TextEditor>>backTo: (in category 'typing support') -----
- backTo: startIndex
- "During typing, backspace to startIndex. If there already is a selection, just delete that selection. Otherwise, check if we did something else than backward-deletion and start a new command if so."
-
- morph readOnly ifTrue: [^ false].
-
- self hasSelection ifTrue: [
- "Add checkpoint in undo history."
- self replaceSelectionWith: self nullText.
- ^ true].
-
- startIndex > self text size ifTrue: [^ false].
-
- self selectInvisiblyFrom: startIndex to: self stopIndex-1.
-
- self isTypingIn ifTrue: [
- self history current type = #backward
- ifFalse: [self closeTypeIn]
- ifTrue: [
- "Accumulate all deleted characters in current undo command."
- self history current contentsBefore replaceFrom: 1 to: 0 with: self selection.
- self history current intervalBefore in: [:i |
- self history current intervalBefore: (startIndex to: i last)]]].
-
- self openTypeInFor: #backward.
- self zapSelectionWith: self nullText.
-
- ^ false!
Item was removed:
- ----- Method: TextEditor>>beginningOfLine: (in category 'private') -----
- beginningOfLine: position
- "Redefined in subclasses using Paragraph support"
- ^ (paragraph lines at:(paragraph lineIndexOfCharacterIndex: position)) first!
Item was removed:
- ----- Method: TextEditor>>bindingOf: (in category 'binding') -----
- bindingOf: aString
- ^model bindingOf: aString!
Item was removed:
- ----- Method: TextEditor>>blinkParen (in category 'parenblinking') -----
- blinkParen
- "Used if Shout"
- lastParenLocation ifNotNil: [
- self text string size >= lastParenLocation ifTrue: [
- self text
- addAttribute: TextEmphasis bold
- from: lastParenLocation
- to: lastParenLocation]]!
Item was removed:
- ----- Method: TextEditor>>blinkParenAt: (in category 'parenblinking') -----
- blinkParenAt: parenLocation
- self text
- addAttribute: TextEmphasis bold
- from: parenLocation
- to: parenLocation.
- lastParenLocation := parenLocation.!
Item was removed:
- ----- Method: TextEditor>>blinkPrevParen: (in category 'parenblinking') -----
- blinkPrevParen: aCharacter
- "Used if not Shout"
- | openDelimiter closeDelimiter level string here hereChar |
- string := paragraph string.
- here := pointBlock stringIndex.
- openDelimiter := aCharacter.
- closeDelimiter := '([{' at: (')]}' indexOf: openDelimiter).
- level := 1.
- [level > 0 and: [here > 1]]
- whileTrue:
- [hereChar := string at: (here := here - 1).
- hereChar = closeDelimiter
- ifTrue:
- [level := level - 1.
- level = 0
- ifTrue: [^ self blinkParenAt: here]]
- ifFalse:
- [hereChar = openDelimiter
- ifTrue: [level := level + 1]]]!
Item was removed:
- ----- Method: TextEditor>>browseChangeSetsWithSelector (in category 'menu messages') -----
- browseChangeSetsWithSelector
- "Determine which, if any, change sets have at least one change for the selected selector, independent of class"
-
- | aSelector |
- self lineSelectAndEmptyCheck: [^ self].
- (aSelector := self selectedSelector) == nil ifTrue: [^ morph flash].
- ChangeSorter browseChangeSetsWithSelector: aSelector!
Item was removed:
- ----- Method: TextEditor>>browseClassFromIt (in category 'menu messages') -----
- browseClassFromIt
- "Launch a hierarchy browser for the class indicated by the current selection. If multiple classes matching the selection exist, let the user choose among them."
- | aClass |
- self lineSelectAndEmptyCheck: [ ^ self ].
- aClass := UIManager default
- classFromPattern: self selection string withBlanksTrimmed
- withCaption: 'choose a class to browse...'
- in: model environment.
- aClass ifNil: [ ^ morph flash ].
- self systemNavigation
- spawnHierarchyForClass: aClass
- selector: nil!
Item was removed:
- ----- Method: TextEditor>>browseIt (in category 'menu messages') -----
- browseIt
- "Launch a browser for the current selection, if appropriate."
-
- Preferences alternativeBrowseIt ifTrue: [^ self browseClassFromIt].
-
- self lineSelectAndEmptyCheck: [^ morph flash].
-
- "First, try to show all accesses to instance or class variables."
- self selectedInstanceVariable ifNotNil:
- [:nameToClass | self systemNavigation
- browseAllAccessesTo: nameToClass key
- from: nameToClass value].
- self selectedClassVariable ifNotNil:
- [:binding | self model browseAllCallsOn: binding].
-
- "Then, either browse the class (from a binding) or all implementors of a selector."
- self selectedBinding ifNotNil:
- [:binding | ^ self systemNavigation browseClass: binding].
- self selectedSelector ifNotNil:
- [:selector | ^ self model browseAllImplementorsOf: selector requestor: morph].
-
- morph flash!
Item was removed:
- ----- Method: TextEditor>>browseIt: (in category 'editing keys') -----
- browseIt: aKeyboardEvent
- "Triggered by Cmd-B; browse the thing represented by the current selection, if plausible. 1/18/96 sw"
-
- self browseIt.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>browseItHere (in category 'menu messages') -----
- browseItHere
- "Retarget the receiver's window to look at the selected class, if appropriate."
-
- self wordSelectAndEmptyCheck: [^ morph flash].
-
- ((model isKindOf: Browser) and: [model couldBrowseAnyClass])
- ifFalse: [^ morph flash].
- model okToChange
- ifFalse: [^ morph flash].
-
- self selectedSymbol ifNotNil: [:symbol |
- (model environment classNamed: symbol) ifNotNil: [:class |
- ^ model setClass: class]].
-
- morph flash!
Item was removed:
- ----- Method: TextEditor>>browseItHere: (in category 'editing keys') -----
- browseItHere: aKeyboardEvent
- "Triggered by Cmd-shift-B; browse the thing represented by the current selection, if plausible, in the receiver's own window. 3/1/96 sw"
-
- self browseItHere.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>cancel (in category 'menu messages') -----
- cancel
- "Cancel the changes made so far to this text in a safe way, so that the user can undo this operation."
-
- morph cancelEditsSafely.!
Item was removed:
- ----- Method: TextEditor>>cancel: (in category 'editing keys') -----
- cancel: aKeyboardEvent
- "Cancel unsubmitted changes."
-
- self cancel.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>changeAlignment (in category 'menu messages') -----
- changeAlignment
- | options reply |
- options := self existingIndentation
- caseOf:
- {[0]-> [ #('leftFlush' 'indented' 'centered' 'justified' 'rightFlush') ].
- [1] -> [ #('leftFlush' 'indented more' 'centered' 'justified' 'rightFlush') ]}
- otherwise: [ #('leftFlush' 'indented less' 'indented more' 'centered' 'justified' 'rightFlush') ].
- reply := UIManager default chooseFrom: options values: options.
- reply ifNil: [ ^ self ].
- self setAlignment: reply.
- paragraph composeAll.
- self recomputeSelection.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>changeEmphasis: (in category 'editing keys') -----
- changeEmphasis: aKeyboardEvent
- "Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change. Keeps typeahead."
-
- "[cmd]+[0..9]"
-
- | keyCode attribute oldAttributes index thisSel colors extras |
- keyCode := ('0123456789' indexOf: aKeyboardEvent keyCharacter ifAbsent: [1]) - 1.
- oldAttributes := paragraph text attributesAt: self pointIndex.
- thisSel := self selection.
-
- "mt: Index-based font changes are not compatible with variable point sizes in text styles. Make room for other shortcuts.
- (keyCode between: 1 and: 5) ifTrue: [attribute := TextFontChange fontNumber: keyCode]."
-
- keyCode = 5
- ifTrue: [
- colors := #(#black #magenta #red #yellow #green #blue #cyan #white).
- extras := self emphasisExtras.
- index := Project uiManager chooseFrom: colors , #('choose color...' ), extras.
- index = 0 ifTrue: [^true].
- index <= colors size
- ifTrue: [attribute := TextColor color: (Color perform: (colors at: index))]
- ifFalse: [
- index := index - colors size - 1. "Re-number!!!!!!"
- index = 0
- ifTrue: [attribute := self chooseColor]
- ifFalse:[^self handleEmphasisExtra: index with: aKeyboardEvent] "handle an extra"]].
- (keyCode between: 6 and: 9)
- ifTrue: [
- aKeyboardEvent shiftPressed
- ifTrue: [ "Cannot be reached bc. method entry is #keyCharacter based and thus dependent on keyboard layout."
- keyCode = 6 ifTrue: [attribute := TextKern kern: -1].
- keyCode = 7 ifTrue: [attribute := TextKern kern: 1]]
- ifFalse: [
- attribute := TextEmphasis
- "And remember this: nine is fine for underline, obliter-eight it as you see fit, seven has been bold for ever'n, which leaves six as the obivous fix to emphasize your poetics."
- perform: (#(italic bold struckOut underlined) at: keyCode - 5).
- oldAttributes
- do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]]]].
- keyCode = 0 ifTrue: [attribute := TextEmphasis normal].
- attribute ifNotNil: [
- thisSel size = 0
- ifTrue: [
- "only change emphasisHere while typing"
- self insertTypeAhead.
- emphasisHere := Text addAttribute: attribute toArray: oldAttributes ]
- ifFalse: [
- self replaceSelectionWith: (thisSel asText addAttribute: attribute) ]].
- ^true!
Item was removed:
- ----- Method: TextEditor>>changeEmphasisOrAlignment (in category 'attributes') -----
- changeEmphasisOrAlignment
- | aList reply code align menuList startIndex |
- startIndex := self startIndex.
- aList := #(normal bold italic narrow underlined struckOut leftFlush centered rightFlush justified).
- align := paragraph text alignmentAt: startIndex
- ifAbsent: [ paragraph textStyle alignment ].
- code := paragraph text emphasisAt: startIndex.
- menuList := WriteStream on: Array new.
- menuList nextPut: (code isZero ifTrue:['<on>'] ifFalse:['<off>']), 'normal' translated.
- menuList nextPutAll: (#(bold italic underlined struckOut) collect:[:emph|
- (code anyMask: (TextEmphasis perform: emph) emphasisCode)
- ifTrue: [ '<on>', emph asString translated ]
- ifFalse: [ '<off>',emph asString translated ]]).
- ((paragraph text attributesAt: startIndex)
- anySatisfy: [ :attr | attr isKern and: [attr kern < 0 ]])
- ifTrue: [ menuList nextPut:'<on>', 'narrow' translated ]
- ifFalse: [ menuList nextPut:'<off>', 'narrow' translated ].
- menuList nextPutAll: (#(leftFlush centered rightFlush justified) withIndexCollect: [ :type :i |
- align = (i-1)
- ifTrue: [ '<on>',type asString translated ]
- ifFalse: [ '<off>',type asString translated ]]).
- aList := #(normal bold italic underlined struckOut narrow leftFlush centered rightFlush justified).
- reply := UIManager default chooseFrom: menuList contents values: aList lines: #(1 6).
- reply notNil ifTrue: [
- (#(leftFlush centered rightFlush justified) includes: reply)
- ifTrue: [
- self setAlignment: reply.
- paragraph composeAll.
- self recomputeSelection]
- ifFalse: [
- self setEmphasis: reply.
- paragraph composeAll.
- self recomputeSelection]].
- ^ true!
Item was removed:
- ----- Method: TextEditor>>changeLfToCr: (in category 'editing keys') -----
- changeLfToCr: aKeyboardEvent
- "Replace all LFs by CRs.
- Triggered by Cmd-U -- useful when getting code from FTP sites
- jmv- Modified to als change crlf by cr"
-
- | fixed |
- fixed := self selection string withSqueakLineEndings.
- self replaceSelectionWith: (Text fromString: fixed).
- ^ true!
Item was removed:
- ----- Method: TextEditor>>changeParagraph: (in category 'initialize-release') -----
- changeParagraph: aParagraph
- "Install aParagraph as the one to be edited by the receiver."
-
- paragraph := aParagraph.
- self resetState!
Item was removed:
- ----- Method: TextEditor>>changeSelectionFontTo: (in category 'attributes') -----
- changeSelectionFontTo: aFont
- | attr |
- aFont ifNil: [ ^ self ].
- attr := TextFontReference toFont: aFont.
-
- self openTypeIn.
-
- paragraph text
- addAttribute: attr
- from: (self hasSelection
- ifTrue: [ self startIndex ]
- ifFalse: [ 1 ])
- to:
- (self hasSelection
- ifTrue: [ self stopIndex - 1 min: paragraph text size ]
- ifFalse: [ paragraph text size ]).
-
- self closeTypeIn.
-
- paragraph composeAll.
- self recomputeSelection.
- morph changed!
Item was removed:
- ----- Method: TextEditor>>changeStyle (in category 'attributes') -----
- changeStyle
- "Let user change styles for the current text pane."
-
- | known knownTTCStyles knownLegacyStyles defaultStyles
- newStyle current currentName menuList |
- current := morph textStyle.
- currentName := current defaultFamilyName.
-
- knownTTCStyles := ((TextStyle actualTextStyles
- select: [:ea | ea isTTCStyle
- "No aliased text styles here..."
- and: [(TextStyle named: ea defaultFamilyName) == ea]])
- sorted: [:a :b | a defaultFamilyName <= b defaultFamilyName])
- collect: [:ea | ea defaultFamilyName -> ea] as: OrderedDictionary.
- knownLegacyStyles := ((TextStyle actualTextStyles reject: [:ea | ea isTTCStyle])
- sorted: [:a :b | a defaultFamilyName <= b defaultFamilyName])
- collect: [:ea | ea defaultFamilyName -> ea] as: OrderedDictionary.
- defaultStyles := ((TextStyle defaultFamilyNames
- collect: [:ea | ea -> (TextStyle named: ea)] as: OrderedDictionary)
- reject: [:ea | ea isNil "undefined default styles"])
- sorted: [:a :b | a key <= b key].
-
- known := defaultStyles, {'---' -> nil}, knownTTCStyles, {'--- ' -> nil}, knownLegacyStyles.
- menuList := Array streamContents: [:s |
- known keysAndValuesDo: [ :knownName :knownStyle |
- s nextPut: (((knownStyle notNil and: [knownStyle defaultFamilyName = currentName])
- ifTrue: [ (' > ', knownName, ' (current)' translated) asText ]
- ifFalse: [ knownName asText ]) addAttribute: (TextFontReference toFont: (knownStyle ifNil: [TextStyle default])defaultFont); yourself)]].
- known := known values.
- newStyle := Project uiManager chooseFrom: menuList values: known.
- newStyle ifNotNil: [morph textStyle: newStyle copy].
- ^ true!
Item was removed:
- ----- Method: TextEditor>>changeStyle: (in category 'typing/selecting keys') -----
- changeStyle: aKeyboardEvent
- "Put up the style-change menu"
-
- self insertAndCloseTypeIn.
- self changeStyle.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>changeTextFont (in category 'attributes') -----
- changeTextFont
- "Present a dialog which allows the user to select a font, and if one is chosen, apply it to the current selection. If there is no selection, or the selection is empty, apply it to the whole morph."
- | curFont startIndex |
- startIndex := self startIndex.
- curFont := (paragraph text fontAt: startIndex withStyle: paragraph textStyle).
- morph openModal: (
- Cursor wait showWhile: [
- (FontChooserTool default
- withTitle: 'Change the selected text''s font to...' translated
- for: [:newFont |
- self flag: #fixme. "mt: This is a workaround because the lifetime/validity of the font-chooser window can be longer than the one of the receiver (i.e., the text editor)."
- morph editor changeSelectionFontTo: newFont]
- setSelector: #value:
- getSelector: curFont)
- "Do not allow changing the emphasis; we don't know how to deal with
- a 'pre-emphasized' font here, so bail."
- offerStyleList: false;
- open])!
Item was removed:
- ----- Method: TextEditor>>chooseAlignment (in category 'menu messages') -----
- chooseAlignment
- self changeAlignment!
Item was removed:
- ----- Method: TextEditor>>chooseColor (in category 'editing keys') -----
- chooseColor
- "Make a new Text Color Attribute, let the user pick a color, and return the attribute"
- | attribute |
- attribute := TextColor color: Color black.
- NewColorPickerMorph useIt
- ifTrue:
- [ (NewColorPickerMorph on: attribute) openNear: morph fullBoundsInWorld ]
- ifFalse:
- [ ColorPickerMorph new
- choseModalityFromPreference ;
- sourceHand: morph activeHand ;
- target: attribute ;
- selector: #color: ;
- originalColor: Color black ;
-
- putUpFor: morph
- near: morph fullBoundsInWorld ].
- ^ attribute!
Item was removed:
- ----- Method: TextEditor>>classCommentsContainingIt (in category 'menu messages') -----
- classCommentsContainingIt
- "Open a browser class comments which contain the current selection somewhere in them."
-
- self lineSelectAndEmptyCheck: [^ self].
- self systemNavigation browseClassCommentsWithString: self selection string!
Item was removed:
- ----- Method: TextEditor>>classNamesContainingIt (in category 'menu messages') -----
- classNamesContainingIt
- "Open a browser on classes whose names contain the selected string"
-
- self lineSelectAndEmptyCheck: [^self].
- self systemNavigation
- browseClassesWithNamesContaining: self selection string
- caseSensitive: Sensor leftShiftDown!
Item was removed:
- ----- Method: TextEditor>>clearEmphasisHere (in category 'typing support') -----
- clearEmphasisHere
-
- emphasisHere := #().!
Item was removed:
- ----- Method: TextEditor>>clearParens (in category 'parenblinking') -----
- clearParens
- lastParenLocation ifNotNil: [
- self text string size >= lastParenLocation ifTrue: [
- self text
- removeAttribute: TextEmphasis bold
- from: lastParenLocation
- to: lastParenLocation]].
- lastParenLocation := nil!
Item was removed:
- ----- Method: TextEditor>>click: (in category 'events') -----
- click: evt
- "This is called if you click in a text selection while drag is enabled, but you did not drag. Also see #startDrag:."
-
- self selectAt: (paragraph characterBlockAtPoint: evt position) stringIndex.!
Item was removed:
- ----- Method: TextEditor>>closeTypeIn (in category 'typing support') -----
- closeTypeIn
- "See comment in openTypeIn. It is important to call closeTypeIn before executing
- any non-typing key, making a new selection, etc. It is called automatically for
- menu commands."
-
- | begin start stop |
- beginTypeInIndex ifNotNil:
- [begin := beginTypeInIndex.
- stop := self stopIndex.
- start := self startIndex.
-
- self history ifNotNil:
- [:myHistory|
- myHistory current
- contentsAfter: (stop <= begin
- ifTrue: [self nullText]
- ifFalse: [paragraph text copyFrom: begin to: stop-1]);
- intervalAfter: (start to: stop-1);
- intervalBetween: (stop < begin
- ifTrue: [stop to: stop-1]
- ifFalse: [begin to: stop-1]);
- messageToUndo: (Message selector: #undoAndReselect);
- messageToRedo: (Message selector: #redoAndReselect).
-
- myHistory finishRemember].
-
- beginTypeInIndex := nil]!
Item was removed:
- ----- Method: TextEditor>>compareToClipboard (in category 'menu messages') -----
- compareToClipboard
- "If any text is selected, present the modifications that would be made to it if the clipboard contents were pasted over it. If no text is selected, present the differences betwen the entire pane's contents and the clipboard text."
- | subjectText proposedText |
- subjectText := self selection string ifEmpty: [ paragraph text string ].
- proposedText := self clipboardText string.
- subjectText = proposedText ifTrue: [^ self inform: 'Exact match'].
- (StringHolder new
- textContents:
- (TextDiffBuilder
- buildDisplayPatchFrom: subjectText
- to: proposedText)) openLabel: 'Differences with Clipboard Text'!
Item was removed:
- ----- Method: TextEditor>>compareToClipboard: (in category 'editing keys') -----
- compareToClipboard: aKeyboardEvent
- "Compare the receiver to the text on the clipboard."
-
- self compareToClipboard.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>compileSelectionFor:in: (in category 'do-its') -----
- compileSelectionFor: anObject in: evalContext
-
- | methodNode |
- methodNode := [Compiler new
- compileNoPattern: self selectionAsStream
- in: anObject class
- context: evalContext
- environment: model environment
- notifying: self
- ifFail: [^nil]]
- on: OutOfScopeNotification
- do: [:ex | ex resume: true].
- ^ methodNode generateWithTempNames!
Item was removed:
- ----- Method: TextEditor>>copyHiddenInfo (in category 'editing keys') -----
- copyHiddenInfo
- "In TextLinks, TextDoits, TextColor, and TextURLs, there is hidden
- info. Copy that to the clipboard. You can paste it and see what it is.
- Usually enclosed in <>."
-
- ^ self clipboardTextPut: self hiddenInfo!
Item was removed:
- ----- Method: TextEditor>>copyHtml (in category 'menu messages') -----
- copyHtml
- "Copy the paragraph as HTML representation and store it in the paste buffer."
-
- self clipboardTextPut: self text printHtmlString.!
Item was removed:
- ----- Method: TextEditor>>copyHtmlSelection (in category 'menu messages') -----
- copyHtmlSelection
- "Copy the current selection as HTML representation and store it in the paste buffer, unless a caret."
-
- self lineSelectAndEmptyCheck: [^ self].
- self clipboardTextPut: self selection printHtmlString.!
Item was removed:
- ----- Method: TextEditor>>copySelection (in category 'menu messages') -----
- copySelection
- "Copy the current selection and store it in the paste buffer, unless a caret."
-
- self lineSelectAndEmptyCheck: [^ self].
- self clipboardTextPut: self selection.!
Item was removed:
- ----- Method: TextEditor>>correctFrom:to:with: (in category 'new selection') -----
- correctFrom: start to: stop with: aString
- "Make a correction in the model that the user has authorised from somewhere else in the system (such as from the compilier). The user's selection is not changed, only corrected."
- | userSelection delta loc |
- aString = '#insert period' ifTrue: [
- loc := start.
- [(loc := loc-1)>0 and: [(paragraph string at: loc) isSeparator]]
- whileTrue: [loc := loc-1].
- ^ self correctFrom: loc+1 to: loc with: '.'].
- userSelection := self selectionInterval.
-
- self selectInvisiblyFrom: start to: stop.
- self replaceSelectionWith: aString.
-
- delta := aString size - (stop - start + 1).
- self
- selectInvisiblyFrom: userSelection first + (userSelection first > start ifFalse: [ 0 ] ifTrue: [ delta ])
- to: userSelection last + (userSelection last > start ifFalse: [ 0 ] ifTrue: [ delta ]).!
Item was removed:
- ----- Method: TextEditor>>crWithIndent: (in category 'typing/selecting keys') -----
- crWithIndent: aKeyboardEvent
- "Replace the current text selection with CR followed by as many tabs
- as on the current line (+/- bracket count) -- initiated by Shift-Return."
- self addString: (String streamContents: [:characterStream | characterStream crtab: self tabCount]). "Now inject CR with tabCount tabs"
- ^ false!
Item was removed:
- ----- Method: TextEditor>>cursorEnd: (in category 'nonediting/nontyping keys') -----
- cursorEnd: aKeyboardEvent
-
- "Private - Move cursor end of current line."
- | string |
- self insertAndCloseTypeIn.
- string := paragraph text string.
- self
- moveCursor:
- [:position | Preferences wordStyleCursorMovement
- ifTrue:[| targetLine |
- targetLine := paragraph lines at:(paragraph lineIndexOfCharacterIndex: position).
- targetLine = paragraph lastLine
- ifTrue:[targetLine last + 1]
- ifFalse:[targetLine last]]
- ifFalse:[
- string
- indexOfAnyOf: CharacterSet crlf
- startingAt: position
- ifAbsent:[string size + 1]]]
- forward: true
- event: aKeyboardEvent
- specialBlock:[:dummy | string size + 1].
- ^true!
Item was removed:
- ----- Method: TextEditor>>cursorHome: (in category 'nonediting/nontyping keys') -----
- cursorHome: aKeyboardEvent
-
- "Private - Move cursor from position in current line to beginning of
- current line. If control key is pressed put cursor at beginning of text"
-
- | string |
-
- string := paragraph text string.
- self
- moveCursor: [ :position | Preferences wordStyleCursorMovement
- ifTrue:[
- (paragraph lines at:(paragraph lineIndexOfCharacterIndex: position)) first]
- ifFalse:[
- (string
- lastIndexOfAnyOf: CharacterSet crlf
- startingAt: position - 1) + 1]]
- forward: false
- event: aKeyboardEvent
- specialBlock: [:dummy | 1].
- ^true!
Item was removed:
- ----- Method: TextEditor>>cut (in category 'menu messages') -----
- cut
- "Cut out the current selection and redisplay the paragraph if necessary. Undoer & Redoer: undoCutCopy:"
-
- self lineSelectAndEmptyCheck: [^ self].
-
- self clipboardTextPut: self selection.
- self replaceSelectionWith: self nullText.!
Item was removed:
- ----- Method: TextEditor>>debugIt (in category 'do-its') -----
- debugIt
-
- | receiver context helperProcess |
- self lineSelectAndEmptyCheck: [^self].
-
- (model respondsTo: #debugExpression:requestor:)
- ifTrue: [^ model perform: #debugExpression:requestor: with: self selection with: self].
- (model respondsTo: #debugExpression:)
- ifTrue: [^ model perform: #debugExpression: with: self selection].
-
- receiver := (model respondsTo: #doItReceiver)
- ifTrue: [model doItReceiver]
- ifFalse: [nil].
-
- context := (model respondsTo: #doItContext)
- ifTrue: [model doItContext]
- ifFalse: [nil].
-
- (self compileSelectionFor: receiver in: context) ifNotNil: [:doItMethod |
- helperProcess := context
- ifNil: [self assert: doItMethod selector = #DoIt.
- Process forMethod: doItMethod receiver: receiver]
- ifNotNil: [self assert: doItMethod selector = #DoItIn:.
- Process forMethod: doItMethod receiver: receiver arguments: {context}].
- helperProcess debugWithTitle: 'Debug it' translated].!
Item was removed:
- ----- Method: TextEditor>>debugIt: (in category 'editing keys') -----
- debugIt: aKeyboardEvent
-
- self debugIt.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>destructiveBackWord: (in category 'typing/selecting keys') -----
- destructiveBackWord: aKeyboardEvent
- typeAhead isEmpty
- ifTrue: [ super destructiveBackWord: aKeyboardEvent ]
- ifFalse: [ typeAhead reset ].
- ^ false!
Item was removed:
- ----- Method: TextEditor>>dispatchOnEnterWith: (in category 'typing support') -----
- dispatchOnEnterWith: aKeyboardEvent
- "Enter key hit. Treat is as an 'accept', viz a synonym for cmd-s. If cmd key is down, treat is as a synonym for print-it. "
-
- aKeyboardEvent commandKeyPressed
- ifTrue:
- [self printIt.]
- ifFalse:
- [self insertAndCloseTypeIn.
- self accept].
- ^ true!
Item was removed:
- ----- Method: TextEditor>>dispatchOnKeyboardEvent: (in category 'typing support') -----
- dispatchOnKeyboardEvent: aKeyboardEvent
- "Carry out the action associated with this character, if any. Type-ahead is passed so some routines can flush or use it."
-
- | honorCommandKeys typedChar |
- typedChar := aKeyboardEvent keyCharacter.
-
- "Handle one-line input fields."
- (typedChar == Character cr and: [morph acceptOnCR])
- ifTrue: [^ true].
-
- "Clear highlight for last opened parenthesis."
- self clearParens.
-
- "Handle line breaks and auto indent."
- typedChar == Character cr ifTrue: [
- aKeyboardEvent controlKeyPressed
- ifTrue: [^ self normalCharacter: aKeyboardEvent].
- aKeyboardEvent shiftPressed
- ifTrue: [^ self lf: aKeyboardEvent].
- aKeyboardEvent commandKeyPressed
- ifTrue: [^ self crlf: aKeyboardEvent].
- ^ self crWithIndent: aKeyboardEvent].
-
- "Handle indent/outdent with selected text block."
- typedChar == Character tab ifTrue: [
- aKeyboardEvent shiftPressed
- ifTrue: [self outdent: aKeyboardEvent. ^ true]
- ifFalse: [self hasMultipleLinesSelected
- ifTrue: [self indent: aKeyboardEvent. ^ true]]].
-
- honorCommandKeys := Preferences cmdKeysInText.
-
- (honorCommandKeys and: [typedChar == Character enter])
- ifTrue: [^ self dispatchOnEnterWith: aKeyboardEvent].
-
- "Special keys overwrite crtl+key combinations - at least on Windows. To resolve this
- conflict, assume that keys other than cursor keys aren't used together with Crtl."
- ((self class specialShiftCmdKeys includes: aKeyboardEvent keyValue)
- and: [aKeyboardEvent keyValue < 27])
- ifTrue: [^ aKeyboardEvent controlKeyPressed
- ifTrue: [self
- perform: (self class shiftCmdActions at: aKeyboardEvent keyValue + 1)
- with: aKeyboardEvent]
- ifFalse: [self
- perform: (self class cmdActions at: aKeyboardEvent keyValue + 1)
- with: aKeyboardEvent]].
-
- "backspace, and escape keys (ascii 8 and 27) are command keys"
- ((honorCommandKeys and: [aKeyboardEvent commandKeyPressed])
- or: [self class specialShiftCmdKeys includes: aKeyboardEvent keyValue])
- ifTrue: [ ^ aKeyboardEvent shiftPressed
- ifTrue: [self
- perform: (self class shiftCmdActions at: aKeyboardEvent keyValue + 1)
- with: aKeyboardEvent]
- ifFalse: [self
- perform: (self class cmdActions at: aKeyboardEvent keyValue + 1)
- with: aKeyboardEvent]].
-
- "the control key can be used to invoke shift-cmd shortcuts"
- (honorCommandKeys and: [ aKeyboardEvent controlKeyPressed ])
- ifTrue: [^ self
- perform: (self class shiftCmdActions at: aKeyboardEvent keyValue + 1)
- with: aKeyboardEvent].
-
- "Enclose selection with brackets etc."
- ((self class encloseSelection and: [self hasSelection]) and: [self enclose: aKeyboardEvent])
- ifTrue: [^ true].
-
- "Automatically enclose paired characters such as brackets."
- (self class autoEnclose and: [self autoEncloseFor: typedChar])
- ifTrue: [^ true].
-
- "Even if no enclosing feature was used, highlight the matching bracket when closing one."
- (')]}' includes: typedChar)
- ifTrue: [self blinkPrevParen: typedChar].
-
- self normalCharacter: aKeyboardEvent.
- ^ false!
Item was removed:
- ----- Method: TextEditor>>displayIfFalse: (in category 'typing/selecting keys') -----
- displayIfFalse: aKeyboardEvent
- "Replace the current text selection with the text 'ifFalse:'--initiated by
- ctrl-f."
-
- self addString: 'ifFalse:'.
- ^false!
Item was removed:
- ----- Method: TextEditor>>displayIfTrue: (in category 'typing/selecting keys') -----
- displayIfTrue: aKeyboardEvent
- "Replace the current text selection with the text 'ifTrue:'--initiated by
- ctrl-t."
-
- self addString: 'ifTrue:'.
- ^false!
Item was removed:
- ----- Method: TextEditor>>doAgain: (in category 'typing/selecting keys') -----
- doAgain: aKeyboardEvent
- "Do the previous thing again once. 1/26/96 sw"
-
- self insertAndCloseTypeIn.
- self again.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>doAgainUpToEnd: (in category 'typing/selecting keys') -----
- doAgainUpToEnd: aKeyboardEvent
- "Do the previous thing again once. 1/26/96 sw"
-
- self insertAndCloseTypeIn.
- self againUpToEnd.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>doIt (in category 'do-its') -----
- doIt
- "Set the context to include pool vars of the model. Then evaluate."
- ^ self evaluateSelection!
Item was removed:
- ----- Method: TextEditor>>doIt: (in category 'editing keys') -----
- doIt: aKeyboardEvent
- "Called when user hits cmd-d. Select the current line, if relevant, then evaluate and execute. 2/1/96 sw.
- 2/29/96 sw: don't call selectLine; it's done by doIt now"
-
- self doIt.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>emphasisExtras (in category 'editing keys') -----
- emphasisExtras
- "Answer an array of extra items for the emphasis menu"
- ^#()!
Item was removed:
- ----- Method: TextEditor>>enclose: (in category 'editing keys') -----
- enclose: aKeyboardEvent
-
- ^ self enclose: aKeyboardEvent toggleOnly: false!
Item was removed:
- ----- Method: TextEditor>>enclose:toggleOnly: (in category 'editing keys') -----
- enclose: aKeyboardEvent toggleOnly: toggleOnly
- "Insert or remove bracket characters around the current selection. An opening
- bracket will add a level, a closing one will remove a level. If there is no level to
- remove, the current text selection will be replaced with that closing bracket. If
- both opening and closing characters are identical, only one level is possible and
- both states are toggled by repeated invocation. If toggleOnly is set, that also
- happens for all asymmetrical characters."
-
- | character left right startIndex stopIndex oldSelection which closingBracket t |
- character := aKeyboardEvent keyCharacter.
- self closeTypeIn.
- startIndex := self startIndex.
- stopIndex := self stopIndex.
- oldSelection := self selection.
- closingBracket := false.
- which := '([<{|"''' indexOf: character ifAbsent: [
- closingBracket := true.
- ')]>}|"''' indexOf: character ifAbsent: [ ^ false ]].
- left := '([<{|"''' at: which.
- right := ')]>}|"''' at: which.
- t := self text.
- ((startIndex > 1 and: [stopIndex <= t size])
- and: [ (t at: startIndex-1) = left and: [(t at: stopIndex) = right]]
- and: [ closingBracket or: [left = right] or: [toggleOnly] ])
- ifTrue:
- ["already enclosed and character is a closing bracket; strip off brackets"
- self selectFrom: startIndex-1 to: stopIndex.
- self replaceSelectionWith: oldSelection]
- ifFalse:
- ["not enclosed or character is an opening bracket; enclose by matching brackets"
- closingBracket ifTrue: [ ^ false ] ifFalse:
- [ self replaceSelectionWith:
- (Text string: (String with: left), oldSelection string, (String with: right) attributes: emphasisHere).
- self selectFrom: startIndex+1 to: stopIndex] ].
- ^true!
Item was removed:
- ----- Method: TextEditor>>encompassLine: (in category 'new selection') -----
- encompassLine: anInterval
- "Return an interval that encompasses the entire line"
- | string left right |
- string := paragraph text string.
- left := (string lastIndexOfAnyOf: CharacterSet crlf startingAt: anInterval first - 1) + 1.
- right := (string indexOfAnyOf: CharacterSet crlf startingAt: anInterval last + 1 ifAbsent: [string size + 1]) - 1.
- ^left to: right!
Item was removed:
- ----- Method: TextEditor>>endOfLine: (in category 'private') -----
- endOfLine: position
- "Redefined in subclasses using Paragraph support"
- | targetLine |
- targetLine := paragraph lines at: (paragraph lineIndexFor: position).
- ^ targetLine = paragraph lastLine
- ifFalse: [ targetLine last ]
- ifTrue: [ targetLine last + 1 ]!
Item was removed:
- ----- Method: TextEditor>>evaluateSelection (in category 'do-its') -----
- evaluateSelection
- "Treat the current selection as an expression; evaluate it and return the result"
-
- ^self evaluateSelectionAndDo: [:result | result]!
Item was removed:
- ----- Method: TextEditor>>evaluateSelectionAndDo: (in category 'do-its') -----
- evaluateSelectionAndDo: aBlock
- "Treat the current selection as an expression; evaluate it and invoke aBlock with the result."
- | result rcvr ctxt |
- self lineSelectAndEmptyCheck: [^ nil].
-
- (model respondsTo: #evaluateExpression:requestor:) ifTrue: [
- ^ aBlock value: (model perform: #evaluateExpression:requestor: with: self selection with: self)].
- (model respondsTo: #evaluateExpression:) ifTrue: [
- ^ aBlock value: (model perform: #evaluateExpression: with: self selection)].
-
- (model respondsTo: #doItReceiver)
- ifTrue: [ rcvr := model doItReceiver.
- ctxt := model doItContext]
- ifFalse: [rcvr := ctxt := nil].
- result := [
- rcvr class evaluatorClass new
- evaluate: self selectionAsStream
- in: ctxt
- to: rcvr
- environment: (model environment ifNil: [Smalltalk globals])
- notifying: self
- ifFail: [self flash. ^ nil]
- logged: true.
- ]
- on: OutOfScopeNotification
- do: [ :ex | ex resume: true].
-
- (model respondsTo: #expressionEvaluated:result:) ifTrue: [
- model perform: #expressionEvaluated:result: with: self selection with: result].
-
- ^aBlock value: result!
Item was removed:
- ----- Method: TextEditor>>exchange (in category 'menu messages') -----
- exchange
- "See comment in exchangeWith:"
-
- self exchangeWith: otherInterval.!
Item was removed:
- ----- Method: TextEditor>>exchange: (in category 'editing keys') -----
- exchange: eKeyboardEvent
- "Exchange the current and prior selections. Keeps typeahead."
-
- self insertAndCloseTypeIn.
- self exchange.
- ^true!
Item was removed:
- ----- Method: TextEditor>>exchangeWith: (in category 'private') -----
- exchangeWith: prior
- "If the prior selection is non-overlapping and legal, exchange the text of
- it with the current selection and leave the currently selected text selected
- in the location of the prior selection (or leave a caret after a non-caret if it was
- exchanged with a caret). If both selections are carets, flash & do nothing.
- Don't affect the paste buffer."
-
- | start stop before selection priorSelection delta altInterval |
- start := self startIndex.
- stop := self stopIndex - 1.
-
- (((prior first <= prior last) and: [start <= stop])
- and: [self isDisjointFrom: prior])
- ifFalse: [morph flash. ^ self].
-
- before := prior last < start.
- selection := self selection.
- priorSelection := paragraph text copyFrom: prior first to: prior last.
- delta := before ifTrue: [0] ifFalse: [priorSelection size - selection size].
-
- "Create first undo command."
- self replaceSelectionWith: priorSelection.
- self history previous isCompositeRedo: true.
-
- self selectInvisiblyFrom: prior first + delta to: prior last + delta.
- delta := before ifTrue: [stop - prior last] ifFalse: [start - prior first].
-
- "Create second undo command."
- self replaceSelectionWith: selection.
- self history previous isCompositeUndo: true.
-
- altInterval := prior first + delta to: prior last + delta.
-
- "If one was a caret, make it otherInterval & leave the caret after the other"
- prior first > prior last ifTrue: [self selectAt: prior last + 1].
- otherInterval := start > stop
- ifTrue: [self selectAt: altInterval last + 1. prior]
- ifFalse: [altInterval]!
Item was removed:
- ----- Method: TextEditor>>existingIndentation (in category 'private') -----
- existingIndentation
- ^ paragraph text indentationAmountAt: (self encompassLine: self selectionInterval)!
Item was removed:
- ----- Method: TextEditor>>explain (in category 'menu messages') -----
- explain
- "Try to shed some light on what kind of entity the current selection is.
- The selection must be a single token or construct. Insert the answer after
- the selection. Send private messages whose names begin with 'explain'
- that return a string if they recognize the selection, else nil."
-
-
- Cursor execute showWhile:
- [ | string numbers delimitors cgVars reply selectors tiVars sorry |
- sorry := '"Sorry, I can''t explain that. Please select a single
- token, construct, or special character.'.
- sorry := sorry , (morph canDiscardEdits
- ifFalse: [' Also, please cancel or accept."']
- ifTrue: ['"']).
- (string := self selection asString) isEmpty
- ifTrue: [reply := '']
- ifFalse: [string := self explainScan: string.
- "Remove space, tab, cr"
- "Temps and Instance vars need only test strings that are all letters"
- (string allSatisfy: [:char | char isLetter or: [char isDigit]])
- ifTrue:
- [tiVars := self explainTemp: string.
- tiVars == nil ifTrue: [tiVars := self explainInst: string]].
- (tiVars == nil and: [model respondsTo: #explainSpecial:])
- ifTrue: [tiVars := model explainSpecial: string].
- tiVars == nil
- ifTrue: [tiVars := '']
- ifFalse: [tiVars := tiVars , '\' withCRs].
- "Context, Class, Pool, and Global vars, and Selectors need
- only test symbols"
- (Symbol lookup: string)
- ifNotNil: [ :symbol |
- cgVars := self explainCtxt: symbol.
- cgVars == nil
- ifTrue: [cgVars := self explainClass: symbol.
- cgVars == nil ifTrue: [cgVars := self explainGlobal: symbol]].
- "See if it is a Selector (sent here or not)"
- selectors := self explainMySel: symbol.
- selectors == nil
- ifTrue:
- [selectors := self explainPartSel: string.
- selectors == nil ifTrue: [
- selectors := self explainAnySel: symbol]]]
- ifNil: [selectors := self explainPartSel: string].
- cgVars == nil
- ifTrue: [cgVars := '']
- ifFalse: [cgVars := cgVars , '\' withCRs].
- selectors == nil
- ifTrue: [selectors := '']
- ifFalse: [selectors := selectors , '\' withCRs].
- string size = 1
- ifTrue: ["single special characters"
- delimitors := self explainChar: string]
- ifFalse: ["matched delimitors"
- delimitors := self explainDelimitor: string].
- numbers := self explainNumber: string.
- numbers == nil ifTrue: [numbers := ''].
- delimitors == nil ifTrue: [delimitors := ''].
- reply := tiVars , cgVars , selectors , delimitors , numbers].
- reply size = 0 ifTrue: [reply := sorry].
- self afterSelectionInsertAndSelect: reply]!
Item was removed:
- ----- Method: TextEditor>>explainAnySel: (in category 'explain') -----
- explainAnySel: symbol
- "Is this any message selector?"
-
- | list reply |
- list := self systemNavigation allClassesImplementing: symbol.
- list size = 0 ifTrue: [^nil].
- list size < 12
- ifTrue: [reply := ' is a message selector which is defined in these classes: ' , list asArray printString]
- ifFalse: [reply := ' is a message selector which is defined in many classes'].
- ^'"' , symbol , reply , '."' , '\' withCRs, 'SystemNavigation new browseAllImplementorsOf: #' , symbol!
Item was removed:
- ----- Method: TextEditor>>explainChar: (in category 'explain') -----
- explainChar: string
- "Does string start with a special character?"
-
- | char |
- char := string at: 1.
- char = $. ifTrue: [^'"Period marks the end of a Smalltalk statement. A period in the middle of a number means a decimal point. (The number is an instance of class Float)."'].
- char = $' ifTrue: [^'"The characters between two single quotes are made into an instance of class String"'].
- char = $" ifTrue: [^'"Double quotes enclose a comment. Smalltalk ignores everything between double quotes."'].
- char = $# ifTrue: [^'"The characters following a hash mark are made into an instance of class Symbol. If parenthesis follow a hash mark, an instance of class Array is made. It contains literal constants."'].
- (char = $( or: [char = $)]) ifTrue: [^'"Expressions enclosed in parenthesis are evaluated first"'].
- (char = $[ or: [char = $]]) ifTrue: [^'"The code inside square brackets is an unevaluated block of code. It becomes an instance of BlockClosure and is usually passed as an argument."'].
- (char = ${ or: [char = $}]) ifTrue: [^ '"A sequence of expressions separated by periods, when enclosed in curly braces, are evaluated to yield the elements of a new Array"'].
- (char = $< or: [char = $>]) ifTrue: [^'"<primitive: xx> means that this method is usually preformed directly by the virtual machine. If this method is primitive, its Smalltalk code is executed only when the primitive fails."'].
- char = $^ ifTrue: [^'"Uparrow means return from this method. The value returned is the expression following the ^"'].
- char = $| ifTrue: [^'"Vertical bars enclose the names of the temporary variables used in this method. In a block, the vertical bar separates the argument names from the rest of the code."'].
- char = $_ ifTrue: [^'"Left arrow means assignment (deprecated, applies if the Preference for allow underscore assignment is set). The value of the expression after the left arrow is stored into the variable before it."'].
- char = $; ifTrue: [^'"Semicolon means cascading. The message after the semicolon is sent to the same object which received the message before the semicolon."'].
- char = $: ifTrue: [^'"A colon at the end of a keyword means that an argument is expected to follow. Methods which take more than one argument have selectors with more than one keyword. (One keyword, ending with a colon, appears before each argument).', '\\' withCRs, 'A colon before a variable name just inside a block means that the block takes an agrument. (When the block is evaluated, the argument will be assigned to the variable whose name appears after the colon)."'].
- char = $$ ifTrue: [^'"The single character following a dollar sign is made into an instance of class Character"'].
- char = $- ifTrue: [^'"A minus sign in front of a number means a negative number."'].
- char = $e ifTrue: [^'"An e in the middle of a number means that the exponent follows."'].
- char = $r ifTrue: [^'"An r in the middle of a bunch of digits is an instance of Integer expressed in a certain radix. The digits before the r denote the base and the digits after it express a number in that base."'].
- char = Character space ifTrue: [^'"the space Character"'].
- char = Character tab ifTrue: [^'"the tab Character"'].
- char = Character cr ifTrue: [^'"the carriage return Character"'].
- char = Character lf ifTrue: [^'"the line feed Character"'].
- ^nil!
Item was removed:
- ----- Method: TextEditor>>explainClass: (in category 'explain') -----
- explainClass: symbol
- "Is symbol a class variable or a pool variable?"
- | class reply classes |
- (model respondsTo: #selectedClassOrMetaClass)
- ifFalse: [^ nil].
- (class := model selectedClassOrMetaClass) ifNil: [^ nil].
- "no class is selected"
- (class isKindOf: Metaclass)
- ifTrue: [class := class soleInstance].
- classes := class withAllSuperclasses.
- "class variables"
- reply := classes detect: [:each | each classVarNames anySatisfy: [:name | symbol = name]]
- ifNone: [].
- reply == nil ifFalse: [^ '"is a class variable, defined in class ' , reply printString , '"\' withCRs , 'SystemNavigation new browseAllCallsOn: (' , reply printString , ' classPool associationAt: #' , symbol , ').'].
- "pool variables"
- classes do: [:each | each sharedPools
- anySatisfy: [:pool | (pool includesKey: symbol)
- and:
- [reply := pool.
- true]]].
- reply
- ifNil: [(class environment isUndeclared: symbol)
- ifTrue: [^ '"is an undeclared variable.' , '"\' withCRs , 'SystemNavigation new browseAllCallsOn: (Undeclared associationAt: #' , symbol , ').']]
- ifNotNil:
- [classes := WriteStream on: Array new.
- self systemNavigation
- allBehaviorsDo: [:each | (each sharedPools
- detect:
- [:pool |
- pool == reply]
- ifNone: [])
- ~~ nil ifTrue: [classes nextPut: each]].
- "Perhaps not print whole list of classes if too long. (unlikely)"
- ^ '"is a pool variable from the pool ' , (Smalltalk globals keyAtIdentityValue: reply) asString , ', which is used by the following classes ' , classes contents printString , '"\' withCRs , 'SystemNavigation new browseAllCallsOn: (' , (Smalltalk globals keyAtIdentityValue: reply) asString , ' bindingOf: #' , symbol , ').'].
- ^ nil!
Item was removed:
- ----- Method: TextEditor>>explainCtxt: (in category 'explain') -----
- explainCtxt: symbol
- "Is symbol a context variable?"
-
- | reply classes text cls |
- symbol = #nil ifTrue: [reply := '"is a constant. It is the only instance of class UndefinedObject. nil is the initial value of all variables."'].
- symbol = #true ifTrue: [reply := '"is a constant. It is the only instance of class True and is the receiver of many control messages."'].
- symbol = #false ifTrue: [reply := '"is a constant. It is the only instance of class False and is the receiver of many control messages."'].
- symbol = #thisContext ifTrue: [reply := '"is a context variable. Its value is always the Context which is executing this method."'].
- (model respondsTo: #selectedClassOrMetaClass) ifTrue: [
- cls := model selectedClassOrMetaClass].
- cls ifNil: [^ reply]. "no class known"
- symbol = #self ifTrue:
- [classes := cls withAllSubclasses.
- classes size > 12
- ifTrue: [text := cls printString , ' or a subclass']
- ifFalse:
- [classes := classes printString.
- text := 'one of these classes' , (classes copyFrom: 4 to: classes size)].
- reply := '"is the receiver of this message; an instance of ' , text , '"'].
- symbol = #super ifTrue: [reply := '"is just like self. Messages to super are looked up in the superclass (' , cls superclass printString , ')"'].
- ^reply!
Item was removed:
- ----- Method: TextEditor>>explainDelimitor: (in category 'explain') -----
- explainDelimitor: string
- "Is string enclosed in delimitors?"
-
- | str |
- (string at: 1) isLetter ifTrue: [^nil]. "only special chars"
- (string first = string last) ifTrue:
- [^ self explainChar: (String with: string first)]
- ifFalse:
- [(string first = $( and: [string last = $)]) ifTrue:
- [^ self explainChar: (String with: string first)].
- (string first = $[ and: [string last = $]]) ifTrue:
- [^ self explainChar: (String with: string first)].
- (string first = ${ and: [string last = $}]) ifTrue:
- [^ self explainChar: (String with: string first)].
- (string first = $< and: [string last = $>]) ifTrue:
- [^ self explainChar: (String with: string first)].
- (string first = $# and: [string last = $)]) ifTrue:
- [^'"An instance of class Array. The Numbers, Characters, Symbols or Arrays between the parenthesis are the elements of the Array."'].
- string first = $# ifTrue:
- [^'"An instance of class Symbol."'].
- (string first = $$ and: [string size = 2]) ifTrue:
- [^'"An instance of class Character. This one is the character ', (String with: string last), '."'].
- (string first = $:) ifTrue:
- [string = ':=' ifTrue:
- [^'"Colon equals means assignment. The value of the expression after the := is stored into the variable before it."'].
- str := string allButFirst.
- (self explainTemp: str) ifNotNil:
- [^'"An argument to this block will be bound to the temporary variable ', str, '."']]].
- ^ nil!
Item was removed:
- ----- Method: TextEditor>>explainGlobal: (in category 'explain') -----
- explainGlobal: symbol
- "Is symbol a global variable?"
- | reply classes |
- reply := Smalltalk at: symbol ifAbsent: [^nil].
- (reply class == Dictionary or:[reply isKindOf: SharedPool class])
- ifTrue:
- [classes := Set new.
- self systemNavigation allBehaviorsDo: [:each | (each sharedPools anySatisfy: [:pool | pool == reply])
- ifTrue: [classes add: each]].
- classes := classes printString.
- ^'"is a global variable. It is a pool which is used by the following classes ' , (classes allButFirst: 5) , '"'].
- (reply isKindOf: Behavior)
- ifTrue: [^'"is a global variable. ' , symbol , ' is a class in category ', reply category,
- '."', '\' withCRs, 'Browser newOnClass: ' , symbol , '.'].
- symbol == #Smalltalk ifTrue: [^'"is a global. Smalltalk is the only instance of SystemDictionary and holds all global variables."'].
- ^'"is a global variable. ' , symbol , ' is ' , reply printString , '"'!
Item was removed:
- ----- Method: TextEditor>>explainInst: (in category 'explain') -----
- explainInst: string
- "Is string an instance variable of this class?"
- | classes cls |
-
- (model respondsTo: #selectedClassOrMetaClass) ifTrue: [
- cls := model selectedClassOrMetaClass].
- cls ifNil: [^ nil]. "no class known"
- classes := (Array with: cls)
- , cls allSuperclasses.
- classes := classes detect: [:each | each instVarNames anySatisfy: [:name | name = string]] ifNone: [^nil].
- classes := classes printString.
- ^ '"is an instance variable of the receiver; defined in class ' , classes ,
- '"\' withCRs , classes , ' systemNavigation browseAllAccessesTo: ''' , string , ''' from: ', classes, '.'!
Item was removed:
- ----- Method: TextEditor>>explainMySel: (in category 'explain') -----
- explainMySel: symbol
- "Is symbol the selector of this method? Is it sent by this method? If
- not, then expalin will call (explainPartSel:) to see if it is a fragment of a
- selector sent here. If not, explain will call (explainAnySel:) to catch any
- selector. "
-
- | lits classes msg |
- (model respondsTo: #selectedMessageName) ifFalse: [^ nil].
- (msg := model selectedMessageName) ifNil: [^nil]. "not in a message"
- classes := self systemNavigation allClassesImplementing: symbol.
- classes size > 12
- ifTrue: [classes := 'many classes']
- ifFalse: [classes := 'these classes ' , classes printString].
- msg = symbol
- ifTrue: [^ '"' , symbol , ' is the selector of this very method!! It is defined in ',
- classes , '. To see the other definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."']
- ifFalse:
- [lits := (model selectedClassOrMetaClass compiledMethodAt:
- msg) messages.
- (lits anySatisfy: [:each | each == symbol])
- ifFalse: [^nil].
- ^ '"' , symbol , ' is a message selector which is defined in ', classes , '. To see the definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."'].!
Item was removed:
- ----- Method: TextEditor>>explainNumber: (in category 'explain') -----
- explainNumber: string
- "Is string a Number?"
-
- | strm c |
- (c := string at: 1) isDigit ifFalse: [(c = $- and: [string size > 1 and: [(string at: 2) isDigit]])
- ifFalse: [^nil]].
- strm := ReadStream on: string.
- c := Number readFrom: strm.
- strm atEnd ifFalse: [^nil].
- c printString = string
- ifTrue: [^'"' , string , ' is a ' , c class name , '"']
- ifFalse: [^'"' , string , ' (= ' , c printString , ') is a ' , c class name , '"']!
Item was removed:
- ----- Method: TextEditor>>explainPartSel: (in category 'explain') -----
- explainPartSel: string
- "Is this a fragment of a multiple-argument selector sent in this method?"
- | lits whole reply classes s msg |
-
- (model respondsTo: #selectedMessageName) ifFalse: [^ nil].
- (msg := model selectedMessageName) ifNil: [^ nil]. "not in a message"
- string last == $: ifFalse: [^ nil].
- "Name of this method"
- lits := Array with: msg.
- (whole := lits detect: [:each | each keywords anySatisfy: [:frag | frag = string] ]
- ifNone: []) ~~ nil
- ifTrue: [reply := ', which is the selector of this very method!!'.
- s := '. To see the other definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."']
- ifFalse:
- ["Selectors called from this method"
- lits := (model selectedClassOrMetaClass compiledMethodAt:
- msg) messages.
- (whole := lits detect: [:each | (each keywords detect: [:frag | frag = string]
- ifNone: []) ~~ nil]
- ifNone: []) ~~ nil
- ifFalse: [string = 'primitive:'
- ifTrue: [^self explainChar: '<']
- ifFalse: [^nil]].
- reply := '.'.
- s := '. To see the definitions, go to the message list pane, get the menu from the top of the scroll bar, and select ''implementors of...''."'].
- classes := self systemNavigation allClassesImplementing: whole.
- classes size > 12
- ifTrue: [classes := 'many classes']
- ifFalse: [classes := 'these classes ' , classes printString].
- ^ '"' , string , ' is one part of the message selector ' , whole, reply , ' It is defined in ' , classes , s!
Item was removed:
- ----- Method: TextEditor>>explainScan: (in category 'explain') -----
- explainScan: string
- "Remove beginning and trailing space, tab, cr.
- 1/15/96 sw: copied intact from BrowserCodeController"
-
- | c beg end |
- beg := 1.
- end := string size.
-
- [beg = end ifTrue: [^string copyFrom: 1 to: 1].
- "if all blank, tell about the first"
- c := string at: beg.
- c = Character space or: [c = Character tab or: [c = Character cr]]]
- whileTrue: [beg := beg + 1].
-
- [c := string at: end.
- c = Character space or: [c = Character tab or: [c = Character cr]]]
- whileTrue: [end := end - 1].
- ^string copyFrom: beg to: end "Return purely visible characters"!
Item was removed:
- ----- Method: TextEditor>>explainTemp: (in category 'explain') -----
- explainTemp: string
- "Is string the name of a temporary variable (method or block argument or temporary)?"
-
- | selectedClass methodNode tempNode |
- (model respondsTo: #selectedMessageName) ifFalse: [^ nil].
- model selectedMessageName ifNil: [^nil]. "not in a method"
- selectedClass := model selectedClassOrMetaClass.
- methodNode := selectedClass newParser parse: model selectedMessage class: selectedClass.
- tempNode := methodNode encoder tempNodes detect: [:n| n name = string] ifNone: [^nil].
- ^(tempNode isArg
- ifTrue: ['"is an argument to this ']
- ifFalse: ['"is a temporary variable in this ']),
- (tempNode isDeclaredAtMethodLevel
- ifTrue: ['method"']
- ifFalse: ['block"'])!
Item was removed:
- ----- Method: TextEditor>>exploreIt (in category 'do-its') -----
- exploreIt
-
- self evaluateSelectionAndDo: [:result |
- (model respondsTo: #exploreIt:result:)
- ifTrue: [model
- perform: #exploreIt:result:
- with: self selection
- with: result]
- ifFalse: [result explore]].!
Item was removed:
- ----- Method: TextEditor>>exploreIt: (in category 'editing keys') -----
- exploreIt: aKeyboardEvent
- "Explore the selection -- invoked via cmd-shift-I. If there is no current selection, use the current line."
-
- self exploreIt.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>fileItIn (in category 'menu messages') -----
- fileItIn
- "Make a Stream on the text selection and fileIn it.
- 1/24/96 sw: moved here from FileController; this function can be useful from any text window that shows stuff in chunk format"
-
- self selectionAsStream fileIn
- !
Item was removed:
- ----- Method: TextEditor>>fileItIn: (in category 'editing keys') -----
- fileItIn: aKeyboardEvent
- "File in the selection; invoked via a keyboard shortcut, -- for now, cmd-shift-G."
-
- self fileItIn.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>find (in category 'menu messages') -----
- find
- "Prompt the user for a string to search for, and search the receiver from the current selection onward for it. 1/26/96 sw"
-
- self setSearchFromSelectionOrHistory.
-
- (Project uiManager request: 'Find what to select?' translated initialAnswer: FindText)
- ifEmpty: [^ self]
- ifNotEmpty: [:reply |
- FindText := reply.
- self findAgainNow].!
Item was removed:
- ----- Method: TextEditor>>find: (in category 'typing/selecting keys') -----
- find: aKeyboardEvent
- "Prompt the user for what to find, then find it, searching from the current selection onward."
-
- self
- insertAndCloseTypeIn;
- find.
-
- ^ true!
Item was removed:
- ----- Method: TextEditor>>findAgain (in category 'menu messages') -----
- findAgain
-
- self setSearchFromSelectionOrHistory.
-
- ^ self findAgainNow!
Item was removed:
- ----- Method: TextEditor>>findAgain: (in category 'typing/selecting keys') -----
- findAgain: aKeyboardEvent
- "Find the desired text again."
-
- self
- insertAndCloseTypeIn;
- findAgain.
-
- ^ true!
Item was removed:
- ----- Method: TextEditor>>findAgainNow (in category 'typing support') -----
- findAgainNow
-
- | where |
- where := self text
- findString: FindText
- startingAt: self stopIndex
- caseSensitive: Preferences caseSensitiveFinds.
-
- where = 0
- ifTrue: [self selectFrom: self stopIndex to: self stopIndex - 1]
- ifFalse: [self selectFrom: where to: where + FindText size - 1].
-
- ^ true!
Item was removed:
- ----- Method: TextEditor>>findReplace (in category 'menu messages') -----
- findReplace
-
- self
- setSearchFromSelectionOrHistory;
- setReplacementFromHistory.
-
- (Project uiManager
- request: 'Find what to replace?' translated
- initialAnswer: FindText)
- ifNotEmpty: [:find |
-
- (Project uiManager
- request: ('Replace ''{1}'' with?' translated format: {find})
- initialAnswer: (ChangeText ifEmpty: [find])
- onCancelReturn: nil)
- ifNotNil: [:replace |
-
- FindText := find.
- ChangeText := replace.
- self findReplaceAgainNow]]!
Item was removed:
- ----- Method: TextEditor>>findReplace: (in category 'typing/selecting keys') -----
- findReplace: aKeyboardEvent
-
- self
- insertAndCloseTypeIn;
- findReplace.
-
- ^ true!
Item was removed:
- ----- Method: TextEditor>>findReplaceAgain (in category 'menu messages') -----
- findReplaceAgain
-
- ^ self again!
Item was removed:
- ----- Method: TextEditor>>findReplaceAgain: (in category 'typing/selecting keys') -----
- findReplaceAgain: aKeyboardEvent
-
- self
- insertAndCloseTypeIn;
- findReplaceAgain.
-
- ^ true!
Item was removed:
- ----- Method: TextEditor>>findReplaceAgainNow (in category 'typing support') -----
- findReplaceAgainNow
-
- self hasSelection ifTrue: [
- "Search from the beginning of the current selection. Supports a nice combination with regular find feature."
- self selectInvisiblyFrom: self startIndex to: self startIndex - 1].
-
- self findAgainNow.
- self hasSelection ifFalse: [^ false].
-
- self replaceSelectionWith: ChangeText.
- self findAgainNow. "Select possible next thing to replace."
-
- ^ true!
Item was removed:
- ----- Method: TextEditor>>flash (in category 'displaying') -----
- flash
- ^ morph flash!
Item was removed:
- ----- Method: TextEditor>>forwardDelete: (in category 'typing/selecting keys') -----
- forwardDelete: aKeyboardEvent
- "Delete forward over the next character.
- Make Undo work on the whole type-in, not just the one char.
- wod 11/3/1998: If there was a selection use #zapSelectionWith: rather than #backspace: which was 'one off' in deleting the selection. Handling of things like undo or typeIn area were not fully considered."
-
- | startIndex stopIndex |
- morph readOnly ifTrue: [^ self].
-
- self hasSelection ifTrue: [
- "Create checkpoint in history."
- self replaceSelectionWith: self nullText.
- ^ true].
-
- startIndex := self markIndex.
- startIndex > self text size ifTrue: [^ false].
-
- stopIndex := startIndex.
-
- "Forward delete next word"
- self flag: #consistency. "mt: We might want to implemented it like #backspace: and #backWord:."
- aKeyboardEvent shiftPressed
- ifTrue: [stopIndex := (self firstWordBoundaryAfter: stopIndex) - 1].
-
- self selectInvisiblyFrom: startIndex to: stopIndex.
-
- self isTypingIn ifTrue: [
- self history current type = #forwardDelete
- ifFalse: [self closeTypeIn]
- ifTrue: [
- "Append next characters that will be removed."
- self history current contentsBefore append: self selection.
- self history current intervalBefore in: [:i |
- self history current intervalBefore: (i first to: i last + (stopIndex - startIndex + 1))]]].
-
- self openTypeInFor: #forwardDelete.
- self zapSelectionWith: self nullText.
-
- ^ false!
Item was removed:
- ----- Method: TextEditor>>handleEmphasisExtra:with: (in category 'editing keys') -----
- handleEmphasisExtra: index with: aKeyboardEvent
- "Handle an emphasis extra choice"
- ^true!
Item was removed:
- ----- Method: TextEditor>>hasCaret (in category 'accessing-selection') -----
- hasCaret
- ^ markBlock = pointBlock!
Item was removed:
- ----- Method: TextEditor>>hasMultipleLinesSelected (in category 'typing support') -----
- hasMultipleLinesSelected
- ^ self selection includesAnyOf: CharacterSet crlf!
Item was removed:
- ----- Method: TextEditor>>hiddenInfo (in category 'editing keys') -----
- hiddenInfo
- "In TextLinks, TextDoits, TextColor, and TextURLs, there is hidden info. Return the entire string that was used by Cmd-6 to create this text attribute. Usually enclosed in < >."
-
- | attrList |
- attrList := self text attributesAt: (self pointIndex + self markIndex)//2.
- attrList do: [:attr |
- (attr isKindOf: TextAction) ifTrue:
- [^ self selection asString, '<', attr info, '>']].
- "If none of the above"
- attrList do: [:attr |
- attr class == TextColor ifTrue:
- [^ self selection asString, '<', attr color printString, '>']].
- ^ self selection asString, '[No hidden info]'!
Item was removed:
- ----- Method: TextEditor>>history (in category 'accessing') -----
- history
- ^ history!
Item was removed:
- ----- Method: TextEditor>>history: (in category 'accessing') -----
- history: commandHistory
- history := commandHistory.!
Item was removed:
- ----- Method: TextEditor>>implementorsOfIt (in category 'menu messages') -----
- implementorsOfIt
- "Open an implementors browser on the selected selector"
-
- self lineSelectAndEmptyCheck: [^ self].
- self selectedSelector ifNotNil:
- [:aSelector| ^self model browseAllImplementorsOf: aSelector requestor: morph].
- self selectedLiteral ifNotNil:
- [:aLiteral| ^self model browseAllImplementorsOf: aLiteral requestor: morph].
- morph flash.!
Item was removed:
- ----- Method: TextEditor>>implementorsOfIt: (in category 'editing keys') -----
- implementorsOfIt: aKeyboardEvent
- "Triggered by Cmd-m; browse implementors of the selector represented by the current selection, if plausible. 2/1/96 sw"
-
- self implementorsOfIt.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>inOutdent:delta: (in category 'editing keys') -----
- inOutdent: aKeyboardEvent delta: delta
- "Add/remove a tab at the front of every line occupied by the selection. Flushes typeahead. Derived from work by Larry Tesler back in December 1985. Now triggered by Cmd-L and Cmd-R. 2/29/96 sw"
-
- | realStart realStop lines startLine stopLine start stop adjustStart "indentation" numLines oldText newText newSize |
-
- "Operate on entire lines, but remember the real selection for re-highlighting later"
- realStart := self startIndex.
- realStop := self stopIndex - 1.
-
- "Special case a caret on a line of its own, including weird case at end of paragraph"
- (realStart > realStop and:
- [realStart < 2 or: [(paragraph string at: realStart - 1) == Character cr or: [(paragraph string at: realStart - 1) == Character lf]]])
- ifTrue:
- [delta < 0
- ifTrue:
- [morph flash]
- ifFalse:
- [self replaceSelectionWith: Character tab asText.
- self selectAt: realStart + 1].
- ^true].
-
- lines := paragraph lines.
- startLine := paragraph lineIndexOfCharacterIndex: realStart.
- "start on a real line, not a wrapped line"
- [startLine = 1 or: [CharacterSet crlf includes: (paragraph string at: (lines at: startLine-1) last)]] whileFalse: [startLine := startLine - 1].
- stopLine := paragraph lineIndexOfCharacterIndex: (realStart max: realStop).
- start := (lines at: startLine) first.
- stop := (lines at: stopLine) last.
-
- "Pin the start of highlighting unless the selection starts a line"
- adjustStart := realStart > start.
-
- "Find the indentation of the least-indented non-blank line; never outdent more"
- "indentation := (startLine to: stopLine) inject: 1000 into:
- [:m :l |
- m min: (paragraph indentationOfLineIndex: l ifBlank: [:tabs | 1000])].
- indentation + delta <= 0 ifTrue: [^false]."
-
- numLines := stopLine + 1 - startLine.
- oldText := paragraph text copyFrom: start to: stop.
- newText := oldText species new: oldText size + ((numLines * delta) max: 0).
-
- "Do the actual work"
- newSize := 0.
- delta > 0
- ifTrue: [| tabs |
- tabs := oldText species new: delta withAll: Character tab.
- oldText string lineIndicesDo: [:startL :endWithoutDelimiters :endL |
- startL < endWithoutDelimiters ifTrue: [newText replaceFrom: 1 + newSize to: (newSize := newSize + delta) with: tabs startingAt: 1].
- newText replaceFrom: 1 + newSize to: (newSize := 1 + newSize + endL - startL) with: oldText startingAt: startL]]
- ifFalse: [| tab |
- tab := Character tab.
- oldText string lineIndicesDo: [:startL :endWithoutDelimiters :endL |
- | i |
- i := 0.
- [i + delta < 0 and: [ i + startL <= endWithoutDelimiters and: [(oldText at: i + startL) == tab]]] whileTrue: [i := i + 1].
- newText replaceFrom: 1 + newSize to: (newSize := 1 + newSize + endL - (i + startL)) with: oldText startingAt: i + startL]].
- newSize < newText size ifTrue: [newText := newText copyFrom: 1 to: newSize].
-
- "Adjust the range that will be highlighted later"
- adjustStart ifTrue: [realStart := (realStart + delta) max: start].
- realStop := realStop + newSize - oldText size.
-
- "Replace selection"
- self selectInvisiblyFrom: start to: stop.
- self replaceSelectionWith: newText.
- self selectFrom: realStart to: realStop. "highlight only the original range"
- ^ true!
Item was removed:
- ----- Method: TextEditor>>indent: (in category 'editing keys') -----
- indent: aKeyboardEvent
- "Add a tab at the front of every line occupied by the selection. Invoked from keyboard via cmd-shift-R. 2/29/96 sw"
-
- ^ self inOutdent: aKeyboardEvent delta: 1!
Item was removed:
- ----- Method: TextEditor>>indent:fromStream:toStream: (in category 'private') -----
- indent: delta fromStream: inStream toStream: outStream
- "Append the contents of inStream to outStream, adding or deleting delta or -delta
- tabs at the beginning, and after every CR except a final CR. Do not add tabs
- to totally empty lines, and be sure nothing but tabs are removed from lines."
-
- | ch skip cr tab prev atEnd |
- cr := Character cr.
- tab := Character tab.
- delta > 0
- ifTrue: "shift right"
- [prev := cr.
- [ch := (atEnd := inStream atEnd) ifTrue: [cr] ifFalse: [inStream next].
- (prev == cr and: [ch ~~ cr]) ifTrue:
- [delta timesRepeat: [outStream nextPut: tab]].
- atEnd]
- whileFalse:
- [outStream nextPut: ch.
- prev := ch]]
- ifFalse: "shift left"
- [skip := delta. "a negative number"
- [inStream atEnd] whileFalse:
- [((ch := inStream next) == tab and: [skip < 0]) ifFalse:
- [outStream nextPut: ch].
- skip := ch == cr ifTrue: [delta] ifFalse: [skip + 1]]]!
Item was removed:
- ----- Method: TextEditor>>indexOfNextNonwhitespaceCharacter (in category 'private') -----
- indexOfNextNonwhitespaceCharacter
- pointBlock stringIndex
- to: paragraph string size
- do:
- [ : n | | char | (char := paragraph string at: n) isSeparator ifFalse: [ ^ n ] ].
- ^ nil!
Item was removed:
- ----- Method: TextEditor>>insertAndCloseTypeIn (in category 'typing support') -----
- insertAndCloseTypeIn
- self
- insertTypeAhead ;
- closeTypeIn!
Item was removed:
- ----- Method: TextEditor>>insertAndSelect:at: (in category 'new selection') -----
- insertAndSelect: aStringOrText at: anInteger
-
- | spacer |
- self closeTypeIn.
- self selectInvisiblyFrom: anInteger to: anInteger - 1.
- self openTypeIn.
-
- spacer := Text string: ' ' attributes: emphasisHere.
-
- self
- replace: self selectionInterval
- with: (aStringOrText isString
- ifTrue: [spacer, (Text string: aStringOrText attributes: emphasisHere)]
- ifFalse: [spacer, aStringOrText, spacer "Extra spacer for type-in after insertion with current emphasis."])
- and: [].
- self closeTypeIn.!
Item was removed:
- ----- Method: TextEditor>>insertTypeAhead (in category 'typing support') -----
- insertTypeAhead
- self typeAhead position = 0 ifFalse:
- [self zapSelectionWith: (Text string: self typeAhead contents emphasis: emphasisHere).
- self typeAhead reset.
- self unselect]!
Item was removed:
- ----- Method: TextEditor>>inspectIt (in category 'do-its') -----
- inspectIt
-
- self evaluateSelectionAndDo: [:result |
- (model respondsTo: #inspectIt:result:)
- ifTrue: [model
- perform: #inspectIt:result:
- with: self selection
- with: result]
- ifFalse: [ToolSet inspect: result]].!
Item was removed:
- ----- Method: TextEditor>>inspectIt: (in category 'editing keys') -----
- inspectIt: aKeyboardEvent
- "Inspect the selection -- invoked via cmd-i. If there is no current selection, use the current line. 1/17/96 sw
- 2/29/96 sw: don't call selectLine; it's done by inspectIt now"
-
- self inspectIt.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>isDisjointFrom: (in category 'private') -----
- isDisjointFrom: anInterval
- "Answer true if anInterval is a caret not touching or within the current
- interval, or if anInterval is a non-caret that does not overlap the current
- selection."
-
- | fudge |
- fudge := anInterval size = 0 ifTrue: [1] ifFalse: [0].
- ^(anInterval last + fudge < self startIndex or:
- [anInterval first - fudge >= self stopIndex])
- !
Item was removed:
- ----- Method: TextEditor>>isEventInSelection: (in category 'events') -----
- isEventInSelection: evt
- "Check whether the event position is within the current selection."
-
- | pt a b |
- self hasSelection ifFalse: [^ false].
-
- pt := evt position.
- a := self startBlock.
- b := self stopBlock.
-
- ^ (pt >= a topLeft and: [pt <= b bottomLeft]) "Start and stop in same line"
- or: [
- a top < b top and: [ "Start and stop in different lines."
- ((pt y > a bottom and: [pt y < b top]) "Fully selected lines in the middle."
- or: [pt x >= a left and: [pt y between: a top and: a bottom]]) "Top tail."
- or: [pt x <= b left and: [pt y between: b top and: b bottom]]]]. "Bottom tail."
-
-
-
-
- !
Item was removed:
- ----- Method: TextEditor>>isTypingIn (in category 'typing support') -----
- isTypingIn
- ^ beginTypeInIndex notNil!
Item was removed:
- ----- Method: TextEditor>>keyStroke: (in category 'events') -----
- keyStroke: anEvent
- self resetTypeAhead.
-
- (self dispatchOnKeyboardEvent: anEvent)
- ifTrue: [
- self closeTypeIn.
- self storeSelectionInParagraph.
- ^self].
-
- self openTypeIn.
- self
- zapSelectionWith: self typeAhead contents;
- resetTypeAhead;
- unselect;
- storeSelectionInParagraph.!
Item was removed:
- ----- Method: TextEditor>>makeCapitalized: (in category 'editing keys') -----
- makeCapitalized: aKeyboardEvent
- "Force the current selection to uppercase."
-
- | prev |
- prev := $-. "not a letter"
- self replaceSelectionWith:
- (self selection string collect:
- [:c | prev := prev isLetter ifTrue: [c asLowercase] ifFalse: [c asUppercase]]).
- ^ true!
Item was removed:
- ----- Method: TextEditor>>makeLowercase: (in category 'editing keys') -----
- makeLowercase: aKeyboardEvent
- "Force the current selection to lowercase. Triggered by Cmd-X."
-
- self replaceSelectionWith: (self selection string asLowercase).
- ^ true!
Item was removed:
- ----- Method: TextEditor>>makeProjectLink (in category 'menu commands') -----
- makeProjectLink
- | attribute thisSel |
-
- thisSel := self selection.
-
- attribute := TextSqkProjectLink new.
- thisSel := attribute analyze: self selection asString.
-
- thisSel ifNil: [^ true].
- self replaceSelectionWith: (thisSel asText addAttribute: attribute).
- ^ true!
Item was removed:
- ----- Method: TextEditor>>makeUppercase: (in category 'editing keys') -----
- makeUppercase: aKeyboardEvent
- "Force the current selection to uppercase. Triggered by Cmd-Y."
-
- self replaceSelectionWith: (self selection string asUppercase).
- ^ true!
Item was removed:
- ----- Method: TextEditor>>markIndex (in category 'accessing-selection') -----
- markIndex
- ^ markBlock stringIndex!
Item was removed:
- ----- Method: TextEditor>>markIndex:pointIndex: (in category 'accessing-selection') -----
- markIndex: anIndex pointIndex: anotherIndex
- "Called, for example, when selecting text with shift+arrow keys"
- markBlock := paragraph characterBlockForIndex: anIndex.
- pointBlock := paragraph characterBlockForIndex: anotherIndex!
Item was removed:
- ----- Method: TextEditor>>methodNamesContainingIt (in category 'menu messages') -----
- methodNamesContainingIt
- "Open a browser on methods names containing the selected string"
-
- self lineSelectAndEmptyCheck: [^ self].
- Cursor wait showWhile:
- [self systemNavigation browseMethodsWhoseNamesContain: self selection string withBlanksTrimmed].
- Cursor normal show!
Item was removed:
- ----- Method: TextEditor>>methodNamesContainingIt: (in category 'editing keys') -----
- methodNamesContainingIt: aKeyboardEvent
- "Browse methods whose selectors containing the selection in their names"
-
- self methodNamesContainingIt.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>methodSourceContainingIt (in category 'menu messages') -----
- methodSourceContainingIt
- "Open a browser on methods which contain the current selection in their source (case-sensitive full-text search of source). Slow!!"
-
- self lineSelectAndEmptyCheck: [^ self].
- self systemNavigation browseMethodsWithSourceString: self selection string!
Item was removed:
- ----- Method: TextEditor>>methodStringsContainingIt: (in category 'editing keys') -----
- methodStringsContainingIt: aKeyboardEvent
- "Invoked from cmd-E -- open a browser on all methods holding string constants containing it. Flushes typeahead. "
-
- self methodStringsContainingit.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>methodStringsContainingit (in category 'menu messages') -----
- methodStringsContainingit
- "Open a browser on methods which contain the current selection as part of a string constant."
-
- self lineSelectAndEmptyCheck: [^ self].
- self systemNavigation browseMethodsWithString: self selection string!
Item was removed:
- ----- Method: TextEditor>>model (in category 'accessing') -----
- model
-
- ^model!
Item was removed:
- ----- Method: TextEditor>>model: (in category 'model access') -----
- model: aModel
- model := aModel!
Item was removed:
- ----- Method: TextEditor>>mouseDown: (in category 'events') -----
- mouseDown: evt
- "Either 1) handle text actions in the paragraph, 2) begin a text drag operation, or 3) modify the caret/selection."
-
- | clickPoint b |
-
- oldInterval := self selectionInterval.
- clickPoint := evt cursorPoint.
- b := paragraph characterBlockAtPoint: clickPoint.
-
- (paragraph clickAt: clickPoint for: model controller: self) ifTrue: [
- self flag: #note. "mt: Do not reset the current text selection for successful text actions. Leave markBlock and pointBlock as is. This behavior matches the one in web browsers when clicking on links."
- evt hand releaseKeyboardFocus: morph.
- evt hand releaseMouseFocus: morph.
- ^ self ].
-
- (morph dragEnabled and: [self isEventInSelection: evt]) ifTrue: [
- evt hand
- waitForClicksOrDrag: morph
- event: evt
- selectors: {#click:. nil. nil. #startDrag:}
- threshold: HandMorph dragThreshold.
- morph setProperty: #waitingForTextDrag toValue: true.
- ^ self].
-
- evt shiftPressed
- ifFalse: [
- self closeTypeIn.
- markBlock := b.
- pointBlock := b ]
- ifTrue: [
- self closeTypeIn.
- self mouseMove: evt ].
- self storeSelectionInParagraph!
Item was removed:
- ----- Method: TextEditor>>mouseMove: (in category 'events') -----
- mouseMove: evt
- "Change the selection in response to mouse-down drag. Do not change the selection if the user wants to drag the current selection."
-
- (morph hasProperty: #waitingForTextDrag) ifTrue: [^ self].
- pointBlock := paragraph characterBlockAtPoint: evt position.
- self storeSelectionInParagraph!
Item was removed:
- ----- Method: TextEditor>>mouseUp: (in category 'events') -----
- mouseUp: evt
- "An attempt to break up the old processRedButton code into threee phases"
-
- oldInterval ifNil: [^ self]. "Patched during clickAt: repair"
- (self hasCaret
- and: [oldInterval = self selectionInterval])
- ifTrue: [self selectWord].
- self setEmphasisHere.
- (self isDisjointFrom: oldInterval) ifTrue:
- [otherInterval := oldInterval].
- self storeSelectionInParagraph.
-
- self updateCursorForEvent: evt.
- morph removeProperty: #waitingForTextDrag.!
Item was removed:
- ----- Method: TextEditor>>moveCursor:forward:event:specialBlock: (in category 'private') -----
- moveCursor: directionBlock forward: forward event: aKeyboardEvent specialBlock: specialBlock
- super moveCursor: directionBlock forward: forward event: aKeyboardEvent specialBlock: specialBlock.
- self setEmphasisHere!
Item was removed:
- ----- Method: TextEditor>>nextTokenFrom:direction: (in category 'new selection') -----
- nextTokenFrom: start direction: dir
- "simple token-finder for compiler automated corrections"
- | loc str |
- loc := start + dir.
- str := paragraph string.
- [(loc between: 1 and: str size) and: [(str at: loc) isSeparator]]
- whileTrue: [loc := loc + dir].
- ^ loc!
Item was removed:
- ----- Method: TextEditor>>notify:at:in: (in category 'new selection') -----
- notify: aString at: anInteger in: aStream
- "The compilation of text failed. The syntax error is noted as the argument,
- aString. Insert it in the text at starting character position anInteger."
-
- self insertAndSelect: aString at: (anInteger max: 1)!
Item was removed:
- ----- Method: TextEditor>>nullText (in category 'private') -----
- nullText
-
- ^Text string: '' attributes: emphasisHere!
Item was removed:
- ----- Method: TextEditor>>offerFontMenu (in category 'attributes') -----
- offerFontMenu
- "Present a menu of available fonts, and if one is chosen, apply it to the current selection.
- Use only names of Fonts of this paragraph "
-
- ^self changeTextFont!
Item was removed:
- ----- Method: TextEditor>>offerFontMenu: (in category 'editing keys') -----
- offerFontMenu: aKeyboardEvent
- "The user typed the command key that requests a font change; Offer the font menu. 5/27/96 sw"
-
- self insertAndCloseTypeIn.
- self offerFontMenu.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>offerMenuFromEsc: (in category 'menu commands') -----
- offerMenuFromEsc: aKeyboardEvent
- "The escape key was hit while the receiver has the keyboard focus; take action."
-
- aKeyboardEvent shiftPressed ifFalse: [
- self raiseContextMenu: aKeyboardEvent].
- ^ true!
Item was removed:
- ----- Method: TextEditor>>openTypeIn (in category 'typing support') -----
- openTypeIn
-
- self openTypeInFor: nil.!
Item was removed:
- ----- Method: TextEditor>>openTypeInFor: (in category 'typing support') -----
- openTypeInFor: editType
- "Set up UndoSelection to null text (to be added to by readKeyboard and backTo:),
- beginTypeInBlock to keep track of the leftmost backspace, and UndoParameter to tally
- how many deleted characters were backspaced over rather than 'cut'.
- You can't undo typing until after closeTypeIn."
-
- beginTypeInIndex ifNil:
- [beginTypeInIndex := self startIndex.
- self history ifNotNil:
- [:myHistory|
- myHistory beginRemember:
- (TextEditorCommand new
- type: editType;
- contentsBefore: (self hasSelection ifTrue: [self selection] ifFalse: [self nullText]);
- intervalBefore: (beginTypeInIndex to: self stopIndex-1)
- yourself)]]!
Item was removed:
- ----- Method: TextEditor>>outdent: (in category 'editing keys') -----
- outdent: aKeyboardEvent
- "Remove a tab from the front of every line occupied by the selection.
- Invoked from keyboard via cmd-shift-L. 2/29/96 sw"
-
- ^ self inOutdent: aKeyboardEvent delta: -1!
Item was removed:
- ----- Method: TextEditor>>pageHeight (in category 'private') -----
- pageHeight
- | howManyLines visibleHeight totalHeight ratio |
- howManyLines := paragraph numberOfLines.
- visibleHeight := self visibleHeight.
- totalHeight := self totalTextHeight.
- ratio := visibleHeight / totalHeight.
- ^(ratio * howManyLines) rounded - 2!
Item was removed:
- ----- Method: TextEditor>>paragraph (in category 'accessing') -----
- paragraph
-
- ^paragraph!
Item was removed:
- ----- Method: TextEditor>>paste (in category 'menu messages') -----
- paste
- "Update command history."
-
- self openTypeIn.
- super paste.
- self closeTypeIn.!
Item was removed:
- ----- Method: TextEditor>>pasteInitials: (in category 'editing keys') -----
- pasteInitials: aKeyboardEvent
- "Replace the current text selection by an authorship name/date stamp; invoked by cmd-shift-v, easy way to put an authorship stamp in the comments of an editor."
-
- self insertAndCloseTypeIn.
- self openTypeIn.
- self replace: self selectionInterval with: (Text fromString: Utilities changeStamp) and: [self selectAt: self stopIndex].
- self closeTypeIn.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>pasteRecent (in category 'menu messages') -----
- pasteRecent
- "Paste an item chose from RecentClippings."
-
- | clipping |
- (clipping := Clipboard chooseRecentClipping) ifNil: [^ self].
- Clipboard clipboardText: clipping.
- ^ self paste!
Item was removed:
- ----- Method: TextEditor>>pointBlock (in category 'accessing-selection') -----
- pointBlock
- ^ pointBlock!
Item was removed:
- ----- Method: TextEditor>>pointIndex (in category 'accessing-selection') -----
- pointIndex
- ^ pointBlock stringIndex!
Item was removed:
- ----- Method: TextEditor>>prettyPrint (in category 'menu messages') -----
- prettyPrint
- self prettyPrint: false!
Item was removed:
- ----- Method: TextEditor>>prettyPrint: (in category 'menu messages') -----
- prettyPrint: decorated
- "Reformat the contents of the receiver's view (a Browser or Workspace)."
-
- model selectedClassOrMetaClass
- ifNil: [ "arbitrary text selection in a workspace, not directly associated with a class"
- (Compiler new formatNoPattern: self selection environment: model environment)
- ifNotNil: [:newText | self replaceSelectionWith: newText]]
- ifNotNil: [:selectedClass | "source for a method in the selected class"
- (selectedClass newCompiler
- format: self text
- in: selectedClass
- notifying: self
- decorated: decorated)
- ifNotNil: [ :newText |
- self selectInvisiblyFrom: 1 to: paragraph text size.
- self replaceSelectionWith: (selectedClass ifNil: [newText] ifNotNil: [newText asText makeSelectorBoldIn: selectedClass]).
- self selectAt: self text size + 1 ]].
- !
Item was removed:
- ----- Method: TextEditor>>prettyPrintWithColor (in category 'menu messages') -----
- prettyPrintWithColor
- self prettyPrint: true!
Item was removed:
- ----- Method: TextEditor>>printIt (in category 'do-its') -----
- printIt
-
- self evaluateSelectionAndDo: [:result |
- (model respondsTo: #printIt:result:)
- ifTrue: [model
- perform: #printIt:result:
- with: self selection
- with: result]
- ifFalse: [self afterSelectionInsertAndSelect: (self printItTextFor: result)]]!
Item was removed:
- ----- Method: TextEditor>>printIt: (in category 'editing keys') -----
- printIt: aKeyboardEvent
- "Print the results of evaluting the selection -- invoked via cmd-p. If there is no current selection, use the current line. 1/17/96 sw
- 2/29/96 sw: don't call selectLine now, since it's called by doIt"
-
- self printIt.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>printItTextFor: (in category 'do-its') -----
- printItTextFor: anObject
-
- self flag: #todo. "mt: Maybe reserve highlights for non-primitive structures only? Maybe skip ByteString, ByteSymbol, Number, Boolean, UndefinedObject? See discussion here: http://forum.world.st/The-Inbox-Morphic-ct-1586-mcz-tp5106774p5129065.html"
-
- ^ self class interactivePrintIt
- ifFalse: [anObject printString]
- ifTrue: [Text string: anObject printString attribute: (TextInspectIt on: anObject)]!
Item was removed:
- ----- Method: TextEditor>>printerSetup (in category 'menu messages') -----
- printerSetup
- "copied from ParagraphEditor"
- TextPrinter defaultTextPrinter inspect
- !
Item was removed:
- ----- Method: TextEditor>>querySymbol: (in category 'typing/selecting keys') -----
- querySymbol: aKeyboardEvent
- "Invoked by Ctrl-q to query the Symbol table and display alternate symbols."
-
- | hintText lastOffering offering |
- (self isTypingIn not or: [self history current type ~= #query])
- ifTrue: [
- self closeTypeIn.
- self openTypeIn.
- self selectPrecedingIdentifier.
- self closeTypeIn].
-
- self openTypeInFor: #query.
-
- hintText := self history current contentsBefore string.
- hintText := hintText copyFrom: (hintText
- lastIndexOfAnyOf: Character separators, '#'
- startingAt: hintText size) + 1 to: hintText size.
- self selectInvisiblyFrom: self history current intervalBefore first to: self stopIndex-1.
- lastOffering := self selection string.
- lastOffering := (lastOffering copyReplaceAll: ': ' with: ':') withBlanksTrimmed.
-
- "Only offer suggestions for not-empty tokens."
- hintText ifEmpty: [morph flash. self closeTypeIn. ^ true].
- offering := Symbol thatStarts: hintText skipping: lastOffering.
- offering ifNil: [offering := Symbol thatStarts: hintText skipping: nil].
- offering ifNil: [morph flash. self closeTypeIn. ^ true].
-
- "Add some nice spacing to the suggestion."
- offering := offering copyReplaceAll: ':' with: ': '.
- offering last = Character space ifTrue: [offering := offering allButLast].
-
- "Insert the suggestions. (Note that due to previous selection, things will be overwritten and not appended.)"
- self typeAhead nextPutAll: offering.
-
- ^ false!
Item was removed:
- ----- Method: TextEditor>>raiseContextMenu: (in category 'nonediting/nontyping keys') -----
- raiseContextMenu: aKeyboardEvent
- (morph respondsTo: #editView)
- ifTrue: [morph editView yellowButtonActivity: false].
- ^ true!
Item was removed:
- ----- Method: TextEditor>>recomputeSelection (in category 'current selection') -----
- recomputeSelection
- "The same characters are selected but their coordinates may have changed."
-
- self markIndex: self markIndex pointIndex: self pointIndex!
Item was removed:
- ----- Method: TextEditor>>redo (in category 'menu messages') -----
- redo
-
- self closeTypeIn.
- self history redoIn: self.!
Item was removed:
- ----- Method: TextEditor>>redo: (in category 'editing keys') -----
- redo: aKeyboardEvent
- "Redo the last edit."
-
- self insertAndCloseTypeIn.
- self redo.
- ^true!
Item was removed:
- ----- Method: TextEditor>>redoAndReselect (in category 'undo') -----
- redoAndReselect
-
- self
- replace: self history current intervalBefore
- with: self history current contentsAfter
- and: [self selectInterval: self history current intervalAfter].!
Item was removed:
- ----- Method: TextEditor>>referencesToIt (in category 'menu messages') -----
- referencesToIt
- "Open a MessageSet with the references to the selected global or variable name."
-
- self wordSelectAndEmptyCheck: [^ self].
- self selectedInstanceVariable ifNotNil:
- [:nameToClass | ^ self systemNavigation
- browseAllAccessesTo: nameToClass key
- from: nameToClass value].
- self selectedBinding ifNotNil:
- [:binding | ^ self systemNavigation browseAllCallsOnClass: binding].
- morph flash.!
Item was removed:
- ----- Method: TextEditor>>referencesToIt: (in category 'editing keys') -----
- referencesToIt: aKeyboardEvent
- "Triggered by Cmd-N; browse references to the current selection"
-
- self referencesToIt.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>removePreviousInsertion (in category 'typing support') -----
- removePreviousInsertion
- "If the previous command was an insertion, remove it by not undoing it but replacing it with nothing."
-
- self history hasInsertedSomething ifFalse: [morph flash. ^ false].
-
- self
- selectInvisiblyFrom: self history previous intervalBefore first
- to: self history previous intervalAfter last.
-
- self replaceSelectionWith: self nullText.
-
- ^ true
- !
Item was removed:
- ----- Method: TextEditor>>replace:with: (in category 'undo') -----
- replace: interval with: newText
-
- self
- replace: interval
- with: newText
- and: ["Do nothing."].!
Item was removed:
- ----- Method: TextEditor>>replace:with:and: (in category 'undo') -----
- replace: xoldInterval with: newText and: selectingBlock
- "Replace the text in oldInterval with newText and execute selectingBlock to establish the new selection. Create an undoAndReselect:redoAndReselect: undoer to allow perfect undoing."
-
- | undoInterval |
- undoInterval := self selectionInterval.
- undoInterval = xoldInterval ifFalse: [
- self selectInvisiblyFrom: xoldInterval start to: xoldInterval stop].
-
- self zapSelectionWith: newText.
- selectingBlock value.
-
- otherInterval := self selectionInterval.!
Item was removed:
- ----- Method: TextEditor>>replaceAllWith: (in category 'undo') -----
- replaceAllWith: aText
- "Like #paste but replacing all contents with aText."
-
- self closeTypeIn.
-
- self selectInvisiblyFrom: 1 to: self text size.
- self openTypeIn.
- self zapSelectionWith: aText.
- self closeTypeIn.!
Item was removed:
- ----- Method: TextEditor>>replaceSelectionWith: (in category 'undo') -----
- replaceSelectionWith: aText
- "Remember the selection text in UndoSelection.
- Deselect, and replace the selection text by aText.
- Remember the resulting selectionInterval in UndoInterval and PriorInterval.
- Set up undo to use UndoReplace."
-
- self openTypeIn.
- self zapSelectionWith: aText.
- self closeTypeIn.!
Item was removed:
- ----- Method: TextEditor>>resetState (in category 'initialize-release') -----
- resetState
- "Establish the initial conditions for editing the paragraph: place caret
- before first character, set the emphasis to that of the first character,
- and save the paragraph for purposes of canceling."
-
- pointBlock := markBlock := paragraph defaultCharacterBlock.
- beginTypeInIndex := nil.
- otherInterval := 1 to: 0.
- self setEmphasisHere.!
Item was removed:
- ----- Method: TextEditor>>resetTypeAhead (in category 'private') -----
- resetTypeAhead
- typeAhead := WriteStream on: (String new: 1)!
Item was removed:
- ----- Method: TextEditor>>sameColumn:newLine:forward: (in category 'private') -----
- sameColumn: start newLine: lineBlock forward: isForward
- "Private - Compute the index in my text
- with the line number derived from lineBlock,"
- " a one argument block accepting the old line number.
- The position inside the line will be preserved as good as possible"
- "The boolean isForward is used in the border case to determine if
- we should move to the beginning or the end of the line."
- | wordStyle column currentLine offsetAtTargetLine targetEOL lines numberOfLines currentLineNumber targetLineNumber |
- wordStyle := Preferences wordStyleCursorMovement.
- wordStyle
- ifTrue: [
- lines := paragraph lines.
- numberOfLines := paragraph numberOfLines.
- currentLineNumber := paragraph lineIndexOfCharacterIndex: start.
- currentLine := lines at: currentLineNumber]
- ifFalse: [
- lines := self lines.
- numberOfLines := lines size.
- currentLine := lines
- detect:[:lineInterval | lineInterval last >= start]
- ifNone:[lines last].
- currentLineNumber := currentLine second].
- column := start - currentLine first.
- targetLineNumber := ((lineBlock value: currentLineNumber) max: 1) min: numberOfLines.
- offsetAtTargetLine := (lines at: targetLineNumber) first.
- targetEOL := (lines at: targetLineNumber) last + (targetLineNumber = numberOfLines ifTrue:[1]ifFalse:[0]).
- targetLineNumber = currentLineNumber
- "No movement or movement failed. Move to beginning or end of line."
- ifTrue:[^isForward
- ifTrue:[targetEOL]
- ifFalse:[offsetAtTargetLine]].
- ^offsetAtTargetLine + column min: targetEOL.!
Item was removed:
- ----- Method: TextEditor>>save: (in category 'editing keys') -----
- save: aKeyboardEvent
- "Submit the current text. Equivalent to 'accept' 1/18/96 sw"
-
- self insertAndCloseTypeIn.
- self accept.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>scrollBy: (in category 'scrolling') -----
- scrollBy: ignore
- "Ignore scroll requests."!
Item was removed:
- ----- Method: TextEditor>>selectAndScroll (in category 'current selection') -----
- selectAndScroll
- "Ignore scroll requests."!
Item was removed:
- ----- Method: TextEditor>>selectCurrentTypeIn: (in category 'nonediting/nontyping keys') -----
- selectCurrentTypeIn: aKeyboardEvent
- "Select what would be replaced by an undo (e.g., the last typeIn)."
-
- | prior |
-
- self flag: #buggy.
- self insertAndCloseTypeIn.
- prior := otherInterval.
- self insertAndCloseTypeIn.
- otherInterval := prior.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>selectFrom:to: (in category 'new selection') -----
- selectFrom: start to: stop
- self closeTypeIn.
- "Select the specified characters inclusive."
- self selectInvisiblyFrom: start to: stop.
- self storeSelectionInParagraph.
- "Preserve current emphasis if selection is empty"
- stop > start ifTrue: [
- self setEmphasisHere ]!
Item was removed:
- ----- Method: TextEditor>>selectLine (in category 'new selection') -----
- selectLine
- "Make the receiver's selection, if it currently consists of an insertion point only, encompass the current line."
-
- self selectInterval: (self encompassLine: self selectionInterval)!
Item was removed:
- ----- Method: TextEditor>>selectPrecedingIdentifier (in category 'new selection') -----
- selectPrecedingIdentifier
- "Invisibly select the identifier that ends at the end of the selection, if any."
-
- | string sep stop tok |
- tok := false.
- string := paragraph string.
- stop := self stopIndex - 1.
- [stop > 0 and: [(string at: stop) isSeparator]] whileTrue: [stop := stop - 1].
- sep := stop.
- [sep > 0 and: [(string at: sep) tokenish]] whileTrue: [tok := true. sep := sep - 1].
- tok ifTrue: [self selectInvisiblyFrom: sep + 1 to: stop]!
Item was removed:
- ----- Method: TextEditor>>selectedBinding (in category 'menu messages') -----
- selectedBinding
- "Try to make a binding out of the current text selection. That binding can be a global or class."
-
- ^ self selectedSymbol ifNotNil:
- [ :symbol |
- ((model respondsTo: #selectedClassOrMetaClass)
- ifTrue: [ model selectedClassOrMetaClass ifNil: [ model environment ] ]
- ifFalse: [ model environment ]) ifNotNil:
- [ :environment | environment bindingOf: symbol ] ]!
Item was removed:
- ----- Method: TextEditor>>selectedClassVariable (in category 'menu messages') -----
- selectedClassVariable
- "Try to make a class-variable binding out of the current text selection."
-
- (model respondsTo: #selectedClassOrMetaClass) ifFalse: [ ^ nil ].
-
- ^ self selectedSymbol ifNotNil:
- [ :symbol | model selectedClassOrMetaClass ifNotNil:
- [ :classOrMetaClass | (classOrMetaClass theNonMetaClass allClassVarNames includes: symbol)
- ifTrue: [ classOrMetaClass bindingOf: symbol ]
- ifFalse: [ nil ] ] ]!
Item was removed:
- ----- Method: TextEditor>>selectedInstanceVariable (in category 'menu messages') -----
- selectedInstanceVariable
- "Try to make an association from an instance-variable name to the class where this variable is defined. Make the implementation robust for models that do not know about classes.
-
- Note that inst-var names might not have symbol a representation, only via their accessors."
-
- (model respondsTo: #selectedClassOrMetaClass) ifFalse: [ ^ nil ].
-
- ^ self selection string ifNotNil:
- [ :token | model selectedClassOrMetaClass ifNotNil:
- [ :behavior |
- (behavior instVarIndexFor: token ifAbsent: [ 0 ]) ~= 0
- ifTrue: [ token -> behavior ]
- ifFalse: [ nil ] ] ]!
Item was removed:
- ----- Method: TextEditor>>selectedLiteral (in category 'menu messages') -----
- selectedLiteral
- "Try to make a Smalltalk literal out of the current text selection."
-
- ^ self selection string findLiteral!
Item was removed:
- ----- Method: TextEditor>>selectedSelector (in category 'menu messages') -----
- selectedSelector
- "Try to make a selector out of the current text selection."
-
- ^ self selection string findSelector!
Item was removed:
- ----- Method: TextEditor>>selectedSymbol (in category 'menu messages') -----
- selectedSymbol
- "Try to make a symbol out of the current text selection."
-
- ^ self selection string findSymbol!
Item was removed:
- ----- Method: TextEditor>>selection (in category 'accessing-selection') -----
- selection
- "Answer the text in the paragraph that is currently selected."
-
- | result |
- result := paragraph text copyFrom: self startIndex to: self stopIndex - 1.
- result ifNotEmpty: [
- result removeAttributesThat: [:attr | attr isOblivious]].
- ^ result!
Item was removed:
- ----- Method: TextEditor>>selectionAsStream (in category 'accessing-selection') -----
- selectionAsStream
- "Answer a ReadStream on the text in the paragraph that is currently selected."
-
- ^ReadStream
- on: paragraph string
- from: self startIndex
- to: self stopIndex - 1!
Item was removed:
- ----- Method: TextEditor>>sendContentsToPrinterWithLabel: (in category 'menu messages') -----
- sendContentsToPrinterWithLabel: label
- | textToPrint printer |
- textToPrint := paragraph text.
- textToPrint size = 0 ifTrue: [^self inform: 'nothing to print.'].
- printer := TextPrinter defaultTextPrinter.
- printer documentTitle: (label ifNil: ['Untitled']).
- printer printText: textToPrint!
Item was removed:
- ----- Method: TextEditor>>sendersOfIt (in category 'menu messages') -----
- sendersOfIt
- "Open a senders browser on the selected selector"
-
- self lineSelectAndEmptyCheck: [^ self].
- self selectedSelector ifNotNil: [:aSelector |
- ^ self model browseAllCallsOn: aSelector requestor: morph].
- self selectedLiteral ifNotNil: [:aLiteral |
- ^ self model browseAllCallsOn: aLiteral requestor: morph].
- morph flash.!
Item was removed:
- ----- Method: TextEditor>>sendersOfIt: (in category 'editing keys') -----
- sendersOfIt: aKeyboardEvent
- "Triggered by Cmd-n; browse implementors of the selector represented by the current selection, if plausible. 2/1/96 sw"
-
- self sendersOfIt.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>setAlignment: (in category 'menu messages') -----
- setAlignment: selectionString
- | attr interval |
- attr := selectionString
- caseOf:
- { [ 'indented' ] -> [ TextIndent amount: 1 ].
- [ 'indented more' ] -> [ TextIndent amount: self existingIndentation+1 ].
- [ 'indented less' ] -> [ TextIndent amount: (self existingIndentation-1 max: 0) ]}
- otherwise:
- [ TextAlignment perform: selectionString asSymbol ].
- interval := self encompassLine: self selectionInterval.
- paragraph
- replaceFrom: interval first
- to: interval last
- with: ((paragraph text copyFrom: interval first to: interval last) addAttribute: attr)!
Item was removed:
- ----- Method: TextEditor>>setEmphasis: (in category 'editing keys') -----
- setEmphasis: emphasisSymbol
- "Change the emphasis of the current selection."
-
- | oldAttributes attribute |
- oldAttributes := paragraph text attributesAt: self selectionInterval first.
-
- attribute := TextEmphasis perform: emphasisSymbol.
- (emphasisSymbol == #normal)
- ifFalse: [oldAttributes do:
- [:att | (att dominates: attribute) ifTrue: [attribute turnOff]]].
- self replaceSelectionWith: (self selection addAttribute: attribute)!
Item was removed:
- ----- Method: TextEditor>>setEmphasisHere (in category 'typing support') -----
- setEmphasisHere
-
- emphasisHere := (paragraph text attributesAt: (self pointIndex - 1 max: 1) forStyle: paragraph textStyle)
- select: [:att | att mayBeExtended]!
Item was removed:
- ----- Method: TextEditor>>setEmphasisHereFromText (in category 'typing support') -----
- setEmphasisHereFromText
-
- self setEmphasisHereFromTextForward: true!
Item was removed:
- ----- Method: TextEditor>>setEmphasisHereFromTextForward: (in category 'typing support') -----
- setEmphasisHereFromTextForward: f
-
- | i t forward delta prevIsSeparator nextIsSeparator |
- i := self pointIndex.
- t := self text.
- "Try to set emphasisHere correctly after whitespace.
- Most important after a cr, i.e. at the start of a new line"
- prevIsSeparator := i > 1 and: [ (t at: i-1) isSeparator ].
- nextIsSeparator := i <= t size and: [ (t at: i) isSeparator ].
- forward := prevIsSeparator = nextIsSeparator
- ifTrue: [ f ]
- ifFalse: [ nextIsSeparator ].
- delta := forward ifTrue: [ 1 ] ifFalse: [ 0 ].
- emphasisHere := (t attributesAt: (i - delta max: 1))
- select: [:att | att mayBeExtended].!
Item was removed:
- ----- Method: TextEditor>>setReplacementFromHistory (in category 'accessing') -----
- setReplacementFromHistory
- "Use history to get the previous replacement."
-
- self history hasReplacedSomething
- ifTrue: [ChangeText := self history previous contentsAfter].!
Item was removed:
- ----- Method: TextEditor>>setSearch: (in category 'accessing') -----
- setSearch: aStringOrText
-
- FindText := aStringOrText.!
Item was removed:
- ----- Method: TextEditor>>setSearchFromSelectionOrHistory (in category 'accessing') -----
- setSearchFromSelectionOrHistory
- "Updates the current string to find with the current selection or the last change if it replaced something and thus had a prior selection."
-
- self hasSelection
- ifTrue: [FindText := self selection]
- ifFalse: [self history hasReplacedSomething
- ifTrue: [FindText := self history previous contentsBefore]
- ifFalse: [(self history hasInsertedSomething and: [(self history hasCursorMoved: self stopIndex) not])
- ifTrue: [
- FindText := self history previous contentsAfter.
- self removePreviousInsertion. "Undoable."]]]!
Item was removed:
- ----- Method: TextEditor>>setSearchString (in category 'menu messages') -----
- setSearchString
- "Make the current selection, if any, be the current search string."
- self hasCaret ifTrue: [morph flash. ^ self].
- self setSearch: self selection string!
Item was removed:
- ----- Method: TextEditor>>spawn (in category 'menu messages') -----
- spawn
- "Create and schedule a message browser for the code of the model's
- selected message. Retain any edits that have not yet been accepted."
- | code |
- code := paragraph text string.
- self cancel.
- (model respondsTo: #spawn:)
- ifTrue: [model spawn: code]
- ifFalse: [Project uiManager edit: code].!
Item was removed:
- ----- Method: TextEditor>>spawnIt: (in category 'editing keys') -----
- spawnIt: aKeyboardEvent
- "Triggered by Cmd-o; spawn a new code window, if it makes sense."
-
- self spawn.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>startBlock (in category 'accessing-selection') -----
- startBlock
- ^ pointBlock min: markBlock!
Item was removed:
- ----- Method: TextEditor>>startIndex (in category 'accessing-selection') -----
- startIndex
- ^ self startBlock stringIndex!
Item was removed:
- ----- Method: TextEditor>>startOfTyping (in category 'typing support') -----
- startOfTyping
- "Compatibility during change from characterBlock to integer"
- beginTypeInIndex == nil ifTrue: [^ nil].
- beginTypeInIndex isNumber ifTrue: [^ beginTypeInIndex].
- "Last line for compatibility during change from CharacterBlock to Integer."
- ^ beginTypeInIndex stringIndex!
Item was removed:
- ----- Method: TextEditor>>stateArray (in category 'initialize-release') -----
- stateArray
- ^[ {ChangeText.
- FindText.
- history ifNil: [TextEditorCommandHistory new]. "Convert old instances"
- self markIndex to: self pointIndex - 1.
- self startOfTyping.
- emphasisHere.
- lastParenLocation}]
- on: MessageNotUnderstood
- do: [:ex| ex resume: nil]!
Item was removed:
- ----- Method: TextEditor>>stateArrayPut: (in category 'initialize-release') -----
- stateArrayPut: stateArray
- ChangeText := stateArray at: 1.
- FindText := stateArray at: 2.
- history := stateArray at: 3.
- (stateArray at: 4) ifNotNil: [:sel| self selectFrom: sel first to: sel last].
- beginTypeInIndex := stateArray at: 5.
- emphasisHere := stateArray at: 6.
- lastParenLocation := stateArray at: 7!
Item was removed:
- ----- Method: TextEditor>>stopBlock (in category 'accessing-selection') -----
- stopBlock
- ^ pointBlock max: markBlock!
Item was removed:
- ----- Method: TextEditor>>stopIndex (in category 'accessing-selection') -----
- stopIndex
- ^ self stopBlock stringIndex!
Item was removed:
- ----- Method: TextEditor>>storeSelectionInParagraph (in category 'mvc compatibility') -----
- storeSelectionInParagraph
- paragraph selectionStart: self startBlock selectionStop: self stopBlock!
Item was removed:
- ----- Method: TextEditor>>string (in category 'accessing') -----
- string
-
- ^self text string!
Item was removed:
- ----- Method: TextEditor>>styler (in category 'accessing') -----
- styler
- "Answers the styler for this editor. Only code editors support syntax highlighting"
- ^nil!
Item was removed:
- ----- Method: TextEditor>>styler: (in category 'accessing') -----
- styler: aStyler
- "Sets the styler for this editor. Only code editors support syntax highlighting"
- ^nil!
Item was removed:
- ----- Method: TextEditor>>swapChars: (in category 'editing keys') -----
- swapChars: aKeyboardEvent
- "Triggered byCmd-Y;. Swap two characters, either those straddling the insertion point, or the two that comprise the selection. Suggested by Ted Kaehler. "
-
- | currentSelection aString chars |
- (chars := self selection) size = 0
- ifTrue:
- [currentSelection := self pointIndex.
- self selectMark: currentSelection - 1 point: currentSelection]
- ifFalse:
- [chars size = 2
- ifFalse:
- [morph flash. ^ true]
- ifTrue:
- [currentSelection := self pointIndex - 1]].
- aString := self selection string.
- self replaceSelectionWith: (Text string: aString reversed attributes: emphasisHere).
- self selectAt: currentSelection + 1.
- ^ true!
Item was removed:
- ----- Method: TextEditor>>tabCount (in category 'typing/selecting keys') -----
- tabCount
- ^ self class autoIndent
- ifTrue:
- [ | tabCount s i char |
- s := paragraph string.
- i := self stopIndex.
- tabCount := 0.
- [(i := i-1) > 0 and: [(char := s at: i) ~= Character cr and: [char ~= Character lf]]]
- whileTrue: "Count tabs and brackets (but not a leading bracket)"
- [(char = Character tab and: [i < s size and: [(s at: i+1) ~= $[ ]]) ifTrue: [tabCount := tabCount + 1].
- char = $[ ifTrue: [tabCount := tabCount + 1].
- char = $] ifTrue: [tabCount := tabCount - 1]].
- tabCount ]
- ifFalse: [ 0 ]!
Item was removed:
- ----- Method: TextEditor>>text (in category 'accessing') -----
- text
- "Answer the text of the paragraph being edited."
-
- ^paragraph text!
Item was removed:
- ----- Method: TextEditor>>totalTextHeight (in category 'accessing') -----
- totalTextHeight
-
- ^paragraph lines last bottom!
Item was removed:
- ----- Method: TextEditor>>transformFrom: (in category 'accessing') -----
- transformFrom: owner
- ^morph transformFrom: owner!
Item was removed:
- ----- Method: TextEditor>>typeAhead (in category 'private') -----
- typeAhead
- ^ typeAhead ifNil:
- [ self resetTypeAhead.
- typeAhead ]!
Item was removed:
- ----- Method: TextEditor>>unapplyAttribute: (in category 'private') -----
- unapplyAttribute: aTextAttribute
- "The user selected aTextAttribute to be removed.
- If there is a selection, unapply the attribute to the selection.
- In any case do not use the attribute for the user input (emphasisHere)"
-
- | interval |
-
- emphasisHere := emphasisHere copyWithout: aTextAttribute.
-
- interval := self selectionInterval.
- (interval isEmpty and: [ aTextAttribute isParagraphAttribute not ])
- ifTrue: [ ^self ].
-
- self text removeAttribute: aTextAttribute from: interval first to: interval last.
- paragraph recomposeFrom: interval first to: interval last delta: 0.
- self recomputeSelection. "Needed so visible selection is updated to reflect new visual extent of selection"
- morph changed!
Item was removed:
- ----- Method: TextEditor>>undo (in category 'menu messages') -----
- undo
-
- self closeTypeIn.
- self history undoIn: self.
- self history hasPrevious ifFalse: [morph hasUnacceptedEdits: false].!
Item was removed:
- ----- Method: TextEditor>>undo: (in category 'editing keys') -----
- undo: aKeyboardEvent
- "Undo the last edit."
-
- self insertAndCloseTypeIn.
- self undo.
- ^true!
Item was removed:
- ----- Method: TextEditor>>undoAndReselect (in category 'undo') -----
- undoAndReselect
-
- self
- replace: self history current intervalBetween
- with: self history current contentsBefore
- and: [self selectInterval: self history current intervalBefore].!
Item was removed:
- ----- Method: TextEditor>>unselect (in category 'accessing-selection') -----
- unselect
- markBlock := pointBlock copy!
Item was removed:
- ----- Method: TextEditor>>updateCursorForEvent: (in category 'events') -----
- updateCursorForEvent: evt
-
- (((morph bounds containsPoint: evt position)
- and: [morph dragEnabled not or: [(self isEventInSelection: evt) not]])
- and: [evt hand temporaryCursor ~~ Cursor text])
- ifTrue: [evt hand showTemporaryCursor: Cursor text]
- ifFalse: [evt hand showTemporaryCursor: nil].!
Item was removed:
- ----- Method: TextEditor>>updateMarker (in category 'scrolling') -----
- updateMarker
- "Ignore scrollbar redraw requests."
- !
Item was removed:
- ----- Method: TextEditor>>visibleHeight (in category 'accessing') -----
- visibleHeight
-
- ^morph owner bounds height!
Item was removed:
- ----- Method: TextEditor>>yellowButtonDown: (in category 'events') -----
- yellowButtonDown: event
- "Process a yellow button event. Answer true if the event was handled, false otherwise."
- (paragraph attributesAt: event cursorPoint) do:[:attr|
- attr menu ifNotNil:[
- attr menu
- setInvokingView: self morph editView;
- popUpEvent: event in: self morph world.
- ^true]].
- ^false!
Item was removed:
- ----- Method: TextEditor>>zapSelectionWith: (in category 'mvc compatibility') -----
- zapSelectionWith: replacement
-
- | start stop rep |
- morph readOnly ifTrue: [^ self].
- start := self startIndex.
- stop := self stopIndex.
- (replacement isEmpty and: [stop > start]) ifTrue: [
- "If deleting, then set emphasisHere from 1st character of the deletion"
- emphasisHere := (self text attributesAt: start) select: [:att | att mayBeExtended]].
- (start = stop and: [ replacement isEmpty ]) ifFalse: [
- morph plainTextOnly
- ifTrue: [
- "We support TextAlignment but nothing else. Rely on emphasisHere."
- rep := Text string: replacement asString attributes: emphasisHere ]
- ifFalse: [ replacement isText
- ifTrue: [ rep := replacement]
- ifFalse: [ rep := Text string: replacement attributes: emphasisHere ] ].
-
- self text replaceFrom: start to: stop - 1 with: rep.
- paragraph
- recomposeFrom: start
- to: start + rep size - 1
- delta: rep size - (stop-start).
- self markIndex: start pointIndex: start + rep size.
- otherInterval := self selectionInterval].
-
- self userHasEdited " -- note text now dirty"!
Item was removed:
- Object subclass: #TextEditorCommand
- instanceVariableNames: 'interval message paragraph selection contentsBefore contentsAfter intervalBefore intervalAfter valid messageToUndo messageToRedo intervalBetween type isCompositeUndo isCompositeRedo'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Text Support'!
Item was removed:
- ----- Method: TextEditorCommand>>contentsAfter (in category 'accessing') -----
- contentsAfter
-
- ^ contentsAfter!
Item was removed:
- ----- Method: TextEditorCommand>>contentsAfter: (in category 'accessing') -----
- contentsAfter: anObject
-
- contentsAfter := anObject!
Item was removed:
- ----- Method: TextEditorCommand>>contentsBefore (in category 'accessing') -----
- contentsBefore
-
- ^ contentsBefore!
Item was removed:
- ----- Method: TextEditorCommand>>contentsBefore: (in category 'accessing') -----
- contentsBefore: anObject
-
- contentsBefore := anObject!
Item was removed:
- ----- Method: TextEditorCommand>>hasInsertedSomething (in category 'testing') -----
- hasInsertedSomething
-
- ^ self contentsBefore isEmpty!
Item was removed:
- ----- Method: TextEditorCommand>>hasReplacedSomething (in category 'testing') -----
- hasReplacedSomething
-
- ^ self contentsBefore size > 0!
Item was removed:
- ----- Method: TextEditorCommand>>intervalAfter (in category 'accessing') -----
- intervalAfter
-
- ^ intervalAfter!
Item was removed:
- ----- Method: TextEditorCommand>>intervalAfter: (in category 'accessing') -----
- intervalAfter: anObject
-
- intervalAfter := anObject!
Item was removed:
- ----- Method: TextEditorCommand>>intervalBefore (in category 'accessing') -----
- intervalBefore
-
- ^ intervalBefore!
Item was removed:
- ----- Method: TextEditorCommand>>intervalBefore: (in category 'accessing') -----
- intervalBefore: anObject
-
- intervalBefore := anObject!
Item was removed:
- ----- Method: TextEditorCommand>>intervalBetween (in category 'accessing') -----
- intervalBetween
-
- ^ intervalBetween!
Item was removed:
- ----- Method: TextEditorCommand>>intervalBetween: (in category 'accessing') -----
- intervalBetween: anObject
-
- intervalBetween := anObject!
Item was removed:
- ----- Method: TextEditorCommand>>isCompositeRedo (in category 'accessing') -----
- isCompositeRedo
-
- ^ isCompositeRedo!
Item was removed:
- ----- Method: TextEditorCommand>>isCompositeRedo: (in category 'accessing') -----
- isCompositeRedo: boolean
-
- isCompositeRedo := boolean.!
Item was removed:
- ----- Method: TextEditorCommand>>isCompositeUndo (in category 'accessing') -----
- isCompositeUndo
-
- ^ isCompositeUndo!
Item was removed:
- ----- Method: TextEditorCommand>>isCompositeUndo: (in category 'accessing') -----
- isCompositeUndo: boolean
-
- isCompositeUndo := boolean.!
Item was removed:
- ----- Method: TextEditorCommand>>messageToRedo (in category 'accessing') -----
- messageToRedo
- ^ messageToRedo!
Item was removed:
- ----- Method: TextEditorCommand>>messageToRedo: (in category 'accessing') -----
- messageToRedo: msg
- messageToRedo := msg.!
Item was removed:
- ----- Method: TextEditorCommand>>messageToUndo (in category 'accessing') -----
- messageToUndo
- ^ messageToUndo!
Item was removed:
- ----- Method: TextEditorCommand>>messageToUndo: (in category 'accessing') -----
- messageToUndo: msg
- messageToUndo := msg.!
Item was removed:
- ----- Method: TextEditorCommand>>postCopy (in category 'copying') -----
- postCopy
-
- super postCopy.
-
- contentsAfter := contentsAfter copy.
- contentsBefore := contentsBefore copy.
- intervalAfter := intervalAfter copy.
- intervalBefore := intervalBefore copy.
- intervalBetween := intervalBetween copy.
-
- messageToUndo := messageToUndo copy.
- messageToRedo := messageToRedo copy.!
Item was removed:
- ----- Method: TextEditorCommand>>redoIn: (in category 'undo/redo') -----
- redoIn: editor
-
- self messageToRedo sendTo: editor.!
Item was removed:
- ----- Method: TextEditorCommand>>type (in category 'accessing') -----
- type
-
- ^ type!
Item was removed:
- ----- Method: TextEditorCommand>>type: (in category 'accessing') -----
- type: symbol
-
- type := symbol.!
Item was removed:
- ----- Method: TextEditorCommand>>undoIn: (in category 'undo/redo') -----
- undoIn: editor
-
- self messageToUndo sendTo: editor.!
Item was removed:
- Object subclass: #TextEditorCommandHistory
- instanceVariableNames: 'commands currentIndex'
- classVariableNames: 'MaximumTextHistoryDepth'
- poolDictionaries: ''
- category: 'Morphic-Text Support'!
Item was removed:
- ----- Method: TextEditorCommandHistory class>>maximumTextHistoryDepth (in category 'preferences') -----
- maximumTextHistoryDepth
- <preference: 'Maximum text edit (undo/redo) history depth'
- categoryList: #(editing Morphic)
- description: 'Specifies the number of editor commands that will be stored in a text editor'
- type: #Number>
- ^ MaximumTextHistoryDepth ifNil: [500]!
Item was removed:
- ----- Method: TextEditorCommandHistory class>>maximumTextHistoryDepth: (in category 'preferences') -----
- maximumTextHistoryDepth: number
-
- MaximumTextHistoryDepth := number.!
Item was removed:
- ----- Method: TextEditorCommandHistory>>beginRemember: (in category 'undo/redo') -----
- beginRemember: command
-
- commands := commands
- copyFrom: (1 max: (currentIndex + 2 - self class maximumTextHistoryDepth))
- to: (currentIndex min: commands size).
- commands := commands, {command}.
- currentIndex := commands size - 1. "Select the new command."!
Item was removed:
- ----- Method: TextEditorCommandHistory>>current (in category 'accessing') -----
- current
-
- ^ self next!
Item was removed:
- ----- Method: TextEditorCommandHistory>>detect: (in category 'enumeration') -----
- detect: block
-
- self do: [:command |
- (block value: command) ifTrue: [^ command]].
- ^ nil!
Item was removed:
- ----- Method: TextEditorCommandHistory>>do: (in category 'enumeration') -----
- do: block
- "Goes backward in history."
-
- ((currentIndex min: commands size) to: 1 by: -1)
- do: [:i | block value: (commands at: i)].!
Item was removed:
- ----- Method: TextEditorCommandHistory>>finishRemember (in category 'undo/redo') -----
- finishRemember
-
- currentIndex := commands size.!
Item was removed:
- ----- Method: TextEditorCommandHistory>>hasCursorMoved: (in category 'testing') -----
- hasCursorMoved: cursorIndex
-
- ^ self hasPrevious and: [self previous intervalAfter first ~= cursorIndex]!
Item was removed:
- ----- Method: TextEditorCommandHistory>>hasInsertedSomething (in category 'testing') -----
- hasInsertedSomething
-
- ^ self hasPrevious and: [self previous hasInsertedSomething]!
Item was removed:
- ----- Method: TextEditorCommandHistory>>hasNext (in category 'accessing') -----
- hasNext
-
- ^ currentIndex < commands size!
Item was removed:
- ----- Method: TextEditorCommandHistory>>hasPrevious (in category 'accessing') -----
- hasPrevious
-
- ^ currentIndex > 0!
Item was removed:
- ----- Method: TextEditorCommandHistory>>hasReplacedSomething (in category 'testing') -----
- hasReplacedSomething
-
- ^ self hasPrevious and: [self previous hasReplacedSomething]!
Item was removed:
- ----- Method: TextEditorCommandHistory>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
- self reset.!
Item was removed:
- ----- Method: TextEditorCommandHistory>>next (in category 'accessing') -----
- next
-
- ^ self hasNext
- ifTrue: [commands at: currentIndex+1]
- ifFalse: [nil]!
Item was removed:
- ----- Method: TextEditorCommandHistory>>previous (in category 'accessing') -----
- previous
-
- ^ self hasPrevious
- ifTrue: [commands at: currentIndex]
- ifFalse: [nil]!
Item was removed:
- ----- Method: TextEditorCommandHistory>>redoIn: (in category 'undo/redo') -----
- redoIn: editor
-
- self hasNext ifFalse: [^ self].
-
- [self current redoIn: editor]
- ensure: [currentIndex := currentIndex + 1].
-
- self previous isCompositeRedo == true ifTrue: [self redoIn: editor].!
Item was removed:
- ----- Method: TextEditorCommandHistory>>reset (in category 'initialization') -----
- reset
-
- commands := #().
- currentIndex := 0.!
Item was removed:
- ----- Method: TextEditorCommandHistory>>undoIn: (in category 'undo/redo') -----
- undoIn: editor
-
- self hasPrevious ifFalse: [^ self].
-
- currentIndex := currentIndex - 1.
- self current undoIn: editor.
-
- self current isCompositeUndo == true ifTrue: [self undoIn: editor].!
Item was removed:
- RectangleMorph subclass: #TextFieldMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Text Support'!
-
- !TextFieldMorph commentStamp: '<historical>' prior: 0!
- Act as a field in a HyperCard-like setting. Has both properties of a Rectangle, and exposes some proteries of the TextMorph it owns.
-
- !
Item was removed:
- ----- Method: TextFieldMorph class>>authoringPrototype (in category 'scripting') -----
- authoringPrototype
- "Answer an instance of the receiver that can serve as a prototype for authoring"
-
- | proto |
- proto := super authoringPrototype.
- proto setProperty: #shared toValue: true.
- proto extent: 170 @ 30.
- proto color: Color veryLightGray lighter.
- proto contents: 'on a clear day you can...'.
- ^ proto
- !
Item was removed:
- ----- Method: TextFieldMorph class>>initialize (in category 'class initialization') -----
- initialize
-
- self registerInFlapsRegistry. !
Item was removed:
- ----- Method: TextFieldMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
- registerInFlapsRegistry
- "Register the receiver in the system's flaps registry"
- self environment
- at: #Flaps
- ifPresent: [:cl | cl registerQuad: {#TextFieldMorph. #exampleBackgroundField. 'Scrolling Field' translatedNoop. 'A scrolling data field which will have a different value on every card of the background' translatedNoop}
- forFlapNamed: 'Scripting'.]!
Item was removed:
- ----- Method: TextFieldMorph class>>unload (in category 'class initialization') -----
- unload
- "Unload the receiver from global registries"
-
- self environment at: #Flaps ifPresent: [:cl |
- cl unregisterQuadsWithReceiver: self] !
Item was removed:
- ----- Method: TextFieldMorph>>append: (in category 'just like textMorph') -----
- append: stringOrText
- "add to my text"
- | tm |
-
- (tm := self findA: TextMorph) ifNil: [^ nil].
- tm contents append: stringOrText.
- tm releaseParagraph; paragraph.
-
-
- !
Item was removed:
- ----- Method: TextFieldMorph>>contents (in category 'just like textMorph') -----
- contents
- | tm |
- "talk to my text"
-
- (tm := self findA: TextMorph) ifNil: [^ nil].
- ^ tm contents!
Item was removed:
- ----- Method: TextFieldMorph>>contents: (in category 'just like textMorph') -----
- contents: textOrString
- "talk to my text"
- | tm newText atts |
-
- (tm := self findA: TextMorph) ifNil: [^ nil].
- textOrString isString ifTrue: [
- tm contents ifNotNil: ["Keep previous properties of the field"
- newText := textOrString asText.
- atts := tm contents attributesAt: 1.
- atts do: [:each | newText addAttribute: each].
- ^ tm contents: newText]].
-
- ^ tm contents: textOrString!
Item was removed:
- ----- Method: TextFieldMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color veryLightGray lighter!
Item was removed:
- ----- Method: TextFieldMorph>>fit (in category 'just like textMorph') -----
- fit
- "tell my text to recompute its looks"
- | tm |
-
- (tm := self findA: TextMorph) ifNil: [^ nil].
- tm releaseParagraph; paragraph.!
Item was removed:
- ----- Method: TextFieldMorph>>fontName:size: (in category 'just like textMorph') -----
- fontName: fontName size: fontSize
- | tm |
- "talk to my text"
-
- (tm := self findA: TextMorph) ifNil: [^ nil].
- ^ tm fontName: fontName size: fontSize
- !
Item was removed:
- ----- Method: TextFieldMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- | tm |
- super initialize.
- ""
-
- self addMorph: (tm := TextMorph new).
- tm fillingOnOff!
Item was removed:
- ----- Method: TextFieldMorph>>lineCount (in category 'just like textMorph') -----
- lineCount
- | tm |
- "how many lines in my text"
-
- (tm := self findA: TextMorph) ifNil: [^ nil].
- ^ tm contents string lineCount!
Item was removed:
- ----- Method: TextFieldMorph>>prepend: (in category 'just like textMorph') -----
- prepend: stringOrText
- "add to my text"
- | tm |
-
- (tm := self findA: TextMorph) ifNil: [^ nil].
- tm contents prepend: stringOrText.
- tm releaseParagraph; paragraph.
-
-
- !
Item was removed:
- RectangleMorph subclass: #TextMorph
- instanceVariableNames: 'textStyle text wrapFlag paragraph editor container predecessor successor backgroundColor margins readOnly autoFit plainTextOnly numCharactersPerLine'
- classVariableNames: 'CaretForm DefaultEditorClass'
- poolDictionaries: ''
- category: 'Morphic-Basic'!
-
- !TextMorph commentStamp: 'nice 3/24/2010 07:40' prior: 0!
- TextMorphs support display of text with emphasis. They also support reasonable text-editing capabilities, as well as embedded hot links, and the ability to embed submorphs in the text.
-
- Late in life, TextMorph was made a subclass of BorderedMorph to provide border and background color if desired. In order to keep things compatible, protocols have been redirected so that color (preferably textColor) relates to the text, and backgroundColor relates to the inner fill color.
-
- Text display is clipped to the innerBounds of the rectangle, and text composition is normally performed within a rectangle which is innerBounds inset by the margins parameter.
-
- If text has been embedded in another object, one can elect to fill the owner's shape, in which case the text will be laid out in the shape of the owner's shadow image (including any submorphs other than the text). One can also elect to have the text avoid occlusions, in which case it will avoid the bounds of any sibling morphs that appear in front of it. It may be necessary to update bounds in order for the text runaround to notice the presence of a new occluding shape.
-
- The optional autoFitContents property enables the following feature: if the text contents changes, then the bounds of the morph will be adjusted to fit the minimum rectangle that encloses the text (plus any margins specified). Similarly, any attempt to change the size of the morph will be resisted if this parameter is set. Except...
-
- If the wrapFlag parameter is true, then text will be wrapped at word boundaries based on the composition width (innerBounds insetBy: margins) width. Thus an attempt to resize the morph in autofit mode, if it changes the width, will cause the text to be recomposed with the new width, and then the bounds will be reset to the minimum enclosing rectangle. Similarly, if the text contents are changed with the wrapFlag set to true, word wrap will be performed based on the current compostion width, after which the bounds will be set (or not), based on the autoFitcontents property.
-
- Note that fonts can only be applied to the TextMorph as a whole. While you can change the size, color, and emphasis of a subsection of the text and have it apply to only that subsection, changing the font changes the font for the entire contents of the TextMorph.
-
- Still a TextMorph can be composed of several texts of different fonts
- | font1 font2 t1 t2 tMorph|
- tMorph := TextMorph new.
- font1 := (TextFontReference toFont: (StrikeFont familyName: 'Atlanta' size: 22)).
- font2 := (TextFontReference toFont: (StrikeFont familyName: 'Atlanta' size: 11)).
- t1 := 'this is font1' asText addAttribute: font1.
- t2 := ' and this is font2' asText addAttribute: font2.
- tMorph contents: (t1,t2).
- tMorph openInHand.
-
-
- Yet to do:
- Make a comprehensive control for the eyedropper, with border width and color, inner color and text color, and margin widths.!
Item was removed:
- ----- Method: TextMorph class>>authoringPrototype (in category 'scripting') -----
- authoringPrototype
- | t |
- t := super authoringPrototype.
- t contents: 'abc' translated asText.
- t wrapFlag: true.
-
- "Strangeness here in order to avoid two offset copies of the default contents when operating in an mvc project before cursor enters the morphic window"
- t paragraph.
- ^ t!
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 at 36;
- margins: 4 at 0;
- fit;
- yourself
- !
Item was removed:
- ----- Method: TextMorph class>>borderedPrototype (in category 'parts bin') -----
- borderedPrototype
-
- | t |
- t := self authoringPrototype.
- t fontName: 'BitstreamVeraSans' pointSize: 24.
- t autoFit: false; extent: 250 at 100.
- t borderWidth: 1; margins: 4 at 0; backgroundColor: Color white.
-
- "Strangeness here in order to avoid two offset copies of the default contents when operating in an mvc project before cursor enters the morphic window"
- t paragraph.
- ^ t!
Item was removed:
- ----- Method: TextMorph class>>cleanUp (in category 'class initialization') -----
- cleanUp
-
- TextMorph allSubInstancesDo: [:m | m releaseEditor].!
Item was removed:
- ----- Method: TextMorph class>>defaultEditorClass (in category 'class initialization') -----
- defaultEditorClass
- "Answers the default editor class for TextMorph"
- ^DefaultEditorClass!
Item was removed:
- ----- Method: TextMorph class>>defaultEditorClass: (in category 'class initialization') -----
- defaultEditorClass: aTextEditorClass
- "Sets the default editor class for TextMorph"
- "
- TextMorph defaultEditorClass: TextMorphEditor.
- TextMorph defaultEditorClass: TextEditor.
- "
- DefaultEditorClass := aTextEditorClass!
Item was removed:
- ----- Method: TextMorph class>>defaultNameStemForInstances (in category 'scripting') -----
- defaultNameStemForInstances
- ^ 'Text' translatedNoop!
Item was removed:
- ----- Method: TextMorph class>>exampleBackgroundLabel (in category 'parts bin') -----
- exampleBackgroundLabel
- "Answer a background label for a parts bin"
-
- | aTextMorph |
- aTextMorph := self authoringPrototype.
- aTextMorph contents: 'background
- label' asText.
- aTextMorph beAllFont: (StrikeFont familyName: #NewYork size: 18).
- aTextMorph color: Color brown.
- aTextMorph setProperty: #shared toValue: true.
- ^ aTextMorph
- !
Item was removed:
- ----- Method: TextMorph class>>fancyPrototype (in category 'parts bin') -----
- fancyPrototype
-
- | t |
- t := self authoringPrototype.
- t autoFit: false; extent: 150 at 75.
- t borderWidth: 2; margins: 4 at 0; useRoundedCorners. "Why not rounded?"
- "fancy font, shadow, rounded"
- t fontName: Preferences standardEToysFont familyName size: 18; textColor: Color blue; fillStyle: Color lightBrown.
- t addDropShadow.
-
- "Strangeness here in order to avoid two offset copies of the default contents when operating in an mvc project before cursor enters the morphic window"
- t paragraph.
- ^ t!
Item was removed:
- ----- Method: TextMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
- includeInNewMorphMenu
- ^ true!
Item was removed:
- ----- Method: TextMorph class>>initialize (in category 'class initialization') -----
- initialize "TextMorph initialize"
-
- "Initialize the default text editor class to use"
- DefaultEditorClass := SmalltalkEditor.
-
- "Initialize constants shared by classes associated with text display."
-
- CaretForm := (ColorForm extent: 16 at 5
- fromArray: #(2r001100e26 2r001100e26 2r011110e26 2r111111e26 2r110011e26)
- offset: -2 at 0)
- colors: (Array with: Color transparent with: (TranslucentColor r: 0.0 g: 0.0 b: 0.8 alpha: 0.2)).
-
- self registerInFlapsRegistry.
- !
Item was removed:
- ----- Method: TextMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
- registerInFlapsRegistry
- "Register the receiver in the system's flaps registry"
- self environment
- at: #Flaps
- ifPresent: [:cl | cl registerQuad: {#TextMorph. #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}
- forFlapNamed: 'PlugIn Supplies'.
- cl registerQuad: {#TextMorph . #exampleBackgroundLabel. 'Background Label' translatedNoop. 'A piece of text that will occur on every card of the background' translatedNoop}
- forFlapNamed: 'Scripting'.
- cl registerQuad: {#TextMorph . #exampleBackgroundField. 'Background Field' translatedNoop. 'A data field which will have a different value on every card of the background' translatedNoop}
- forFlapNamed: 'Scripting'.
- cl registerQuad: {#TextMorph . #authoringPrototype. 'Simple Text' translatedNoop. 'Text that you can edit into anything you wish' translatedNoop}
- forFlapNamed: 'Stack Tools'.
- cl registerQuad: {#TextMorph . #fancyPrototype. 'Fancy Text' translatedNoop. 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop}
- forFlapNamed: 'Stack Tools'.
- cl registerQuad: {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}
- forFlapNamed: 'Supplies'.]!
Item was removed:
- ----- Method: TextMorph class>>string:fontName: (in category 'instance creation') -----
- string: aString fontName: aName
-
- ^ self
- string: aString
- fontName: aName
- size: TextStyle defaultFont pixelSize!
Item was removed:
- ----- Method: TextMorph class>>string:fontName:size: (in category 'instance creation') -----
- string: aString fontName: aName size: aSize
-
- ^ self
- string: aString
- fontName: aName
- size: aSize
- wrap: false "...because we don't know the initial width to wrap..."
- !
Item was removed:
- ----- Method: TextMorph class>>string:fontName:size:wrap: (in category 'instance creation') -----
- string: aString fontName: aName size: aSize wrap: shouldWrap
-
- ^ self new
- string: aString fontName: aName size: aSize wrap: shouldWrap;
- yourself!
Item was removed:
- ----- Method: TextMorph class>>string:size: (in category 'instance creation') -----
- string: aString size: pixelSize
-
- ^ self
- string: aString
- fontName: TextStyle defaultFont familyName
- size: pixelSize!
Item was removed:
- ----- Method: TextMorph class>>unload (in category 'class initialization') -----
- unload
- "Unload the receiver from global registries"
-
- self environment at: #Flaps ifPresent: [:cl |
- cl unregisterQuadsWithReceiver: self] !
Item was removed:
- ----- Method: TextMorph>>acceptContents (in category 'editing') -----
- acceptContents
- "The message is sent when the user hits enter or Cmd-S.
- Accept the current contents and end editing.
- This default implementation does nothing."
- self updateFromParagraph!
Item was removed:
- ----- Method: TextMorph>>acceptDroppingMorph:event: (in category 'layout') -----
- acceptDroppingMorph: aMorph event: evt
- "This message is sent when a morph is dropped onto me."
-
- self addMorphFront: aMorph fromWorldPosition: aMorph position.
- "Make a TextAnchor and install it in a run."!
Item was removed:
- ----- Method: TextMorph>>acceptOnCR (in category 'editing') -----
- acceptOnCR
- "Answer whether the receiver wants to accept when the Return key is hit. Generic TextMorph has no such feature, but subclasses may."
-
- ^ false!
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: [Smalltalk at: #TextOnCurveContainer ifPresent: [:ignored | 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>>addMorphFront:fromWorldPosition: (in category 'submorphs - add/remove') -----
- addMorphFront: aMorph fromWorldPosition: wp
- "Overridden for more specific re-layout and positioning"
- aMorph textAnchorProperties anchorLayout == #document
- ifFalse:[^ self
- anchorMorph: aMorph
- at: wp
- type: aMorph textAnchorProperties anchorLayout].
- self addMorphFront: aMorph.
- !
Item was removed:
- ----- Method: TextMorph>>addPredecessor: (in category 'linked frames') -----
- addPredecessor: evt
- | newMorph |
- newMorph := self copy predecessor: predecessor successor: self.
- newMorph extent: self width @ 100.
- predecessor ifNotNil: [predecessor setSuccessor: newMorph].
- self setPredecessor: newMorph.
- predecessor recomposeChain.
- evt hand attachMorph: newMorph!
Item was removed:
- ----- Method: TextMorph>>addSuccessor: (in category 'linked frames') -----
- addSuccessor: evt
- | newMorph |
- newMorph := self copy predecessor: self successor: successor.
- newMorph extent: self width @ 100.
- successor ifNotNil: [successor setPredecessor: newMorph].
- self setSuccessor: newMorph.
- successor recomposeChain.
- evt hand attachMorph: newMorph!
Item was removed:
- ----- Method: TextMorph>>adjustLineIndicesBy: (in category 'private') -----
- adjustLineIndicesBy: delta
- paragraph ifNotNil: [paragraph adjustLineIndicesBy: delta]!
Item was removed:
- ----- Method: TextMorph>>adjustTextAnchor: (in category 'anchors') -----
- adjustTextAnchor: aMorph
- "Later compute the new relative position of aMorph if it is #paragraph anchored."!
Item was removed:
- ----- Method: TextMorph>>anchorMorph:at:type: (in category 'anchors') -----
- anchorMorph: aMorph at: aPoint type: anchorType
-
- | relPt index newText block |
- aMorph owner == self ifTrue:[self removeMorph: aMorph].
- self addMorphFront: aMorph.
-
- relPt := self transformFromWorld globalPointToLocal: aPoint.
- index := (self paragraph characterBlockAtPoint: relPt) stringIndex.
- newText := Text string: Character startOfHeader asString attribute: (TextAnchor new anchoredMorph: aMorph).
- anchorType == #inline ifTrue:[
- self paragraph replaceFrom: index to: index-1 with: newText displaying: false].
- anchorType == #document ifTrue: [
- index := index min: paragraph text size.
- index := paragraph text string lastIndexOf: Character cr startingAt: index.
- block := paragraph characterBlockForIndex: index+1.
- aMorph textAnchorProperties positionInDocument: (relPt x - bounds left) @ (relPt y - block top).
- self paragraph replaceFrom: index+1 to: index with: newText displaying: false].
-
- self fit.!
Item was removed:
- ----- Method: TextMorph>>areasRemainingToFill: (in category 'drawing') -----
- areasRemainingToFill: aRectangle
- "Overridden from BorderedMorph to test backgroundColor instead of (text) color."
- (self backgroundColor isNil or: [self backgroundColor asColor isTranslucent])
- ifTrue: [^ Array with: aRectangle].
- self wantsRoundedCorners
- ifTrue: [(self borderWidth > 0 and: [self borderColor isColor and: [self borderColor isTranslucent]])
- ifTrue: [^ aRectangle areasOutside: (self innerBounds intersect: self boundsWithinCorners)]
- ifFalse: [^ aRectangle areasOutside: self boundsWithinCorners]]
- ifFalse: [(self borderWidth > 0 and: [self borderColor isColor and: [self borderColor isTranslucent]])
- ifTrue: [^ aRectangle areasOutside: self innerBounds]
- ifFalse: [^ aRectangle areasOutside: self bounds]]!
Item was removed:
- ----- Method: TextMorph>>asText (in category 'converting') -----
- asText
-
- self flag: #todo. "mt: There are too many strange places were #asText is called but #text actually be accessed. Maybe change this after the release of Squeak 6.0."
- ^ text
-
- "Answer the receiver's text composed in a paragraph with additional line breaks. Use #text if you want to retain the original text layout."
-
- "^ self paragraph asTextWithLineBreaks"!
Item was removed:
- ----- Method: TextMorph>>autoFit: (in category 'accessing') -----
- autoFit: trueOrFalse
- "Private!! Please use #hResizing: and #vResizing:."
-
- "Whether I automatically adjust my size to fit text as it changes"
-
- self isAutoFit = trueOrFalse ifTrue: [^ self].
- self autoFitOnOff.!
Item was removed:
- ----- Method: TextMorph>>autoFitOnOff (in category 'menu') -----
- autoFitOnOff
- autoFit := self isAutoFit not.
- self isAutoFit ifTrue: [self fit]!
Item was removed:
- ----- Method: TextMorph>>autoFitString (in category 'menu') -----
- autoFitString
- "Answer the string to put in a menu that will invite the user to
- switch autoFit mode"
- ^ (self isAutoFit
- ifTrue: ['<yes>']
- ifFalse: ['<no>'])
- , 'text auto fit' translated!
Item was removed:
- ----- Method: TextMorph>>averageLineLength (in category 'layout') -----
- averageLineLength
- "Answers the average length per line in characters. When the entire content is composed in the receiver's #textStyle's default font, it will be an exact match only for monospaced fonts. For variable width fonts it will be an average depending on the (natural) language used, number of lines, and each glyph's advance width. Optimized for English text. Can vary greatly when combining different font faces or sizes. See commentary in #withNoLineLongerThan: and TextStyle >> #compositionWidthFor:."
-
- ^ numCharactersPerLine!
Item was removed:
- ----- Method: TextMorph>>averageLineLength: (in category 'layout') -----
- averageLineLength: numCharsOrNil
- "Reset the receiver's composition rectangle to fit approx. numChars per line. For nil, it uses a sane default for English text. See commentary in #averageLineLength."
-
- numCharactersPerLine = numCharsOrNil ifTrue: [^ self].
- numCharactersPerLine := numCharsOrNil.
- self releaseParagraph; changed.!
Item was removed:
- ----- Method: TextMorph>>avoidsOcclusions (in category 'containment') -----
- avoidsOcclusions
- ^container notNil and: [ container avoidsOcclusions ]
- !
Item was removed:
- ----- Method: TextMorph>>backgroundColor (in category 'accessing') -----
- backgroundColor
- ^ self fillStyle.
- !
Item was removed:
- ----- Method: TextMorph>>backgroundColor: (in category 'accessing') -----
- backgroundColor: newColor
- self fillStyle: newColor.
- !
Item was removed:
- ----- Method: TextMorph>>beAllFont: (in category 'initialization') -----
- beAllFont: aFont
- "Change the receiver's default font, which is used to draw its contents. Also see commentary in #font:."
-
- self font: aFont.!
Item was removed:
- ----- Method: TextMorph>>blinkStart (in category 'blinking') -----
- blinkStart
- "Reset time for blink cursor after which blinking should actually start"
- ^self valueOfProperty: #blinkStart ifAbsent:[Time millisecondClockValue]
- !
Item was removed:
- ----- Method: TextMorph>>blinkStart: (in category 'blinking') -----
- blinkStart: msecs
- "Reset time for blink cursor after which blinking should actually start"
- ^self setProperty: #blinkStart toValue: msecs
- !
Item was removed:
- ----- Method: TextMorph>>borderWidth: (in category 'accessing') -----
- borderWidth: newWidth
- super borderWidth: newWidth.
- paragraph ifNotNil: [self composeToBounds].!
Item was removed:
- ----- Method: TextMorph>>bounds (in category 'geometry') -----
- bounds
- container ifNil: [^ bounds].
- ^ container bounds ifNil: [bounds]!
Item was removed:
- ----- Method: TextMorph>>cancelEdits (in category 'editing') -----
- cancelEdits
- "The message is sent when the user hits enter or Cmd-L.
- Cancel the current contents and end editing.
- This default implementation does nothing."
- self releaseParagraph!
Item was removed:
- ----- Method: TextMorph>>cancelEditsSafely (in category 'editing') -----
- cancelEditsSafely
- "Safe variation of #cancelEdits, where the undo history is not discarded and can thus be used to undo the cancel operation.
- This default implementation does nothing."!
Item was removed:
- ----- Method: TextMorph>>caretColor (in category 'accessing') -----
- caretColor
- ^ self valueOfProperty: #caretColor ifAbsent: [Color red]!
Item was removed:
- ----- Method: TextMorph>>caretColor: (in category 'accessing') -----
- caretColor: aColor
- self
- setProperty: #caretColor
- toValue: aColor.!
Item was removed:
- ----- Method: TextMorph>>centered (in category 'alignment') -----
- centered
- self paragraph centered.
- self updateFromParagraph !
Item was removed:
- ----- Method: TextMorph>>changeMargins: (in category 'menu') -----
- changeMargins: evt
- | handle origin aHand oldMargin newMargin |
- aHand := evt ifNil: [self primaryHand] ifNotNil: [evt hand].
- origin := aHand position.
- oldMargin := margins.
- (handle := HandleMorph new)
- forEachPointDo:
- [:newPoint | handle removeAllMorphs.
- handle addMorph:
- (LineMorph from: origin to: newPoint color: Color black width: 1).
- newMargin := (newPoint - origin max: 0 at 0) // 5.
- self margins: newMargin]
- lastPointDo:
- [:newPoint | handle deleteBalloon.
- self halo ifNotNil: [ :halo | halo addHandles].
- self rememberCommand:
- (Command new cmdWording: ('margin change for ' translated,self nameForUndoWording);
- undoTarget: self selector: #margins: argument: oldMargin;
- redoTarget: self selector: #margins: argument: newMargin;
- yourself)].
- aHand attachMorph: handle.
- handle setProperty: #helpAtCenter toValue: true.
- handle showBalloon:
- 'Move cursor down and to the right
- to increase margin inset.
- Click when done.' hand: evt hand.
- handle startStepping!
Item was removed:
- ----- Method: TextMorph>>changeTextColor (in category 'menu') -----
- changeTextColor
- "Change the color of the receiver -- triggered, e.g. from a menu"
-
- self openATextPropertySheet.
- ">>>>>
- ColorPickerMorph new
- choseModalityFromPreference;
- sourceHand: self activeHand;
- target: self;
- selector: #textColor:;
- originalColor: self textColor;
- putUpFor: self near: self fullBoundsInWorld
- <<<<"!
Item was removed:
- ----- Method: TextMorph>>chooseAlignment (in category 'editing') -----
- chooseAlignment
- self editor changeAlignment.
- self updateFromParagraph!
Item was removed:
- ----- Method: TextMorph>>chooseEmphasis (in category 'editing') -----
- chooseEmphasis
- self editor changeEmphasisOrAlignment.
- self updateFromParagraph!
Item was removed:
- ----- Method: TextMorph>>chooseEmphasisOrAlignment (in category 'editing') -----
- chooseEmphasisOrAlignment
- self editor changeEmphasisOrAlignment.
- self updateFromParagraph!
Item was removed:
- ----- Method: TextMorph>>chooseFont (in category 'editing') -----
- chooseFont
- self editor changeTextFont.
- self updateFromParagraph.!
Item was removed:
- ----- Method: TextMorph>>chooseStyle (in category 'editing') -----
- chooseStyle
- self editor changeStyle.
- self updateFromParagraph.!
Item was removed:
- ----- Method: TextMorph>>click: (in category 'event handling') -----
- click: evt
-
- self
- handleInteraction: [self editor click: evt]
- fromEvent: evt.!
Item was removed:
- ----- Method: TextMorph>>clippingRectangle (in category 'private') -----
- clippingRectangle
- ^ self innerBounds!
Item was removed:
- ----- Method: TextMorph>>composeToBounds (in category 'private') -----
- composeToBounds
- "Compose my text to fit my bounds.
- If any text lies outside my bounds, it will be clipped, or
- if I have successors, it will be shown in the successors."
- | |
- self releaseParagraph; paragraph.
- container ifNotNil:
- [self privateBounds: container bounds truncated].
- self paragraph positionWhenComposed: self position.
- successor ifNotNil:
- [successor predecessorChanged].
-
- !
Item was removed:
- ----- Method: TextMorph>>compositionRectangle (in category 'private') -----
- compositionRectangle
-
- | compRect minW minH |
- compRect := self innerBounds.
- margins ifNotNil: [compRect := compRect insetBy: margins].
- minW := self minCompositionWidth.
- minH := self minCompositionHeight.
- compRect width < minW ifTrue: [compRect := compRect withWidth: minW].
- compRect height < minH ifTrue: [compRect := compRect withHeight: minH].
- numCharactersPerLine ifNotNil: [
- | preferredWidth |
- preferredWidth := textStyle compositionWidthFor: numCharactersPerLine.
- wrapFlag
- ifTrue: [compRect := compRect withWidth: (compRect width min: preferredWidth)]
- ifFalse: [compRect := compRect withWidth: preferredWidth]].
- ^ compRect!
Item was removed:
- ----- Method: TextMorph>>container (in category 'geometry') -----
- container
- "Return the container for composing this text. There are four cases:
- 1. container is specified as, eg, an arbitrary shape,
- 2. container is specified as the bound rectangle, because
- this morph is linked to others,
- 3. container is nil, and wrap is true -- grow downward as necessary,
- 4. container is nil, and wrap is false -- grow in 2D as necessary."
-
- container ifNil: [
- successor ifNotNil: [^ self compositionRectangle].
- ^ wrapFlag
- ifTrue: [self compositionRectangle withHeight: self maximumContainerExtent y]
- ifFalse: [
- numCharactersPerLine
- ifNil: [self compositionRectangle topLeft extent: self maximumContainerExtent]
- ifNotNil: [self compositionRectangle withHeight: self maximumContainerExtent y]]].
- ^ container!
Item was removed:
- ----- Method: TextMorph>>containsPoint: (in category 'geometry testing') -----
- containsPoint: aPoint
- (super containsPoint: aPoint) ifFalse: [^ false]. "Not in my bounds"
- container ifNil: [^ true]. "In bounds of simple text"
- self startingIndex > text size ifTrue:
- ["make null text frame visible"
- ^ super containsPoint: aPoint].
- "In complex text (non-rect container), test by line bounds"
- ^ self paragraph containsPoint: aPoint
- !
Item was removed:
- ----- Method: TextMorph>>contents (in category 'accessing') -----
- contents
-
- ^ text!
Item was removed:
- ----- Method: TextMorph>>contents: (in category 'accessing') -----
- contents: stringOrText
- ^ self newContents: stringOrText!
Item was removed:
- ----- Method: TextMorph>>contents:wrappedTo: (in category 'accessing') -----
- contents: stringOrText wrappedTo: width
- "Accept new text contents. Lay it out, wrapping to width.
- Then fit my height to the result."
- self newContents: ''.
- wrapFlag := true.
- super extent: width truncated at self height.
- self newContents: stringOrText!
Item was removed:
- ----- Method: TextMorph>>contentsAsIs: (in category 'accessing') -----
- contentsAsIs: stringOrText
- "Accept new text contents with line breaks only as in the text.
- Fit my width and height to the result."
- wrapFlag := false.
- container ifNotNil: [container fillsOwner ifTrue: [wrapFlag := true]].
- self newContents: stringOrText!
Item was removed:
- ----- Method: TextMorph>>contentsWrapped: (in category 'accessing') -----
- contentsWrapped: stringOrText
- "Accept new text contents. Lay it out, wrapping within my current width.
- Then fit my height to the result."
- wrapFlag := true.
- self newContents: stringOrText!
Item was removed:
- ----- Method: TextMorph>>convertToCurrentVersion:refStream: (in category 'objects from disk') -----
- convertToCurrentVersion: varDict refStream: smartRefStrm
-
- self borderWidth ifNil: [
- self borderWidth: 0.
- self removeProperty: #fillStyle].
- ^ super convertToCurrentVersion: varDict refStream: smartRefStrm.
-
- !
Item was removed:
- ----- Method: TextMorph>>copy (in category 'copying') -----
- copy
- ^ super copy text: text copy textStyle: textStyle copy
- wrap: wrapFlag color: color
- predecessor: nil successor: nil!
Item was removed:
- ----- Method: TextMorph>>crAction (in category 'accessing') -----
- crAction
- "Return the action to perform when encountering a CR in the input"
- ^self valueOfProperty: #crAction!
Item was removed:
- ----- Method: TextMorph>>crAction: (in category 'accessing') -----
- crAction: aMessageSend
- "Return the action to perform when encountering a CR in the input"
- ^self setProperty: #crAction toValue: aMessageSend!
Item was removed:
- ----- Method: TextMorph>>createParagraph (in category 'private') -----
- createParagraph
-
- self setProperty: #CreatingParagraph toValue: true.
-
- [
- self setDefaultContentsIfNil.
-
- "...Code here to recreate the paragraph..."
- paragraph := (self paragraphClass new textOwner: self owner).
- paragraph wantsColumnBreaks: successor notNil.
- paragraph
- compose: text
- style: textStyle
- from: self startingIndex
- in: self container.
- wrapFlag ifFalse:
- ["Was given huge container at first... now adjust"
- paragraph adjustRightXDownTo: self minCompositionWidth].
- paragraph focused: (self currentHand keyboardFocus == self).
-
- paragraph
- caretColor: self caretColor;
- selectionColor: self selectionColor;
- unfocusedSelectionColor: self unfocusedSelectionColor.
-
- self fit.
- ] ensure: [self removeProperty: #CreatingParagraph].
-
- ^ paragraph!
Item was removed:
- ----- Method: TextMorph>>cursor (in category 'accessing') -----
- cursor
- "Answer the receiver's logical cursor position"
-
- | loc |
- loc := self valueOfProperty: #textCursorLocation ifAbsentPut: [1].
- loc := loc min: text string size.
- ^ loc rounded
- !
Item was removed:
- ----- Method: TextMorph>>cursorWrapped: (in category 'accessing') -----
- cursorWrapped: aNumber
- "Set the cursor as indicated"
-
- self setProperty: #textCursorLocation toValue: (((aNumber rounded - 1) \\ text string size) + 1)
-
- !
Item was removed:
- ----- Method: TextMorph>>debugDrawLineRectsOn: (in category 'drawing') -----
- debugDrawLineRectsOn: aCanvas
- "Shows where text line rectangles are"
- self paragraph lines do:
- [:line | aCanvas frameRectangle: line rectangle color: Color brown]
- !
Item was removed:
- ----- Method: TextMorph>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- ^ 0!
Item was removed:
- ----- Method: TextMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color black!
Item was removed:
- ----- Method: TextMorph>>defaultLineHeight (in category 'geometry') -----
- defaultLineHeight
- ^ textStyle lineGrid!
Item was removed:
- ----- Method: TextMorph>>delete (in category 'submorphs - add/remove') -----
- delete
- predecessor ifNotNil: [predecessor setSuccessor: successor].
- successor ifNotNil: [successor setPredecessor: predecessor.
- successor recomposeChain].
- super delete!
Item was removed:
- ----- Method: TextMorph>>doLayoutIn: (in category 'layout') -----
- doLayoutIn: layoutBounds
- "Compute paragraph here to reduce visual flickering. Also update the layout of any submorphs, which can be added via text anchors.
-
- autoFit + wrapFlag -> hResizing: #rigid + vResizing: #shrinkWrap
- autoFIt + no wrapFlag -> hResizing: #shrinkWrap + vResizing: #shrinkWrap
- no autoFit + wrapFlag -> hResizing: #rigid + vRresizing: #rigid
- no autoFit + no wrapFlag -> hResizing: #rigid + vRresizing: #rigid"
-
- self submorphsDo: [:m | m fullBounds].
- self paragraph.
- fullBounds := self privateFullBounds.!
Item was removed:
- ----- Method: TextMorph>>drawNullTextOn: (in category 'drawing') -----
- drawNullTextOn: aCanvas
- "make null text frame visible"
-
- aCanvas isPostscriptCanvas ifFalse: [
- aCanvas fillRectangle: bounds color:
- ((Color black) alpha: 0.1).
- ]!
Item was removed:
- ----- Method: TextMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- "Draw the receiver on a canvas"
-
- | fauxBounds |
- self setDefaultContentsIfNil.
- super drawOn: aCanvas. "Border and background if any"
- false ifTrue: [self debugDrawLineRectsOn: aCanvas]. "show line rects for debugging"
- (self startingIndex > text size)
- ifTrue: [self drawNullTextOn: aCanvas].
- "Hack here: The canvas expects bounds to carry the location of the text, but we also need to communicate clipping."
- fauxBounds := self bounds topLeft corner: self innerBounds bottomRight.
- aCanvas paragraph: self paragraph bounds: fauxBounds color: color!
Item was removed:
- ----- Method: TextMorph>>editHistory (in category 'multi level undo') -----
- editHistory
- ^ self editor history!
Item was removed:
- ----- Method: TextMorph>>editor (in category 'accessing') -----
- editor
- "Return my current editor, or install a new one."
- editor ifNotNil: [^ editor].
- ^ self installEditorToReplace: nil!
Item was removed:
- ----- Method: TextMorph>>editorClass (in category 'private') -----
- editorClass
- "Answer the class used to create the receiver's editor"
- ^DefaultEditorClass!
Item was removed:
- ----- Method: TextMorph>>elementCount (in category 'accessing') -----
- elementCount
- "Answer how many sub-objects are within me"
-
- ^ self text string size !
Item was removed:
- ----- Method: TextMorph>>enterClickableRegion: (in category 'editing') -----
- enterClickableRegion: evt
- | index isLink |
- evt hand hasSubmorphs ifTrue:[^false].
- paragraph ifNotNil:[
- index := (paragraph characterBlockAtPoint: evt position) stringIndex.
- isLink := (paragraph text attributesAt: index forStyle: paragraph textStyle)
- anySatisfy:[:attr| attr mayActOnClick].
- isLink ifTrue: [
- evt hand showTemporaryCursor: Cursor webLink.
- ^ true]].
- ^ false
- !
Item was removed:
- ----- Method: TextMorph>>extent: (in category 'geometry') -----
- extent: aPoint
- | newExtent priorEditor |
- bounds extent = aPoint ifTrue: [^ self].
- priorEditor := editor.
- self isAutoFit
- ifTrue: [wrapFlag ifFalse: [^ self]. "full autofit can't change"
- newExtent := aPoint truncated.
- newExtent x = self extent x ifTrue: [^ self]. "No change of wrap width"
- self releaseParagraph. "invalidate the paragraph cache"
- super extent: newExtent.
- priorEditor
- ifNil: [self fit] "since the width has changed..."
- ifNotNil: [self installEditorToReplace: priorEditor]]
- ifFalse: [super extent: aPoint truncated.
- wrapFlag ifFalse: [^ self]. "no effect on composition"
- self composeToBounds]
- !
Item was removed:
- ----- Method: TextMorph>>fillStyle (in category 'visual properties') -----
- fillStyle
- "Return the current fillStyle of the receiver."
- ^ self
- valueOfProperty: #fillStyle
- ifAbsent: [backgroundColor
- ifNil: [Color transparent]]!
Item was removed:
- ----- Method: TextMorph>>fillStyle: (in category 'visual properties') -----
- fillStyle: aFillStyle
- "Set the current fillStyle of the receiver."
- self setProperty: #fillStyle toValue: aFillStyle.
- "Workaround for Morphs not yet converted"
- backgroundColor := aFillStyle asColor.
- self changed.!
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>>firstCharacterIndex (in category 'linked frames') -----
- firstCharacterIndex
- ^ self paragraph firstCharacterIndex!
Item was removed:
- ----- Method: TextMorph>>firstInChain (in category 'linked frames') -----
- firstInChain
- "Return the first morph in a chain of textMorphs"
-
- | first |
- first := self.
- [first predecessor isNil] whileFalse: [first := first predecessor].
- ^first!
Item was removed:
- ----- Method: TextMorph>>fit (in category 'private') -----
- fit
- "Adjust my bounds to fit the text. Should be a no-op if autoFit is not specified.
- Required after the text changes,
- or if wrapFlag is true and the user attempts to change the extent."
-
- | newExtent para cBounds lastOfLines heightOfLast |
- self isAutoFit
- ifTrue: "Adjust at least my height"
- [wrapFlag
- ifTrue: "Keep my width"
- [ | box |
- box := self innerBounds. "i.e, no borders"
- margins ifNotNil: [box := box insetBy: margins].
- newExtent := box width @ self paragraph extent y]
- ifFalse: "Adjust my width"
- [ newExtent := self paragraph extent ].
- newExtent := newExtent + (2 * self borderWidth).
- margins
- ifNotNil: [newExtent := ((0 @ 0 extent: newExtent) expandBy: margins) extent].
- newExtent ~= bounds extent
- ifTrue:
- [(container isNil and: [successor isNil])
- ifTrue:
- [para := paragraph. "Save para (layoutChanged smashes it)"
- super extent: newExtent.
- paragraph := para]].
- container notNil & successor isNil
- ifTrue:
- [cBounds := container bounds truncated.
- "23 sept 2000 - try to allow vertical growth"
- lastOfLines := self paragraph lines last.
- heightOfLast := lastOfLines bottom - lastOfLines top.
- (lastOfLines last < text size
- and: [lastOfLines bottom + heightOfLast >= self bottom])
- ifTrue:
- [container releaseCachedState.
- cBounds := cBounds origin corner: cBounds corner + (0 @ heightOfLast)].
- self privateBounds: cBounds]].
-
- "These statements should be pushed back into senders"
- self paragraph positionWhenComposed: self position.
- successor ifNotNil: [successor predecessorChanged].
- self changed "Too conservative: only paragraph composition
- should cause invalidation."!
Item was removed:
- ----- Method: TextMorph>>fixUponLoad:seg: (in category 'objects from disk') -----
- fixUponLoad: aProject seg: anImageSegment
- "We are in an old project that is being loaded from disk. Fix up conventions that have changed."
-
- | substituteFont |
- wrapFlag ifNil:[wrapFlag := true].
- substituteFont := aProject projectParameters at: #substitutedFont ifAbsent: [#none].
- (substituteFont ~~ #none and: [self textStyle fontArray includes: substituteFont])
- ifTrue: [ self fit ].
-
- ^ super fixUponLoad: aProject seg: anImageSegment!
Item was removed:
- ----- Method: TextMorph>>followCurve (in category 'menu') -----
- followCurve
- self setContainer: (TextOnCurveContainer new baseline: 0; textDirection: 1).
- self changed!
Item was removed:
- ----- Method: TextMorph>>font: (in category 'accessing') -----
- font: aFont
- "Change the receiver's default font, which is used to draw its contents. Remove all custom font-face-related attributes from the current contents. For a less harsh approach, just use #textStyle: instead and rely on text attributes.
-
- !! It is best practice to work with #textStyle: and rely on the text attributes TextFontChange and (sometimes) TextFontReference."
-
- self text ifNotNil: [
- self text removeAttributesThat: [:attr | attr isTextFontChange and: [attr canFontBeSubstituted]].
-
- aFont emphasis ~= 0 ifTrue: [
- self text addAttribute: (TextEmphasis new emphasisCode: aFont emphasis; yourself)]].
-
- self textStyle: aFont asNewTextStyle.!
Item was removed:
- ----- Method: TextMorph>>fontName:pointSize: (in category 'initialization') -----
- fontName: fontName pointSize: fontSize
- "Change the receiver's default font, which is used to draw its contents. Also see commentary in #font:."
-
- self font: (((TextStyle named: fontName asSymbol) ifNil: [TextStyle default]) fontOfPointSize: fontSize).!
Item was removed:
- ----- Method: TextMorph>>fontName:size: (in category 'initialization') -----
- fontName: fontName size: pixelSize
- "Change the receiver's default font, which is used to draw its contents. Also see commentary in #font:."
-
- self font: (((TextStyle named: fontName asSymbol) ifNil: [TextStyle default]) fontOfSize: pixelSize).!
Item was removed:
- ----- Method: TextMorph>>fullPrintOn: (in category 'printing') -----
- fullPrintOn: aStream
-
- aStream nextPutAll: '('.
- super fullPrintOn: aStream.
- aStream nextPutAll: ') contents: '; print: text!
Item was removed:
- ----- Method: TextMorph>>getAllButFirstCharacter (in category 'scripting access') -----
- getAllButFirstCharacter
- "Obtain all but the first character from the receiver; if that would be empty, return a black dot"
-
- | aString |
- ^ (aString := text string) size > 1
- ifTrue: [aString copyFrom: 2 to: aString size]
- ifFalse: ['·']!
Item was removed:
- ----- Method: TextMorph>>getFirstCharacter (in category 'accessing') -----
- getFirstCharacter
- "obtain the first character from the receiver if it is empty, return a
- black dot"
- | aString |
- ^ (aString := text string) isEmpty
- ifTrue: ['·']
- ifFalse: [aString first asString] !
Item was removed:
- ----- Method: TextMorph>>getLastCharacter (in category 'accessing') -----
- getLastCharacter
- "obtain the last character from the receiver if it is empty, return a black dot"
-
- | aString |
- ^ (aString := text string) size > 0
- ifTrue: [aString last asString]
- ifFalse: ['·']!
Item was removed:
- ----- Method: TextMorph>>getMenu: (in category 'event handling') -----
- getMenu: shiftKeyState
- ^ (shiftKeyState not or: [Preferences noviceMode])
- ifTrue: [TextEditor yellowButtonMenu]
- ifFalse: [TextEditor shiftedYellowButtonMenu]!
Item was removed:
- ----- Method: TextMorph>>goBehind (in category 'submorphs - add/remove') -----
- goBehind
- "We need to save the container, as it knows about fill and run-around"
- | cont |
- container ifNil: [^ super goBehind].
- self releaseParagraph. "Cause recomposition"
- cont := container. "Save the container"
- super goBehind. "This will change owner, nilling the container"
- container := cont. "Restore the container"
- self changed!
Item was removed:
- ----- Method: TextMorph>>hResizing (in category 'layout-properties') -----
- hResizing
-
- self layoutProperties ifNotNil: [:props |
- ^ props hResizing].
-
- (self isAutoFit and: [self isWrapped])
- ifTrue: [^ #rigid]. "or #spaceFill"
- (self isAutoFit and: [self isWrapped not])
- ifTrue: [^ #shrinkWrap].
- (self isAutoFit not and: [self isWrapped])
- ifTrue: [^ #rigid]. "or #spaceFill"
- (self isAutoFit not and: [self isWrapped not])
- ifTrue: [^ #rigid]. "or #spaceFill"!
Item was removed:
- ----- Method: TextMorph>>hResizing: (in category 'layout-properties') -----
- hResizing: aSymbol
-
- super hResizing: aSymbol.
-
- aSymbol == #shrinkWrap
- ifTrue: [self autoFit: true; wrapFlag: false];
- ifFalse: ["#rigid or #spaceFill -- Prefer to not cut out text."
- self autoFit: self vResizing == #shrinkWrap; wrapFlag: true].
-
- self releaseParagraph.!
Item was removed:
- ----- Method: TextMorph>>handleEdit: (in category 'editing') -----
- handleEdit: editBlock
- "Ensure that changed areas get suitably redrawn"
- | result |
- self selectionChanged. "Note old selection"
- result := editBlock value.
- self selectionChanged. "Note new selection"
- self updateFromParagraph. "Propagate changes as necessary"
- ^result!
Item was removed:
- ----- Method: TextMorph>>handleInteraction:fromEvent: (in category 'editing') -----
- handleInteraction: interactionBlock fromEvent: evt
- "Perform the changes in interactionBlock, noting any change in selection
- and possibly a change in the size of the paragraph (ar 9/22/2001 - added for TextPrintIts)"
-
- | oldEditor oldParagraph oldText oldSelection |
- oldEditor := editor.
- oldParagraph := paragraph.
- oldText := oldParagraph text copy.
- oldSelection := oldParagraph selectionRects. "already copy"
-
- "1) Note old selection to avoid visual glitches."
- self selectionChanged: oldSelection.
-
- "2) Evaluate the interaction. Ensure access to paragraph."
- interactionBlock value.
- paragraph ifNil: [self createParagraph].
-
- "3) ?!! Account for premature #releaseEditor ?!!"
- oldParagraph == paragraph ifTrue: [
- self flag: #fixme.
- editor := oldEditor].
-
- "4) Note new selection to avoid visual glitches."
- paragraph selectionRects in: [:newSelection |
- newSelection ~= oldSelection ifTrue: [
- self selectionChanged: newSelection]].
-
- "5) Update my layout as a morph if necessary."
- (oldText = paragraph text and: [ oldText runs = paragraph text runs ])
- ifFalse: [ self updateFromParagraph ].
-
- self flag: #ImmPlugin.
- "self setCompositionWindow."!
Item was removed:
- ----- Method: TextMorph>>handleKeystroke: (in category 'events-processing') -----
- handleKeystroke: anEvent
- "Overwritten to support tab-among-fields preference."
-
- | pasteUp |
- anEvent wasHandled ifTrue:[^self].
- (self handlesKeyboard: anEvent) ifFalse: [^ self].
- (anEvent hand keyboardFocus ~~ self
- and: [self handlesKeyboardOnlyOnFocus])
- ifTrue: [^ self].
-
- anEvent keyCharacter = Character tab ifTrue: [
- "Allow passing through text morph inside pasteups"
- (self wouldAcceptKeyboardFocusUponTab
- and: [(pasteUp := self pasteUpMorphHandlingTabAmongFields) notNil])
- ifTrue: [
- anEvent wasHandled: true.
- ^ pasteUp tabHitWithEvent: anEvent]].
-
- ^ super handleKeystroke: anEvent!
Item was removed:
- ----- Method: TextMorph>>handleMouseMove: (in category 'events-processing') -----
- handleMouseMove: anEvent
- "Re-implemented to allow for mouse-up move events"
- anEvent wasHandled ifTrue:[^self]. "not interested"
- (anEvent hand hasSubmorphs) ifTrue:[^self].
- anEvent wasHandled: true.
- self mouseMove: anEvent.
- (anEvent anyButtonPressed and:[anEvent hand mouseFocus == self]) ifFalse:[^self].
- (self handlesMouseStillDown: anEvent) ifTrue:[
- "Step at the new location"
- self startStepping: #handleMouseStillDown:
- at: Time millisecondClockValue
- arguments: {anEvent copy resetHandlerFields}
- stepTime: 1].
- !
Item was removed:
- ----- Method: TextMorph>>handlesKeyboard: (in category 'event handling') -----
- handlesKeyboard: evt
- ^true!
Item was removed:
- ----- Method: TextMorph>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: evt
- self isPartsDonor ifTrue: [^ false].
- ^ self innerBounds containsPoint: evt cursorPoint!
Item was removed:
- ----- Method: TextMorph>>handlesMouseOver: (in category 'event handling') -----
- handlesMouseOver: evt
- ^ self isPartsDonor not!
Item was removed:
- ----- Method: TextMorph>>hasFocus (in category 'event handling') -----
- hasFocus
- ^editor notNil!
Item was removed:
- ----- Method: TextMorph>>hasTranslucentColor (in category 'accessing') -----
- hasTranslucentColor
- "Overridden from BorderedMorph to test backgroundColor instead of (text) color."
-
- ^ self backgroundColor isNil
- or: [self backgroundColor isColor and: [self backgroundColor isTranslucentColor]]
- or: [self borderColor isColor and: [self borderColor isTranslucentColor]]!
Item was removed:
- ----- Method: TextMorph>>hasUnacceptedEdits: (in category 'editing') -----
- hasUnacceptedEdits: aBoolean
- "Ignored here, but noted in TextMorphForEditView"
- !
Item was removed:
- ----- Method: TextMorph>>holderForCharacters (in category 'menu') -----
- holderForCharacters
- "Hand the user a Holder that is populated with individual text morphs representing my characters"
-
- | aHolder |
- aHolder := ScriptingSystem prototypicalHolder.
- aHolder setNameTo: 'H', self externalName.
- text string do:
- [:aChar |
- aHolder addMorphBack: (TextMorph new contents: aChar asText)].
- aHolder setProperty: #donorTextMorph toValue: self.
- aHolder fullBounds.
- aHolder openInHand!
Item was removed:
- ----- Method: TextMorph>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
-
- textStyle := TextStyle default copy.
-
- wrapFlag := false.
- autoFit := true.!
Item was removed:
- ----- Method: TextMorph>>insertCharacters: (in category 'scripting access') -----
- insertCharacters: aString
- "Insert the characters from the given source at my current cursor position"
-
- | aLoc aText attributes |
- aLoc := self cursor max: 1.
- aText := aLoc > text size
- ifTrue: [aString asText]
- ifFalse: [
- attributes := (text attributesAt: aLoc)
- select: [:attr | attr mayBeExtended].
- Text string: aString attributes: attributes].
- paragraph replaceFrom: aLoc to: (aLoc - 1) with: aText displaying: true.
- self updateFromParagraph !
Item was removed:
- ----- Method: TextMorph>>insertContentsOf: (in category 'scripting access') -----
- insertContentsOf: aPlayer
- "Insert the characters from the given player at my current cursor position"
-
- | aLoc |
- aLoc := self cursor.
- paragraph replaceFrom: aLoc to: (aLoc - 1) with: aPlayer getStringContents displaying: true.
- self updateFromParagraph !
Item was removed:
- ----- Method: TextMorph>>installEditorToReplace: (in category 'private') -----
- installEditorToReplace: priorEditor
- "Install an editor for my paragraph. This constitutes 'hasFocus'.
- If priorEditor is not nil, then initialize the new editor from its state.
- We may want to rework this so it actually uses the prior editor."
-
- | stateArray |
- priorEditor ifNotNil: [stateArray := priorEditor stateArray].
- editor := self editorClass new morph: self.
- editor changeParagraph: self paragraph.
- priorEditor
- ifNil: [editor history: TextEditorCommandHistory new]
- ifNotNil: [editor stateArrayPut: stateArray].
- self selectionChanged.
- ^ editor!
Item was removed:
- ----- Method: TextMorph>>isAutoFit (in category 'accessing') -----
- isAutoFit
- "For migrating old instances only. See #initialize."
-
- ^ autoFit ifNil: [autoFit := true]!
Item was removed:
- ----- Method: TextMorph>>isLinkedTo: (in category 'linked frames') -----
- isLinkedTo: aMorph
- self firstInChain withSuccessorsDo:
- [:m | m == aMorph ifTrue: [^ true]].
- ^ false!
Item was removed:
- ----- Method: TextMorph>>isTextMorph (in category 'classification') -----
- isTextMorph
- ^true!
Item was removed:
- ----- Method: TextMorph>>isWrapped (in category 'accessing') -----
- isWrapped
-
- ^wrapFlag!
Item was removed:
- ----- Method: TextMorph>>justified (in category 'alignment') -----
- justified
- self paragraph justified.
- self updateFromParagraph!
Item was removed:
- ----- Method: TextMorph>>keyStroke: (in category 'event handling') -----
- keyStroke: evt
- "Handle a keystroke event."
-
- self resetBlinkCursor. "don't blink during type-in"
- ToolSet
- codeCompletionAround: [
- evt keyValue = 13 ifTrue: [ "CR - check for special action"
- self crAction ifNotNil: [ :action |
- "Note: Code below assumes that this was some
- input field reacting on CR. Break the keyboard
- focus so that the receiver can be safely deleted."
- evt hand newKeyboardFocus: nil.
- ^action valueWithEnoughArguments: { evt } ] ].
- self handleInteraction: [ self editor keyStroke: evt ] fromEvent: evt.
- "self updateFromParagraph."
- super keyStroke: evt "sends to keyStroke event handler, if any" ]
- textMorph: self
- keyStroke: evt!
Item was removed:
- ----- Method: TextMorph>>keyboardFocusChange: (in category 'event handling') -----
- keyboardFocusChange: weHaveFocus
-
- paragraph ifNotNil: [:para | para focused: weHaveFocus].
-
- weHaveFocus
- ifTrue: [ "A hand is wanting to send us characters..."
- self hasFocus ifFalse: [self editor "Forces install"].
- Editor blinkingCursor
- ifTrue: [self startBlinking]
- ifFalse: [self resetBlinkCursor "ensure caret visible"]]
- ifFalse: [ "A hand has clicked elsewhere..."
- self world ifNotNil: [:w |
- self flag: #suspicious. "mt: Why should this be called with 'false' if a hand holds on the focus? Do hands not talk to each other before sending this call? They should..."
- w handsDo: [:h | h keyboardFocus == self ifTrue: [^self]].
- "Release control unless some hand is still holding on"
- self releaseEditor].
- self stopBlinking].
- !
Item was removed:
- ----- Method: TextMorph>>lastCharacterIndex (in category 'linked frames') -----
- lastCharacterIndex
- ^ self paragraph lastCharacterIndex!
Item was removed:
- ----- Method: TextMorph>>layoutChanged (in category 'layout') -----
- layoutChanged
- "For embedded morphs, we have to invalidate our paragraph if those morphs invalidate their layout. Since paragraph creation will also change this morph's bounds, ignore that case."
-
- "2019-10-16 mt Does not work. Breaks up scroll ranges after saving a method. Breaks highlight of opening parenthesis in Shout."
- "(self hasProperty: #CreatingParagraph) ifFalse: [self releaseParagraph]."
-
- ^ super layoutChanged!
Item was removed:
- ----- Method: TextMorph>>leftFlush (in category 'alignment') -----
- leftFlush
- self paragraph leftFlush.
- self updateFromParagraph!
Item was removed:
- ----- Method: TextMorph>>loadCachedState (in category 'caching') -----
- loadCachedState
- "Prepare for fast response -- next page of a book?"
- self paragraph!
Item was removed:
- ----- Method: TextMorph>>margins (in category 'accessing') -----
- margins
-
- ^margins!
Item was removed:
- ----- Method: TextMorph>>margins: (in category 'accessing') -----
- margins: newMargins
- "newMargins can be a number, point or rectangle, as allowed by, eg, insetBy:."
-
- margins := newMargins.
- self composeToBounds!
Item was removed:
- ----- Method: TextMorph>>maximumContainerExtent (in category 'geometry') -----
- maximumContainerExtent
- "For text composition. Returns the maximum area for text to be composed."
-
- ^ 9999999 at 9999999!
Item was removed:
- ----- Method: TextMorph>>minCompositionHeight (in category 'layout') -----
- minCompositionHeight
-
- ^ (textStyle ifNil: [TextStyle default]) lineGrid!
Item was removed:
- ----- Method: TextMorph>>minCompositionWidth (in category 'layout') -----
- minCompositionWidth
-
- ^ ((textStyle ifNil: [TextStyle default]) defaultFont widthOf: $x) * 2!
Item was removed:
- ----- Method: TextMorph>>minHeight (in category 'layout') -----
- minHeight
-
- | result |
- result := (paragraph
- ifNil: [self minCompositionHeight]
- ifNotNil: [paragraph lines first lineHeight])
- + (self borderWidth*2).
- margins ifNil: [^ result].
-
- ^ margins isRectangle
- ifTrue: [result + margins top + margins bottom]
- ifFalse: [margins isPoint
- ifTrue: [result + margins y + margins y]
- ifFalse: [result + (2*margins)]]!
Item was removed:
- ----- Method: TextMorph>>minWidth (in category 'layout') -----
- minWidth
-
- | result |
- result := self minCompositionWidth + (self borderWidth*2).
- margins ifNil: [^ result].
-
- ^ margins isRectangle
- ifTrue: [result + margins left + margins right]
- ifFalse: [margins isPoint
- ifTrue: [result + margins x + margins x]
- ifFalse: [result + (2*margins)]]!
Item was removed:
- ----- Method: TextMorph>>mouseDown: (in category 'event handling') -----
- mouseDown: evt
- "Make this TextMorph be the keyboard input focus, if it isn't
- already, and repond to the text selection gesture."
-
- evt yellowButtonPressed ifTrue: [
- "First check for option (menu) click"
- ^ self yellowButtonActivity: evt shiftPressed].
-
- "Show the caret immediately on mouse down to give user feedback."
- self resetBlinkCursor.
-
- "If focus does not follow the mouse cursor and we click below everything, just grab the focus to not destroy the selection."
- ((self hasKeyboardFocus: evt hand) not and: [(self bounds containsPoint: evt position) not])
- ifTrue: [evt hand newKeyboardFocus: self]
- ifFalse: [
- evt hand newKeyboardFocus: self.
- self
- handleInteraction: [self mouseEnter: evt. editor mouseDown: evt]
- fromEvent: evt].!
Item was removed:
- ----- Method: TextMorph>>mouseEnter: (in category 'event handling') -----
- mouseEnter: evt
-
- self editor updateCursorForEvent: evt.!
Item was removed:
- ----- Method: TextMorph>>mouseLeave: (in category 'event handling') -----
- mouseLeave: evt
-
- evt hand showTemporaryCursor: nil.!
Item was removed:
- ----- Method: TextMorph>>mouseMove: (in category 'event handling') -----
- mouseMove: evt
-
- evt redButtonPressed ifFalse: [
- (self enterClickableRegion: evt)
- ifFalse: [self editor updateCursorForEvent: evt].
- ^ self].
-
- self
- handleInteraction: [self editor mouseMove: evt]
- fromEvent: evt.!
Item was removed:
- ----- Method: TextMorph>>mouseUp: (in category 'event handling') -----
- mouseUp: evt
- self handleInteraction: [editor mouseUp: evt] fromEvent: evt!
Item was removed:
- ----- Method: TextMorph>>newContents: (in category 'accessing') -----
- newContents: stringOrText
- "Accept new text contents."
- | newText embeddedMorphs oldSelection |
- newText := stringOrText isString
- ifTrue: [Text fromString: stringOrText copy ]
- ifFalse: [ stringOrText copy asText. "should be veryDeepCopy?" ].
- self plainTextOnly ifTrue: [ newText removeAttributesThat: [:att | att isTextAlignment not] ].
-
- (text = newText and: [text runs = newText runs]) ifTrue: [^ self]. "No substantive change"
- text ifNotNil: [(embeddedMorphs := text embeddedMorphs)
- ifNotNil:
- [self removeAllMorphsIn: embeddedMorphs.
- embeddedMorphs do: [:m | m delete]]].
-
- oldSelection := editor ifNotNil: [:ed | ed selectionInterval].
- text := newText.
-
- "add all morphs off the visible region; they'll be moved into the right
- place when they become visible. (this can make the scrollable area too
- large, though)"
- newText embeddedMorphs do:
- [:m |
- self addMorph: m.
- m position: -1000 @ 0].
- self releaseParagraph.
- "update the paragraph cache"
- self paragraph.
- oldSelection ifNotNil: [:sel | self selectFrom: sel first to: sel last].
- "re-instantiate to set bounds"
- self world ifNotNil: [self world startSteppingSubmorphsOf: self]!
Item was removed:
- ----- Method: TextMorph>>occlusionsOnOff (in category 'containment') -----
- occlusionsOnOff
- "Establish a container for this text, with opposite occlusion avoidance status"
- self setContainer:
- (container
- ifNil: [(TextContainer new for: self minWidth: textStyle lineGrid*2)
- fillsOwner: false; avoidsOcclusions: true]
- ifNotNil: [(container avoidsOcclusions and: [container fillsOwner not])
- ifTrue: [nil "Return to simple rectangular bounds"]
- ifFalse: [container avoidsOcclusions: container avoidsOcclusions not]])!
Item was removed:
- ----- Method: TextMorph>>onBlinkCursor (in category 'blinking') -----
- onBlinkCursor
-
- | para |
- para := paragraph ifNil: [^nil].
- Time millisecondClockValue < self blinkStart
- ifTrue: [para showCaret: para focused]
- ifFalse: [para showCaret: para showCaret not].
- para caretRect ifNotNil: [ :r | self invalidRect: r].!
Item was removed:
- ----- Method: TextMorph>>ownerChanged (in category 'change reporting') -----
- ownerChanged
- | priorEditor |
- super ownerChanged.
- container ifNotNil:
- [editor isNil
- ifTrue:
- [self releaseParagraph.
- (container isKindOf: TextContainer) ifTrue:
- ["May need to recompose due to changes in owner"
- self installEditorToReplace: nil.
- self releaseParagraph]]
- ifFalse:
- [priorEditor := editor.
- self releaseParagraph.
- self installEditorToReplace: priorEditor]]!
Item was removed:
- ----- Method: TextMorph>>paragraph (in category 'private') -----
- paragraph
- "Paragraph instantiation is lazy -- create it only when needed"
-
- ^ paragraph ifNil: [self createParagraph]!
Item was removed:
- ----- Method: TextMorph>>paragraphClass (in category 'private') -----
- paragraphClass
- container ifNil: [^ NewParagraph].
- ^ container paragraphClass!
Item was removed:
- ----- Method: TextMorph>>passKeyboardFocusTo: (in category 'editing') -----
- passKeyboardFocusTo: otherMorph
- | w |
- self flag: #arNote. "Do we need this?!!"
- (w := self world) isNil
- ifFalse:
- [w
- handsDo: [:h | h keyboardFocus == self ifTrue: [h newKeyboardFocus: otherMorph]]]!
Item was removed:
- ----- Method: TextMorph>>plainTextOnly (in category 'accessing') -----
- plainTextOnly
-
- ^ plainTextOnly ifNil: [false]!
Item was removed:
- ----- Method: TextMorph>>plainTextOnly: (in category 'accessing') -----
- plainTextOnly: aBoolean
-
- plainTextOnly := aBoolean.!
Item was removed:
- ----- Method: TextMorph>>predecessor (in category 'linked frames') -----
- predecessor
- ^ predecessor!
Item was removed:
- ----- Method: TextMorph>>predecessor:successor: (in category 'private') -----
- predecessor: pred successor: succ
- "Private -- for use only in morphic duplication"
- predecessor := pred.
- successor := succ.
- !
Item was removed:
- ----- Method: TextMorph>>predecessorChanged (in category 'private') -----
- predecessorChanged
- | newStart oldStart |
- (self hasProperty: #CreatingParagraph) ifTrue: [^self].
- newStart := predecessor isNil
- ifTrue: [1]
- ifFalse: [predecessor lastCharacterIndex + 1].
- (self paragraph adjustedFirstCharacterIndex ~= newStart
- or: [newStart >= text size])
- ifTrue:
- [paragraph composeAllStartingAt: newStart.
- self fit]
- ifFalse:
- ["If the offset to end of text has not changed, just slide"
- oldStart := self firstCharacterIndex.
- self withSuccessorsDo: [:m | m adjustLineIndicesBy: newStart - oldStart]]!
Item was removed:
- ----- Method: TextMorph>>preferredKeyboardPosition (in category 'Multilingual-ImmPlugin') -----
- preferredKeyboardPosition
- | default rects |
- self flag: #ImmPlugin.
- default := (self bounds: self bounds in: self world) topLeft.
- paragraph
- ifNil: [^ default].
- rects := paragraph selectionRects.
- rects size = 0
- ifTrue: [^ default].
- ^ rects first bottomLeft!
Item was removed:
- ----- Method: TextMorph>>privateMoveBy: (in category 'geometry') -----
- privateMoveBy: delta
- super privateMoveBy: delta.
- editor
- ifNil: [ paragraph ifNotNil: [paragraph moveBy: delta]]
- ifNotNil: [
- "When moving text with an active editor, save and restore all state."
- paragraph moveBy: delta.
- self installEditorToReplace: editor]!
Item was removed:
- ----- Method: TextMorph>>privateOwner: (in category 'private') -----
- privateOwner: newOwner
- "Nil the container when text gets extracted"
- super privateOwner: newOwner.
- container ifNotNil: [
- newOwner ifNotNil: [
- newOwner isWorldOrHandMorph ifTrue: [self setContainer: nil]]]!
Item was removed:
- ----- Method: TextMorph>>readOnly (in category 'accessing') -----
- readOnly
-
- ^ readOnly ifNil: [false]!
Item was removed:
- ----- Method: TextMorph>>readOnly: (in category 'accessing') -----
- readOnly: aBoolean
-
- readOnly := aBoolean.!
Item was removed:
- ----- Method: TextMorph>>recognizerArena (in category 'containment') -----
- recognizerArena
- "Answer the rectangular area, in world coordinates, that the character recognizer should regard as its tablet"
-
- | outer |
- ^ (outer := self ownerThatIsA: PluggableTextMorph)
- ifNotNil: [outer boundsInWorld]
- ifNil: [self boundsInWorld]!
Item was removed:
- ----- Method: TextMorph>>recomposeChain (in category 'linked frames') -----
- recomposeChain
- "Recompose this textMorph and all that follow it."
- self withSuccessorsDo:
- [:m | m text: text textStyle: textStyle; "Propagate new style if any"
- releaseParagraph; "Force recomposition"
- fit "and propagate the change"]!
Item was removed:
- ----- Method: TextMorph>>releaseCachedState (in category 'caching') -----
- releaseCachedState
-
- super releaseCachedState.
- self releaseParagraph; paragraph.
- !
Item was removed:
- ----- Method: TextMorph>>releaseEditor (in category 'private') -----
- releaseEditor
- "Release the editor for my paragraph. This morph no longer 'hasFocus'."
- editor ifNotNil:
- [self selectionChanged.
- self paragraph selectionStart: nil selectionStop: nil.
- editor := nil].!
Item was removed:
- ----- Method: TextMorph>>releaseParagraph (in category 'private') -----
- releaseParagraph
-
- "a slight kludge so subclasses can have a bit more control over whether the paragraph really
- gets released. important for GeeMail since the selection needs to be accessible even if the
- hand is outside me"
-
- self releaseParagraphReally.
- !
Item was removed:
- ----- Method: TextMorph>>releaseParagraphReally (in category 'private') -----
- releaseParagraphReally
-
- "a slight kludge so subclasses can have a bit more control over whether the paragraph really
- gets released. important for GeeMail since the selection needs to be accessible even if the
- hand is outside me"
-
- "Paragraph instantiation is lazy -- it will be created only when needed"
- self releaseEditor.
- paragraph ifNotNil:
- [paragraph := nil].
- container ifNotNil:
- [container releaseCachedState]!
Item was removed:
- ----- Method: TextMorph>>removedMorph: (in category 'private') -----
- removedMorph: aMorph
- | range |
- range := text find: (TextAnchor new anchoredMorph: aMorph).
- range ifNotNil: [
- self paragraph
- replaceFrom: range first
- to: range last
- with: Text new
- displaying: false.
- self fit].
- super removedMorph: aMorph.!
Item was removed:
- ----- Method: TextMorph>>resetBlinkCursor (in category 'blinking') -----
- resetBlinkCursor
- "Reset the blinking cursor"
- | para |
- self blinkStart: Time millisecondClockValue + 500.
- para := paragraph ifNil: [^self].
- para showCaret = para focused ifFalse:[
- para caretRect ifNotNil: [ :r | self invalidRect: r].
- para showCaret: para focused.].
- !
Item was removed:
- ----- Method: TextMorph>>reverseCurveDirection (in category 'menu') -----
- reverseCurveDirection
- container textDirection: container textDirection negated.
- self paragraph composeAll!
Item was removed:
- ----- Method: TextMorph>>rightFlush (in category 'alignment') -----
- rightFlush
- self paragraph rightFlush.
- self updateFromParagraph!
Item was removed:
- ----- Method: TextMorph>>selectAll (in category 'accessing') -----
- selectAll
-
- self selectionChanged.
- self editor selectAll.
- self selectionChanged.!
Item was removed:
- ----- Method: TextMorph>>selectFrom:to: (in category 'accessing') -----
- selectFrom: start to: stop
-
- self selectionChanged.
- self editor selectFrom: start to: stop.
- self selectionChanged.
- !
Item was removed:
- ----- Method: TextMorph>>selectInterval: (in category 'accessing') -----
- selectInterval: anInterval
-
- self selectionChanged.
- self editor selectInterval: anInterval.
- self selectionChanged.
- !
Item was removed:
- ----- Method: TextMorph>>selection (in category 'accessing') -----
- selection
- ^editor ifNotNil: [ editor selection ]!
Item was removed:
- ----- Method: TextMorph>>selectionChanged (in category 'private') -----
- selectionChanged
-
- self selectionChanged: self paragraph selectionRects.!
Item was removed:
- ----- Method: TextMorph>>selectionChanged: (in category 'private') -----
- selectionChanged: rects
- "Invalidate all the selection rectangles. By using either fullBounds or outerBounds, we make sure that any drop shadow is accounted for too."
-
- | myBounds |
- rects ifEmpty: [^ self].
- myBounds := fullBounds ifNil: [self outerBounds].
- rects do: [:r | self invalidRect: (r intersect: myBounds)].!
Item was removed:
- ----- Method: TextMorph>>selectionColor (in category 'accessing') -----
- selectionColor
- ^ self valueOfProperty: #selectionColor ifAbsent: [Color blue muchLighter]!
Item was removed:
- ----- Method: TextMorph>>selectionColor: (in category 'accessing') -----
- selectionColor: aColor
-
- self
- setProperty: #selectionColor
- toValue: aColor.!
Item was removed:
- ----- Method: TextMorph>>selectionInterval (in category 'accessing') -----
- selectionInterval
-
- ^ self editor selectionInterval!
Item was removed:
- ----- Method: TextMorph>>selectionInterval: (in category 'accessing') -----
- selectionInterval: anInterval
-
- self selectInterval: anInterval.!
Item was removed:
- ----- Method: TextMorph>>setAllButFirstCharacter: (in category 'scripting access') -----
- setAllButFirstCharacter: source
- "Set all but the first char of the receiver to the source"
- | chars |
- (chars := self getCharacters) isEmpty
- ifTrue: [self newContents: '·' , source asString]
- ifFalse: [self newContents: (String
- streamContents: [:aStream |
- aStream nextPut: chars first.
- aStream nextPutAll: source])]!
Item was removed:
- ----- Method: TextMorph>>setCharacters: (in category 'accessing') -----
- setCharacters: chars
- "obtain a string value from the receiver"
-
- (self getCharacters = chars) ifFalse:
- [self newContents: chars]!
Item was removed:
- ----- Method: TextMorph>>setCompositionWindow (in category 'editing') -----
- setCompositionWindow
-
- | hand |
- self flag: #ImmPlugin.
- hand := self primaryHand.
- hand ifNotNil: [hand compositionWindowManager keyboardFocusForAMorph: self].
- !
Item was removed:
- ----- Method: TextMorph>>setContainer: (in category 'containment') -----
- setContainer: newContainer
- "Adopt (or abandon) container shape"
- self changed.
- container := newContainer.
- self releaseParagraph!
Item was removed:
- ----- Method: TextMorph>>setCurveBaseline: (in category 'menu') -----
- setCurveBaseline: evt
- | handle origin |
- origin := evt cursorPoint.
- handle := HandleMorph new forEachPointDo:
- [:newPoint | handle removeAllMorphs.
- handle addMorph:
- (PolygonMorph vertices: (Array with: origin with: newPoint)
- color: Color black borderWidth: 1 borderColor: Color black).
- container baseline: (newPoint - origin) y negated asInteger // 5.
- self paragraph composeAll].
- evt hand attachMorph: handle.
- handle startStepping !
Item was removed:
- ----- Method: TextMorph>>setDefaultContentsIfNil (in category 'private') -----
- setDefaultContentsIfNil
- "Set the default contents"
-
- | toUse |
- text ifNil:
- [toUse := self valueOfProperty: #defaultContents.
- toUse ifNil: [toUse :='abc' asText "allBold"]. "try it plain for a while"
- text := toUse]!
Item was removed:
- ----- Method: TextMorph>>setFirstCharacter: (in category 'accessing') -----
- setFirstCharacter: source
- "Set the first character of the receiver as indicated"
- | aChar chars |
- aChar := source asCharacter.
- (chars := self getCharacters) isEmpty
- ifTrue: [self
- newContents: (String with: aChar)]
- ifFalse: [chars first = aChar
- ifFalse: [self
- newContents: (String
- streamContents: [:aStream |
- aStream nextPut: aChar.
- aStream
- nextPutAll: (chars copyFrom: 2 to: chars size)])]] !
Item was removed:
- ----- Method: TextMorph>>setLastCharacter: (in category 'accessing') -----
- setLastCharacter: source
- "Set the last character of the receiver as indicated"
-
- | aChar chars |
- aChar := source asCharacter.
- (chars := self getCharacters) size > 0
- ifFalse:
- [self newContents: (String with: aChar)]
- ifTrue:
- [(chars last = aChar) ifFalse:
- [self newContents: (String streamContents:
- [:aStream |
- aStream nextPutAll: (chars copyFrom: 1 to: (chars size - 1)).
- aStream nextPut: aChar])]]!
Item was removed:
- ----- Method: TextMorph>>setPredecessor: (in category 'private') -----
- setPredecessor: newPredecessor
- predecessor := newPredecessor!
Item was removed:
- ----- Method: TextMorph>>setSuccessor: (in category 'private') -----
- setSuccessor: newSuccessor
-
- successor := newSuccessor.
- paragraph ifNotNil: [paragraph wantsColumnBreaks: successor notNil].
- !
Item was removed:
- ----- Method: TextMorph>>setTextStyle: (in category 'initialization') -----
- setTextStyle: aTextStyle
-
- self flag: #deprecated.
- self textStyle: aTextStyle.!
Item was removed:
- ----- Method: TextMorph>>startBlinking (in category 'blinking') -----
- startBlinking
- self startStepping: #onBlinkCursor
- at: Time millisecondClockValue
- arguments: nil stepTime: 500.
- self resetBlinkCursor.
- !
Item was removed:
- ----- Method: TextMorph>>startDrag: (in category 'event handling') -----
- startDrag: evt
-
- self removeProperty: #waitingForTextDrag.
-
- [evt hand grabMorph: (TransferMorph withPassenger: self selection from: self)]
- ensure: [evt hand releaseMouseFocus: self].!
Item was removed:
- ----- Method: TextMorph>>startingIndex (in category 'linked frames') -----
- startingIndex
- predecessor isNil
- ifTrue: [^ 1].
- ^ predecessor lastCharacterIndex + 1 !
Item was removed:
- ----- Method: TextMorph>>stopBlinking (in category 'blinking') -----
- stopBlinking
- self stopSteppingSelector: #onBlinkCursor.
- self resetBlinkCursor. "Ensure caret visible."!
Item was removed:
- ----- Method: TextMorph>>string:fontName:size: (in category 'initialization') -----
- string: aString fontName: aName size: aSize
-
- self string: aString fontName: aName size: aSize wrap: true!
Item was removed:
- ----- Method: TextMorph>>string:fontName:size:wrap: (in category 'initialization') -----
- string: aString fontName: aName size: aSize wrap: shouldWrap
-
- shouldWrap
- ifTrue: [self contentsWrapped: aString]
- ifFalse: [self contentsAsIs: aString].
-
- self fontName: aName size: aSize!
Item was removed:
- ----- Method: TextMorph>>successor (in category 'linked frames') -----
- successor
- ^ successor!
Item was removed:
- ----- Method: TextMorph>>text (in category 'accessing') -----
- text
- ^ text!
Item was removed:
- ----- Method: TextMorph>>text:textStyle: (in category 'private') -----
- text: t textStyle: s
- "Private -- for use only in morphic duplication"
- text := t.
- textStyle := s.
- paragraph ifNotNil: [paragraph textStyle: s]!
Item was removed:
- ----- Method: TextMorph>>text:textStyle:wrap:color:predecessor:successor: (in category 'private') -----
- text: t textStyle: s wrap: wrap color: c
- predecessor: pred successor: succ
- "Private -- for use only in morphic duplication"
- text := t.
- textStyle := s.
- wrapFlag := wrap.
- color := c.
- paragraph := editor := container := nil.
- self predecessor: pred successor: succ!
Item was removed:
- ----- Method: TextMorph>>textAlignment (in category 'accessing') -----
- textAlignment
- "Answer 1..4, representing #leftFlush, #rightFlush, #centered, or #justified"
- ^self editor textAlignment!
Item was removed:
- ----- Method: TextMorph>>textAlignmentSymbol (in category 'accessing') -----
- textAlignmentSymbol
- "Answer one of #leftFlush, #rightFlush, #centered, or #justified"
- ^self editor textAlignmentSymbol!
Item was removed:
- ----- Method: TextMorph>>textBounds (in category 'geometry') -----
- textBounds
- ^ bounds!
Item was removed:
- ----- Method: TextMorph>>textColor (in category 'accessing') -----
- textColor
-
- ^ color!
Item was removed:
- ----- Method: TextMorph>>textColor: (in category 'accessing') -----
- textColor: aColor
-
- color = aColor ifTrue: [^ self].
- color := aColor.
- self changed.
- !
Item was removed:
- ----- Method: TextMorph>>textStyle (in category 'accessing') -----
- textStyle
- ^textStyle!
Item was removed:
- ----- Method: TextMorph>>textStyle: (in category 'accessing') -----
- textStyle: aTextStyle
- "Change the receiver's set of fonts to aTextStyle. You can access those fonts via the TextFontChange text attribute. If you want to enfore a specific font face or point size, use #font: instead. NOTE THAT you must provide either a freshly created instance of TextStyle or a copy of an existing one. NEVER use, for example, TextStyle class >> #default directly. Also see senders and implementors of #asNewTextStyle."
-
- textStyle := aTextStyle.
- self releaseParagraph; changed.!
Item was removed:
- ----- Method: TextMorph>>unfocusedSelectionColor (in category 'accessing') -----
- unfocusedSelectionColor
- ^ self valueOfProperty: #unfocusedSelectionColor ifAbsent: [Color blue muchLighter]!
Item was removed:
- ----- Method: TextMorph>>unfocusedSelectionColor: (in category 'accessing') -----
- unfocusedSelectionColor: aColor
-
- self
- setProperty: #unfocusedSelectionColor
- toValue: aColor.!
Item was removed:
- ----- Method: TextMorph>>updateFromParagraph (in category 'private') -----
- updateFromParagraph
- "A change has taken place in my paragraph, as a result of editing and I must be updated. If a line break causes recomposition of the current paragraph, or it the selection has entered a different paragraph, then the current editor will be released, and must be reinstalled with the resulting new paragraph, while retaining any editor state, such as selection, undo state, and current typing emphasis."
-
- | newStyle sel oldLast oldEditor back |
- paragraph ifNil: [^self].
- wrapFlag ifNil: [wrapFlag := true].
- editor ifNotNil:
- [oldEditor := editor.
- sel := editor selectionInterval.
- editor storeSelectionInParagraph].
- text := paragraph text.
- paragraph textStyle = textStyle
- ifTrue: [self fit]
- ifFalse:
- ["Broadcast style changes to all morphs"
-
- newStyle := paragraph textStyle.
- (self firstInChain text: text textStyle: newStyle) recomposeChain.
- editor ifNotNil: [self installEditorToReplace: editor]].
-
- self layoutChanged.
- sel ifNil: [^self].
-
- "If selection is in top line, then recompose predecessor for possible ripple-back"
- predecessor ifNotNil:
- [sel first <= (self paragraph lines first last + 1)
- ifTrue:
- [oldLast := predecessor lastCharacterIndex.
- predecessor paragraph
- recomposeFrom: oldLast
- to: text size
- delta: 0.
- oldLast = predecessor lastCharacterIndex
- ifFalse:
- [predecessor changed. "really only last line"
- self predecessorChanged]]].
- ((back := predecessor notNil
- and: [sel first <= self paragraph firstCharacterIndex]) or:
- [successor notNil
- and: [sel first > (self paragraph lastCharacterIndex + 1)]])
- ifTrue:
- ["The selection is no longer inside this paragraph.
- Pass focus to the paragraph that should be in control."
-
- back ifTrue: [predecessor recomposeChain] ifFalse: [self recomposeChain].
- self firstInChain withSuccessorsDo:
- [:m |
- (sel first between: m firstCharacterIndex and: m lastCharacterIndex + 1)
- ifTrue:
- [m installEditorToReplace: oldEditor.
- ^self passKeyboardFocusTo: m]].
- self error: 'Inconsistency in text editor' "Must be somewhere in the successor chain"].
- editor ifNil:
- ["Reinstate selection after, eg, style change"
-
- self installEditorToReplace: oldEditor].
-
- self flag: #ImmPlugin.
- "self setCompositionWindow."
- !
Item was removed:
- ----- Method: TextMorph>>userString (in category 'accessing') -----
- userString
- "Do I have a text string to be searched on?"
-
- ^text ifNotNil: [:txt| txt string]!
Item was removed:
- ----- Method: TextMorph>>vResizing (in category 'layout-properties') -----
- vResizing
-
- self layoutProperties ifNotNil: [:props |
- ^ props vResizing].
-
- (self isAutoFit and: [self isWrapped])
- ifTrue: [^ #shrinkWrap].
- (self isAutoFit and: [self isWrapped not])
- ifTrue: [^ #shrinkWrap].
- (self isAutoFit not and: [self isWrapped])
- ifTrue: [^ #rigid]. "or #spaceFill"
- (self isAutoFit not and: [self isWrapped not])
- ifTrue: [^ #rigid]. "or #spaceFill"!
Item was removed:
- ----- Method: TextMorph>>vResizing: (in category 'layout-properties') -----
- vResizing: aSymbol
-
- super vResizing: aSymbol.
-
- self autoFit: aSymbol == #shrinkWrap.
-
- self wrapDirection: (aSymbol == #shrinkWrap
- ifTrue: [#topToBottom]
- ifFalse: [#none]).
-
- self releaseParagraph.!
Item was removed:
- ----- Method: TextMorph>>veryDeepFixupWith: (in category 'copying') -----
- veryDeepFixupWith: deepCopier
- "If target and arguments fields were weakly copied, fix them here. If
- they were in the tree being copied, fix them up, otherwise point to the
- originals!!"
-
- super veryDeepFixupWith: deepCopier.
- "It makes no sense to share pointers to an existing predecessor and successor"
- predecessor := deepCopier references at: predecessor ifAbsent: [nil].
- successor := deepCopier references at: successor ifAbsent: [nil]!
Item was removed:
- ----- Method: TextMorph>>veryDeepInner: (in category 'copying') -----
- veryDeepInner: deepCopier
- "Copy all of my instance variables. Some need to be not copied at all, but shared.
- Warning!!!! Every instance variable defined in this class must be handled.
- We must also implement veryDeepFixupWith:. See DeepCopier class comment."
-
- super veryDeepInner: deepCopier.
- textStyle := textStyle veryDeepCopyWith: deepCopier.
- text := text veryDeepCopyWith: deepCopier.
- wrapFlag := wrapFlag veryDeepCopyWith: deepCopier.
- paragraph := paragraph veryDeepCopyWith: deepCopier.
- editor := editor veryDeepCopyWith: deepCopier.
- container := container veryDeepCopyWith: deepCopier.
- predecessor := predecessor.
- successor := successor.
- backgroundColor := backgroundColor veryDeepCopyWith: deepCopier.
- margins := margins veryDeepCopyWith: deepCopier.!
Item was removed:
- ----- Method: TextMorph>>wantsKeyboardFocus (in category 'event handling') -----
- wantsKeyboardFocus
-
- ^ true!
Item was removed:
- ----- Method: TextMorph>>withNoLineLongerThan: (in category 'converting') -----
- withNoLineLongerThan: numChars
- "Convenience only to establish this protocol across String, Text, and TextMorph."
-
- self averageLineLength: numChars.
- ^ self paragraph asTextWithLineBreaks!
Item was removed:
- ----- Method: TextMorph>>withSuccessorsDo: (in category 'linked frames') -----
- withSuccessorsDo: aBlock
- "Evaluate aBlock for each morph in my successor chain"
-
- | each |
- each := self.
- [each isNil] whileFalse:
- [aBlock value: each.
- each := each successor]!
Item was removed:
- ----- Method: TextMorph>>wouldAcceptKeyboardFocusUponTab (in category 'event handling') -----
- wouldAcceptKeyboardFocusUponTab
- "Answer whether the receiver might accept keyboard focus if
- tab were hit in some container playfield"
- ^ self inPartsBin not!
Item was removed:
- ----- Method: TextMorph>>wrapDirection (in category 'layout-properties') -----
- wrapDirection
-
- self layoutProperties ifNotNil: [:props |
- ^ props wrapDirection].
-
- ^ self vResizing == #shrinkWrap
- ifTrue: [#topToBottom]
- ifFalse: [#none]!
Item was removed:
- ----- Method: TextMorph>>wrapFlag: (in category 'accessing') -----
- wrapFlag: aBoolean
- "Private!! Please use #hResizing: and #vResizing:."
-
- "Whether contained text will adjust its bounds as I change shape:
- | wrapFlag | TextMorph grows | TextMorph shrinks |
- | true | wrapped lines fill new space | long lines wrap to fit |
- | false | wrapped lines stay same | long lines are cut off |"
-
- aBoolean == wrapFlag ifTrue: [^ self].
- wrapFlag := aBoolean.
- self composeToBounds!
Item was removed:
- ----- Method: TextMorph>>wrapOnOff (in category 'menu') -----
- wrapOnOff
- self wrapFlag: wrapFlag not!
Item was removed:
- ----- Method: TextMorph>>wrapString (in category 'menu') -----
- wrapString
- "Answer the string to put in a menu that will invite the user to
- switch autoFit mode"
- ^ (wrapFlag
- ifTrue: ['<yes>']
- ifFalse: ['<no>'])
- , 'text wrap to bounds' translated!
Item was removed:
- ----- Method: TextMorph>>xeqLinkText:withParameter: (in category 'editing') -----
- xeqLinkText: sourceString withParameter: param
- self confirm: 'xeqLinkText:
- ' asText allBold , sourceString asText!
Item was removed:
- ----- Method: TextMorph>>yellowButtonActivity: (in category 'event handling') -----
- yellowButtonActivity: shiftKeyState
- "Invoke the text-editing menu"
- | menu |
- (menu := self getMenu: shiftKeyState)
- ifNotNil: [""
- menu setInvokingView: self editor.
- self flag: #refactor. "mt: This should work non-modally..."
- menu invokeModal. self changed]!
Item was removed:
- TextMorph subclass: #TextMorphForEditView
- instanceVariableNames: 'editView acceptOnCR'
- classVariableNames: 'DraggableTextSelection'
- poolDictionaries: ''
- category: 'Morphic-Text Support'!
Item was removed:
- ----- Method: TextMorphForEditView class>>draggableTextSelection (in category 'preferences') -----
- draggableTextSelection
-
- <preference: 'Draggable Text Selections'
- categoryList: #(editing mouse Morphic)
- description: 'Whether you can drag-and-drop selections in text morphs.'
- type: #Boolean>
-
- ^ DraggableTextSelection ifNil: [false]!
Item was removed:
- ----- Method: TextMorphForEditView class>>draggableTextSelection: (in category 'preferences') -----
- draggableTextSelection: aBooleanOrNil
-
- DraggableTextSelection := aBooleanOrNil.
-
- self draggableTextSelection in: [:aBoolean |
- TextMorphForEditView allInstancesDo: [:tm |
- tm dragEnabled: aBoolean; dropEnabled: aBoolean]].!
Item was removed:
- ----- Method: TextMorphForEditView class>>includeInNewMorphMenu (in category 'new-morph participation') -----
- includeInNewMorphMenu
- "Not to be instantiated from the menu"
- ^ false!
Item was removed:
- ----- Method: TextMorphForEditView>>acceptContents (in category 'editing') -----
- acceptContents
- "The message is sent when the user hits enter or Cmd-S.
- Accept the current contents and end editing."
- self updateFromParagraph.
- editView accept.!
Item was removed:
- ----- Method: TextMorphForEditView>>acceptDroppingMorph:event: (in category 'dropping/grabbing') -----
- acceptDroppingMorph: aTransferMorph event: evt
- "Accept a text to be inserted at the event/cursor position. Either remove or keep the source text depending on the transfer morph's copy state."
-
- | sourceEditor |
- sourceEditor := (aTransferMorph source respondsTo: #editor)
- ifTrue: [aTransferMorph source editor]
- ifFalse: [nil].
-
- self
- handleInteraction: [
-
- "1) Delete selection if it is a move operation."
- (aTransferMorph shouldCopy or: [sourceEditor isNil]) ifFalse: [
- sourceEditor destructiveBackWord.
- sourceEditor history previous isCompositeRedo: sourceEditor == self editor].
-
- "2) Insert selection at new place."
- self editor addText: aTransferMorph passenger asText event: evt.
- self editor history previous
- isCompositeUndo: (sourceEditor == self editor and: [aTransferMorph shouldCopy not])]
-
- fromEvent: evt.
-
- evt hand newKeyboardFocus: self.!
Item was removed:
- ----- Method: TextMorphForEditView>>acceptOnCR (in category 'editing') -----
- acceptOnCR
- "Answer whether the receiver wants to accept when the Return key is hit"
-
- ^ acceptOnCR == true!
Item was removed:
- ----- Method: TextMorphForEditView>>acceptOnCR: (in category 'accept/cancel') -----
- acceptOnCR: trueOrFalse
- acceptOnCR := trueOrFalse!
Item was removed:
- ----- Method: TextMorphForEditView>>autoScrollView: (in category 'event handling') -----
- autoScrollView: evt
- "This is kind of a hack because the PluggableTextMorph expects me to first expand the selection before auto scrolling will work."
- | localEvt |
- localEvt := evt transformedBy: (self transformedFrom: editView).
- super mouseMove: localEvt.
- editView scrollSelectionIntoView: localEvt.!
Item was removed:
- ----- Method: TextMorphForEditView>>cancelEdits (in category 'editing') -----
- cancelEdits
- "The message is sent when the user hits enter or Cmd-L.
- Cancel the current contents and end editing."
- super cancelEdits.
- editView cancel!
Item was removed:
- ----- Method: TextMorphForEditView>>cancelEditsSafely (in category 'editing') -----
- cancelEditsSafely
- "Safe variation of #cancelEdits, where the undo history is not discarded and can thus be used to undo the cancel operation."
-
- editView cancelSafely.!
Item was removed:
- ----- Method: TextMorphForEditView>>convertToCurrentVersion:refStream: (in category 'objects from disk') -----
- convertToCurrentVersion: varDict refStream: smartRefStrm
-
- acceptOnCR ifNil: [acceptOnCR := false].
- ^super convertToCurrentVersion: varDict refStream: smartRefStrm.
-
- !
Item was removed:
- ----- Method: TextMorphForEditView>>doLayoutIn: (in category 'layout') -----
- doLayoutIn: layoutBounds
-
- | shouldRestoreSelection |
- self flag: #workaround. "mt: The combination of 'releaseParagraph; paragraph' resets the selection. We should find a better way for this in the future. Sigh...."
-
- shouldRestoreSelection := paragraph isNil.
-
- super doLayoutIn: layoutBounds.
-
- shouldRestoreSelection ifTrue: [
- self editView ifNotNil: [:view |
- view restoreSelectionInterval]].!
Item was removed:
- ----- Method: TextMorphForEditView>>drawNullTextOn: (in category 'drawing') -----
- drawNullTextOn: aCanvas
- "Just run the normal code to show selection in a window"
- aCanvas paragraph: self paragraph bounds: bounds color: color
- !
Item was removed:
- ----- Method: TextMorphForEditView>>editView (in category 'edit view') -----
- editView
- ^ editView!
Item was removed:
- ----- Method: TextMorphForEditView>>flash (in category 'macpal') -----
- flash
- ^ editView flash!
Item was removed:
- ----- Method: TextMorphForEditView>>handleInteraction:fromEvent: (in category 'editing') -----
- handleInteraction: interActionBlock fromEvent: evt
- "Overridden to pass along a model to the editor for, eg, link resolution, doits, etc"
-
- self editor model: editView model. "For evaluateSelection, etc"
- ^ super handleInteraction: interActionBlock fromEvent: evt!
Item was removed:
- ----- Method: TextMorphForEditView>>hasUnacceptedEdits: (in category 'editing') -----
- hasUnacceptedEdits: aBoolean
- "Set the hasUnacceptedEdits flag in my view."
-
- editView hasUnacceptedEdits: aBoolean!
Item was removed:
- ----- Method: TextMorphForEditView>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
-
- self acceptOnCR: false.
- self dragEnabled: self class draggableTextSelection.
- self dropEnabled: self class draggableTextSelection.!
Item was removed:
- ----- Method: TextMorphForEditView>>keyStroke: (in category 'event handling') -----
- keyStroke: evt
- | view |
-
- editView deleteBalloon.
- self editor model: editView model. "For evaluateSelection"
- view := editView. "Copy into temp for case of a self-mutating doit"
- (acceptOnCR and: [evt keyCharacter = Character cr])
- ifTrue: [^ self editor accept].
-
- view hasUserEdited: false.
- super keyStroke: evt.
- view scrollSelectionIntoView.
-
- view hasUserEdited
- ifTrue: [ view textEdited: self contents].!
Item was removed:
- ----- Method: TextMorphForEditView>>keyboardFocusChange: (in category 'event handling') -----
- keyboardFocusChange: weHaveFocus
- "Overwritten because we do not want to release the editor if we do not have the focus. Editors and their paragraphs store the text selection, which we want to reuse after getting keyboard focus again. This supports keyboard navigation."
-
- paragraph ifNotNil: [:para | para focused: weHaveFocus].
-
- weHaveFocus
- ifFalse: [self stopBlinking]
- ifTrue: [
- self hasFocus
- ifFalse: [self editor "forces install"].
- Editor blinkingCursor
- ifTrue: [self startBlinking]
- ifFalse: [self resetBlinkCursor "ensure caret visible"]].
-
- self changed.
-
- "Tell my edit-view about this because I am his delegate."
- self editView keyboardFocusChange: weHaveFocus.
- !
Item was removed:
- ----- Method: TextMorphForEditView>>mouseDown: (in category 'event handling') -----
- mouseDown: event
-
- event yellowButtonPressed ifTrue: [
- (self editor yellowButtonDown: event) ifTrue:[^self].
- ^ editView yellowButtonActivity: event shiftPressed].
- ^ super mouseDown: event
- !
Item was removed:
- ----- Method: TextMorphForEditView>>mouseMove: (in category 'event handling') -----
- mouseMove: evt
- | editEvt |
- super mouseMove: evt.
- evt redButtonPressed ifFalse: [^ self].
- editEvt := evt transformedBy: (self transformedFrom: editView) inverseTransformation.
- (editEvt position y between: editView top and: editView bottom) ifFalse:[
- "Start auto-scrolling"
- self startStepping: #autoScrollView:
- at: Time millisecondClockValue
- arguments: (Array with: editEvt)
- stepTime: 100. "fast enough"
- ] ifTrue:[
- self stopSteppingSelector: #autoScrollView:.
- ].!
Item was removed:
- ----- Method: TextMorphForEditView>>mouseUp: (in category 'event handling') -----
- mouseUp: evt
- super mouseUp: evt.
- self stopSteppingSelector: #autoScrollView:.
- editView scrollSelectionIntoView: evt.
-
- self flag: #ImmPlugin.
- "self setCompositionWindow."
- !
Item was removed:
- ----- Method: TextMorphForEditView>>preferredKeyboardPosition (in category 'Multilingual-ImmPlugin') -----
- preferredKeyboardPosition
-
- | pos |
- self flag: #ImmPlugin.
- pos := super preferredKeyboardPosition.
- ^ pos + (self boundsInWorld) topLeft.
- !
Item was removed:
- ----- Method: TextMorphForEditView>>setEditView: (in category 'edit view') -----
- setEditView: editPane
- editView := editPane!
Item was removed:
- ----- Method: TextMorphForEditView>>tempCommand (in category 'debug and other') -----
- tempCommand
- "Smalltalk browseAllImplementorsOf: #tempCommand"
- "Place your definition for tempCommand for this class here"!
Item was removed:
- ----- Method: TextMorphForEditView>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
- wantsDroppedMorph: aMorph event: evt
-
- ^ ((super wantsDroppedMorph: aMorph event: evt)
- and: [aMorph isTransferMorph])
- and: [aMorph passenger isString or: [aMorph passenger isText]]!
Item was removed:
- ----- Method: TextMorphForEditView>>wouldAcceptKeyboardFocusUponTab (in category 'event handling') -----
- wouldAcceptKeyboardFocusUponTab
- "Answer whether the receiver would be a happy inheritor of keyboard focus if tab were hit in an enclosing playfield under propitious circumstances. Does not make sense for this kind of morph, which is encased in a window"
-
- ^ false!
Item was removed:
- ----- Method: TextStyle class>>emphasisMenuForFont:target:selector:highlight: (in category '*Morphic-user interface') -----
- emphasisMenuForFont: font target: target selector: selector highlight: currentEmphasis
- "Offer a font emphasis menu for the given style. If one is selected, pass that font to target with a call to selector. The fonts will be displayed in that font.
- Answer nil if no derivatives exist.
- "
-
- | aMenu derivs |
- derivs := font derivativeFonts.
- derivs isEmpty ifTrue: [ ^nil ].
- aMenu := MenuMorph entitled: 'emphasis' translated.
- derivs := derivs asOrderedCollection.
- derivs addFirst: font.
- derivs do: [ :df |
- aMenu
- add: df emphasisString
- target: target
- selector: selector
- argument: df.
- aMenu lastItem font: df.
- df emphasis == currentEmphasis ifTrue: [aMenu lastItem color: Color blue darker]].
- ^ aMenu!
Item was removed:
- ----- Method: TextStyle class>>fontMenuForStyle:target:selector: (in category '*Morphic-user interface') -----
- fontMenuForStyle: styleName target: target selector: selector
- ^self fontMenuForStyle: styleName target: target selector: selector highlight: nil!
Item was removed:
- ----- Method: TextStyle class>>fontMenuForStyle:target:selector:highlight: (in category '*Morphic-user interface') -----
- fontMenuForStyle: styleName target: target selector: selector highlight: currentFont
- "Offer a font menu for the given style. If one is selected, pass
- that font to target with a
- call to selector. The fonts will be displayed in that font."
- | aMenu |
- aMenu := MenuMorph entitled: styleName.
- (TextStyle named: styleName)
- ifNotNil: [:s | s isTTCStyle
- ifTrue: [aMenu
- add: 'New Size'
- target: self
- selector: #chooseTTCFontSize:
- argument: {styleName. target. selector}]].
- (self pointSizesFor: styleName)
- do: [:pointSize |
- | font subMenu displayFont |
- font := (self named: styleName)
- fontOfPointSize: pointSize.
- subMenu := self
- emphasisMenuForFont: font
- target: target
- selector: selector
- highlight: (currentFont
- ifNotNil: [:cf | (cf familyName = styleName
- and: [cf pointSize = font pointSize])
- ifTrue: [currentFont emphasis]]).
- subMenu
- ifNil: [aMenu
- add: pointSize asString , ' Point'
- target: target
- selector: selector
- argument: font]
- ifNotNil: [aMenu add: pointSize asString , ' Point' subMenu: subMenu].
- displayFont := font.
- (font isSymbolFont or:[(font hasDistinctGlyphsForAll: pointSize asString , ' Point') not])
- ifTrue:[
- "don't use a symbol font to display its own name!!!!"
- displayFont := self default fontOfPointSize: pointSize].
- aMenu lastItem font: displayFont.
- currentFont
- ifNotNil: [:cf | (cf familyName = styleName
- and: [cf pointSize = font pointSize])
- ifTrue: [aMenu lastItem color: Color blue darker]]].
- ^ aMenu!
Item was removed:
- ----- Method: TextStyle class>>promptForFont:andSendTo:withSelector: (in category '*Morphic-user interface') -----
- promptForFont: aPrompt andSendTo: aTarget withSelector: aSelector
- self promptForFont: aPrompt andSendTo: aTarget withSelector: aSelector highlight: nil!
Item was removed:
- ----- Method: TextStyle class>>promptForFont:andSendTo:withSelector:highlight: (in category '*Morphic-user interface') -----
- promptForFont: aPrompt andSendTo: aTarget withSelector: aSelector highlight: currentFont
- "Morphic Only!! prompt for a font and if one is provided, send it to aTarget using a
- message with selector aSelector."
- "TextStyle promptForFont: 'Choose system font:' andSendTo: Preferences withSelector:
- #setSystemFontTo: "
- "Derived from a method written by Robin Gibson"
- | menu currentTextStyle |
- currentTextStyle := currentFont
- ifNotNil: [currentFont textStyleName].
- menu := MenuMorph entitled: aPrompt.
- self actualTextStyles keysSortedSafely
- do: [:styleName | | subMenu |
- subMenu := self
- fontMenuForStyle: styleName
- target: aTarget
- selector: aSelector
- highlight: currentFont.
- menu add: styleName subMenu: subMenu.
- menu lastItem
- font: ((self named: styleName)
- fontOfSize: 18).
- styleName = currentTextStyle
- ifTrue: [menu lastItem color: Color blue darker]].
- menu popUpInWorld: self currentWorld!
Item was removed:
- ----- Method: TextURL>>actOnClickFor: (in category '*Morphic') -----
- actOnClickFor: anObject
- "Do what you can with this URL. Later a web browser."
-
- | m |
-
- (url beginsWith: 'sqPr://') ifTrue: [
- ProjectLoading thumbnailFromUrl: (url copyFrom: 8 to: url size).
- ^ true "should not get here, but what the heck"
- ].
- (url beginsWith: 'code://') ifTrue: [
- Project current addDeferredUIMessage: [self open: (Compiler evaluate: (url allButFirst: 7))].
- ^ true "should not get here, but what the heck"
- ].
- "if it's a web browser, tell it to jump"
- anObject isWebBrowser
- ifTrue: [anObject jumpToUrl: url. ^ true]
- ifFalse: [((anObject respondsTo: #model) and: [anObject model isWebBrowser])
- ifTrue: [anObject model jumpToUrl: url. ^ true]].
-
- "if it's a morph, see if it is contained in a web browser"
- (anObject isKindOf: Morph) ifTrue: [
- m := anObject.
- [ m ~= nil ] whileTrue: [
- (m isWebBrowser) ifTrue: [
- m jumpToUrl: url.
- ^true ].
- (m hasProperty: #webBrowserView) ifTrue: [
- m model jumpToUrl: url.
- ^true ].
- m := m owner. ]
- ].
-
- "no browser in sight. ask if we should start a new browser"
- WebBrowser defaultOrNil
- ifNil: [Clipboard clipboardText: url]
- ifNotNil: [:wb |
- (UIManager default
- confirm: ('Do you want to open this URL in a Web browser?\\{1}' translated withCRs format: {url})
- title: 'Open Web Page' translated)
- ifTrue: [wb openOnUrl: url].
- ^ true ].
-
- "Couldn't display in a browser. Offer to put up just the source"
- (UIManager default
- confirm: ('There is no Web browser installed but the URL was copied to the clipboard:\{1}\\Do you want to view the Web page''s source/response anyway?' translated withCRs format: {url})
- title: 'Open Web Page' translated)
-
- ifTrue: [
- (Smalltalk classNamed: 'WebClient')
- ifNotNil: [:wc | Project current addDeferredUIMessage: [(wc httpGet: url) explore]]
- ifNil: [HTTPSocket httpShowPage: url]].
-
- ^ true!
Item was removed:
- ----- Method: TextURL>>open: (in category '*Morphic') -----
- open: anObject
-
- anObject isBehavior ifTrue: [
- ^ ToolSet browseClass: anObject].
- anObject isCompiledMethod ifTrue: [
- ^ ToolSet browse: anObject methodClass selector: anObject selector].
- anObject class == MethodReference ifTrue: [
- ^ ToolSet browse: anObject actualClass selector: anObject selector].
- anObject isSymbol ifTrue: [
- SystemNavigation default browseAllImplementorsOf: anObject.
- SystemNavigation default browseAllCallsOn: anObject.
- self flag: #todo. "mt: Which tool window to return in this case?"
- ^ self].!
Item was removed:
- Object subclass: #TheWorldMainDockingBar
- instanceVariableNames: ''
- classVariableNames: 'Instance ShowSecondsInClock TS TwentyFourHourClock'
- poolDictionaries: ''
- category: 'Morphic-Kernel'!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>applyUserInterfaceTheme (in category 'preferences') -----
- applyUserInterfaceTheme
-
- self updateInstances.!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>cleanUp (in category 'initialize-release') -----
- cleanUp
- self updateInstances.!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>disableMenuPreference: (in category 'preferences') -----
- disableMenuPreference: aPreferenceSymbol
-
- self setMenuPreference: aPreferenceSymbol to: false.!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>enableMenuPreference: (in category 'preferences') -----
- enableMenuPreference: aPreferenceSymbol
-
- self setMenuPreference: aPreferenceSymbol to: true.!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>getMenuPreference: (in category 'preferences') -----
- getMenuPreference: aPreferenceSymbol
-
- ^ self getMenuPreference: aPreferenceSymbol ifAbsent: [true]!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>getMenuPreference:ifAbsent: (in category 'preferences') -----
- getMenuPreference: aPreferenceSymbol ifAbsent: aBlock
-
- | project |
- ^ (project := Project current) isMorphic
- ifTrue: [project projectPreferenceFlagDictionary at: aPreferenceSymbol ifAbsent: aBlock]
- ifFalse: aBlock
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>initialize (in category 'class initialization') -----
- initialize
- "self initialize"
-
- self updateInstances.!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>instance (in category 'access') -----
- instance
- "Answer the receiver's instance"
- ^ Instance ifNil: [ Instance := self new ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>instance: (in category 'access') -----
- instance: aTheWorldMainDockingBar
- Instance := aTheWorldMainDockingBar.
- self updateInstances!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>localeChanged (in category 'events') -----
- localeChanged
- self updateInstances!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>setMenuPreference:to: (in category 'preferences') -----
- setMenuPreference: aPreferenceSymbol to: aBooleanOrNil
- | project |
- (project := Project current) isMorphic ifTrue: [
- aBooleanOrNil
- ifNil: ["Reset to default value."
- (Preferences preferenceAt: aPreferenceSymbol) ifNotNil: [:pref | pref restoreDefaultValue]]
- ifNotNil: [
- project projectPreferenceFlagDictionary at: aPreferenceSymbol put: aBooleanOrNil].
- (aBooleanOrNil ~= (Preferences preferenceAt: aPreferenceSymbol))
- ifTrue: [Preferences setPreference: aPreferenceSymbol toValue: aBooleanOrNil]].
- self updateInstances.!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>setTimeStamp (in category 'timestamping') -----
- setTimeStamp
- "Change the receiver's timeStamp"
- TS := UUID new!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showAppsMenuInWorldMainDockingBar (in category 'preferences') -----
- showAppsMenuInWorldMainDockingBar
-
- <preference: 'Show ''Apps'' menu in world main docking bar'
- category: 'docking bars'
- description: 'Whether world''s main docking bar should show the ''Apps'' menu.'
- type: #Boolean>
- ^ self getMenuPreference: #showAppsMenuInWorldMainDockingBar ifAbsent: [true]
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showAppsMenuInWorldMainDockingBar: (in category 'preferences') -----
- showAppsMenuInWorldMainDockingBar: aBoolean
-
- self
- setMenuPreference: #showAppsMenuInWorldMainDockingBar
- to: aBoolean.
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showDoMenuInWorldMainDockingBar (in category 'preferences') -----
- showDoMenuInWorldMainDockingBar
-
- <preference: 'Show ''Do'' menu in world main docking bar'
- category: 'docking bars'
- description: 'Whether world''s main docking bar should show the ''Do'' menu.'
- type: #Boolean>
- ^ self getMenuPreference: #showDoMenuInWorldMainDockingBar ifAbsent: [true]
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showDoMenuInWorldMainDockingBar: (in category 'preferences') -----
- showDoMenuInWorldMainDockingBar: aBoolean
-
- self
- setMenuPreference: #showDoMenuInWorldMainDockingBar
- to: aBoolean.
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showExtrasMenuInWorldMainDockingBar (in category 'preferences') -----
- showExtrasMenuInWorldMainDockingBar
-
- <preference: 'Show ''Extras'' menu in world main docking bar'
- category: 'docking bars'
- description: 'Whether world''s main docking bar should show the ''Extras'' menu.'
- type: #Boolean>
- ^ self getMenuPreference: #showExtrasMenuInWorldMainDockingBar ifAbsent: [true]
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showExtrasMenuInWorldMainDockingBar: (in category 'preferences') -----
- showExtrasMenuInWorldMainDockingBar: aBoolean
-
- self
- setMenuPreference: #showExtrasMenuInWorldMainDockingBar
- to: aBoolean.
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showHelpMenuInWorldMainDockingBar (in category 'preferences') -----
- showHelpMenuInWorldMainDockingBar
-
- <preference: 'Show ''Help'' menu in world main docking bar'
- category: 'docking bars'
- description: 'Whether world''s main docking bar should show the ''Help'' menu.'
- type: #Boolean>
- ^ self getMenuPreference: #showHelpMenuInWorldMainDockingBar ifAbsent: [true]
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showHelpMenuInWorldMainDockingBar: (in category 'preferences') -----
- showHelpMenuInWorldMainDockingBar: aBoolean
-
- self
- setMenuPreference: #showHelpMenuInWorldMainDockingBar
- to: aBoolean.
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showMainMenuInWorldMainDockingBar (in category 'preferences') -----
- showMainMenuInWorldMainDockingBar
-
- <preference: 'Show ''Main'' menu in world main docking bar'
- category: 'docking bars'
- description: 'Whether world''s main docking bar should show the ''Main'' menu.'
- type: #Boolean>
- ^ self getMenuPreference: #showMainMenuInWorldMainDockingBar ifAbsent: [true]
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showMainMenuInWorldMainDockingBar: (in category 'preferences') -----
- showMainMenuInWorldMainDockingBar: aBoolean
-
- self
- setMenuPreference: #showMainMenuInWorldMainDockingBar
- to: aBoolean.
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showProjectsMenuInWorldMainDockingBar (in category 'preferences') -----
- showProjectsMenuInWorldMainDockingBar
-
- <preference: 'Show ''Projects'' menu in world main docking bar'
- category: 'docking bars'
- description: 'Whether world''s main docking bar should show the ''Projects'' menu.'
- type: #Boolean>
- ^ self getMenuPreference: #showProjectsMenuInWorldMainDockingBar ifAbsent: [true]
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showProjectsMenuInWorldMainDockingBar: (in category 'preferences') -----
- showProjectsMenuInWorldMainDockingBar: aBoolean
-
- self
- setMenuPreference: #showProjectsMenuInWorldMainDockingBar
- to: aBoolean.
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showSecondsInClock (in category 'preferences') -----
- showSecondsInClock
- <preference: 'Show seconds in clock'
- category: 'docking bars'
- description: 'Whether the clock in the world''s main docking bar should display seconds.'
- type: #Boolean>
- ^ ShowSecondsInClock ifNil: [ true ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showSecondsInClock: (in category 'preferences') -----
- showSecondsInClock: boolean
-
- ShowSecondsInClock := boolean.
- self updateInstances.!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showToolsMenuInWorldMainDockingBar (in category 'preferences') -----
- showToolsMenuInWorldMainDockingBar
-
- <preference: 'Show ''Tools'' menu in world main docking bar'
- category: 'docking bars'
- description: 'Whether world''s main docking bar should show the ''Tools'' menu.'
- type: #Boolean>
- ^ self getMenuPreference: #showToolsMenuInWorldMainDockingBar ifAbsent: [true]
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showToolsMenuInWorldMainDockingBar: (in category 'preferences') -----
- showToolsMenuInWorldMainDockingBar: aBoolean
-
- self
- setMenuPreference: #showToolsMenuInWorldMainDockingBar
- to: aBoolean.
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showWindowsMenuInWorldMainDockingBar (in category 'preferences') -----
- showWindowsMenuInWorldMainDockingBar
-
- <preference: 'Show ''Windows'' menu in world main docking bar'
- category: 'docking bars'
- description: 'Whether world''s main docking bar should show the ''Windows'' menu.'
- type: #Boolean>
- ^ self getMenuPreference: #showWindowsMenuInWorldMainDockingBar ifAbsent: [true]
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showWindowsMenuInWorldMainDockingBar: (in category 'preferences') -----
- showWindowsMenuInWorldMainDockingBar: aBoolean
-
- self
- setMenuPreference: #showWindowsMenuInWorldMainDockingBar
- to: aBoolean.
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showWorldMainDockingBar (in category 'preferences') -----
- showWorldMainDockingBar
-
- <preference: 'Show world main docking bar'
- category: 'docking bars'
- description: 'Whether world''s main docking bar should be shown or not.'
- type: #Boolean>
- ^Project current showWorldMainDockingBar!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>showWorldMainDockingBar: (in category 'preferences') -----
- showWorldMainDockingBar: aBoolean
-
- Project current showWorldMainDockingBar: aBoolean!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ {
- { #textColor. 'Colors'. 'The color for the clock and other labels.' }.
- { #font. 'Fonts'. 'The font for the clock and other labels.' }.
- { #logoColor. 'Colors'. 'The color of the Squeak logo.' }.
- { #selectionLogoColor. 'Colors'. 'The color of the Squeak logo when it is selected.' }.
- }!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>timeStamp (in category 'timestamping') -----
- timeStamp
- "Answer the receiver's timeStamp"
- ^ TS!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>twentyFourHourClock (in category 'preferences') -----
- twentyFourHourClock
- <preference: '24-hour Time Clock'
- category: 'docking bars'
- description: 'Whether the clock in the world''s main docking bar should present the time in 24-hour format.'
- type: #Boolean>
- ^ TwentyFourHourClock ifNil: [ true ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>twentyFourHourClock: (in category 'preferences') -----
- twentyFourHourClock: aBoolean
- TwentyFourHourClock := aBoolean.
- self updateInstances!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>updateInstances (in category 'events') -----
- updateInstances
- "The class has changed, time to update the instances"
-
- self setTimeStamp.
- Project current in: [:project |
- project isMorphic ifTrue: [
- project assureMainDockingBarPresenceMatchesPreference]].!
Item was removed:
- ----- Method: TheWorldMainDockingBar class>>updateInstances: (in category 'events') -----
- updateInstances: anEvent
- "The class has changed, time to update the instances"
- (anEvent itemClass == self
- or: [anEvent itemClass == self class])
- ifFalse: [^ self].
- ""
- self updateInstances!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>aboutMenuItemOn: (in category 'submenu - squeak') -----
- aboutMenuItemOn: menu
-
- menu addItem: [ :item |
- item
- contents: 'About Squeak...' translated;
- help: 'SystemReporter status of the image and runtime environment' translated;
- target: self;
- selector: #aboutSqueak ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>aboutSqueak (in category 'menu actions') -----
- aboutSqueak
-
- | m |
- m := SystemReporter open.
- m label: 'About Squeak' translated.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>allOtherWindowsLike: (in category 'submenu - windows') -----
- allOtherWindowsLike: window
- ^ self allVisibleWindows reject: [:each |
- each model name ~= window model name or: [each = window]]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>allVisibleWindows (in category 'submenu - windows') -----
- allVisibleWindows
- ^ self allVisibleWindowsIn: Project current world!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>allVisibleWindowsIn: (in category 'submenu - windows') -----
- allVisibleWindowsIn: world
- ^SystemWindow windowsIn: world satisfying: [ :w | w visible ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>allWindowsLike: (in category 'submenu - windows') -----
- allWindowsLike: window
- ^ self allVisibleWindows reject: [:each | each model ~= window model or: [each = window]]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>applyUserInterfaceTheme (in category 'updating') -----
- applyUserInterfaceTheme
- "Do it on the class-side."!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>appsMenuOn: (in category 'submenu - apps') -----
- appsMenuOn: aDockingBar
- "Create a menu with the registered apps"
-
- aDockingBar addItem: [ :item |
- item
- contents: 'Apps' translated;
- subMenuUpdater: self
- selector: #listAppsOn: ]
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar>>browseChangeSet (in category 'submenu - changes') -----
- browseChangeSet
-
- ChangeSetBrowser openOnCurrent.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>browseChangedMethods (in category 'submenu - changes') -----
- browseChangedMethods
-
- ChangedMessageSet openFor: ChangeSet current.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>browseChanges (in category 'submenu - changes') -----
- browseChanges
-
- ChangeSorter open.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>browseChangesDual (in category 'submenu - changes') -----
- browseChangesDual
-
- DualChangeSorter open.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>browseChangesLabel (in category 'submenu - changes') -----
- browseChangesLabel
- "The project name is the same as the current change set."
-
- ^ Project current name!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>browserMenuItemOn: (in category 'submenu - tools') -----
- browserMenuItemOn: menu
-
- menu addItem: [ :item |
- item
- contents: 'Browser' translated;
- help: 'Open a browser' translated;
- icon: (self colorIcon: Browser basicNew windowColorToUse);
- target: StandardToolSet;
- selector: #openClassBrowser ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>canCloseProject (in category 'submenu - projects') -----
- canCloseProject
-
- ^ self canEnterParentProject!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>canEnterParentProject (in category 'submenu - projects') -----
- canEnterParentProject
-
- ^ Project current isTopProject not!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>canEnterPreviousProject (in category 'submenu - projects') -----
- canEnterPreviousProject
-
- ^ Project current previousProject notNil!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>changesMenuOn: (in category 'submenu - changes') -----
- changesMenuOn: aDockingBar
-
- aDockingBar addUpdatingItem: [:item |
- item
- help: 'Browse this project''s changes' translated;
- wordingProvider: self
- wordingSelector: #browseChangesLabel;
- subMenuUpdater: self
- selector: #listChangesOn:].!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>chooseCustomScaleFactor (in category 'submenu - extras') -----
- chooseCustomScaleFactor
-
- | result |
- result := Project uiManager request: 'Please enter a scale factor in %' translated initialAnswer: '350'.
- result ifEmpty: [^ self].
- [result := result asInteger abs] ifError: [^ self].
- result < 100 ifTrue: [^ self].
- Display relativeUiScaleFactor: result / 100.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>clockOn: (in category 'right side') -----
- clockOn: aDockingBar
- aDockingBar
- addMorphBack: (ClockMorph new
- font: self fontToUse;
- color: self colorToUse;
- show24hr: self class twentyFourHourClock;
- showSeconds: self class showSecondsInClock;
- yourself);
- addDefaultSpace!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>closeAllWindows (in category 'submenu - windows') -----
- closeAllWindows
- self allVisibleWindows do: [:each |
- each model canDiscardEdits ifTrue: [each delete]]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>closeAllWindowsBut: (in category 'submenu - windows') -----
- closeAllWindowsBut: window
- (self allOtherWindowsLike: window) do: [:each |
- each model canDiscardEdits ifTrue: [each delete]]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>closeAllWindowsButWorkspaces (in category 'submenu - windows') -----
- closeAllWindowsButWorkspaces
-
- (UserDialogBoxMorph
- confirm: 'There might be unsaved changes.\Do you really want to close all windows\that are no workspaces?' withCRs
- title: 'Only keep workspaces') ifTrue: [
- self allVisibleWindows
- reject: [:each | each model isKindOf: Workspace]
- thenDo: [:each | [each delete] valueSupplyingAnswer: true]].!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>closeAllWindowsLike: (in category 'submenu - windows') -----
- closeAllWindowsLike: window
- self closeAllWindowsBut: window.
- window model canDiscardEdits ifTrue: [window delete]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>closeAllWindowsUnsafe (in category 'submenu - windows') -----
- closeAllWindowsUnsafe
-
- (UserDialogBoxMorph
- confirm: 'There might be unsaved changes.\Do you really want to close all windows?' withCRs
- title: 'Close All Windows') ifTrue: [
- self allVisibleWindows do: [:each | [each delete] valueSupplyingAnswer: true]].!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>closeProject (in category 'submenu - projects') -----
- closeProject
-
- Project current close.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>closeProjectMenuItemOn: (in category 'submenu - projects') -----
- closeProjectMenuItemOn: menu
-
- menu addUpdatingItem: [ :item |
- item
- contents: 'Close This Project' translated;
- help: 'Close this project and return to parent one' translated;
- target: self;
- selector: #closeProject;
- enablementSelector: #canCloseProject ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>colorIcon: (in category 'private') -----
- colorIcon: aColor
-
- "Guess if 'uniform window colors' are used and avoid all icons to be just gray"
- (aColor = (UserInterfaceTheme current get: #uniformWindowColor for: Model) or: [Preferences tinyDisplay]) ifTrue: [ ^nil ].
- ^(aColor iconOrThumbnailOfSize: (14 * RealEstateAgent scaleFactor) truncated)
- borderWidth: 3 color: ((UserInterfaceTheme current get: #color for: #MenuMorph) ifNil: [(Color r: 0.9 g: 0.9 b: 0.9)]) muchDarker;
- borderWidth: 2 color: Color transparent!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>colorToUse (in category 'private') -----
- colorToUse
-
- ^ self userInterfaceTheme textColor ifNil: [Color black]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>commandKeyHelp (in category 'submenu - help') -----
- commandKeyHelp
- "Open a window giving command key help."
-
- self
- openHelp: #SqueakTutorialsCommandKey
- topic: nil!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>createDockingBar (in category 'construction') -----
- createDockingBar
- "Create a docking bar from the receiver's representation"
-
- | dockingBar |
- dockingBar := DockingBarMorph new
- adhereToTop;
- borderWidth: 0.
- self fillDockingBar: dockingBar.
- "self labelIfNeeded: dockingBar."
- ^ dockingBar!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>doMenuOn: (in category 'construction') -----
- doMenuOn: aDockingBar
-
- aDockingBar addItem: [ :item |
- item
- contents: 'Do' translated;
- subMenuUpdater: self
- selector: #listCommonRequestsOn: ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>dualChangeSorterMenuItemOn: (in category 'submenu - tools') -----
- dualChangeSorterMenuItemOn: menu
-
- menu addItem: [ :item |
- item
- contents: 'Dual Change Sorter' translated;
- help: 'Open a Dual Change Sorter' translated;
- icon: (self colorIcon: ChangeSorter basicNew windowColorToUse);
- target: DualChangeSorter;
- selector: #open ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>editCurrentTheme (in category 'submenu - extras') -----
- editCurrentTheme
-
- UserInterfaceTheme current explore.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>enterParentProject (in category 'submenu - projects') -----
- enterParentProject
-
- ^ Project returnToParentProject!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>enterPreviousProject (in category 'submenu - projects') -----
- enterPreviousProject
-
- ^ Project returnToPreviousProject!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>extendingTheSystem (in category 'submenu - help') -----
- extendingTheSystem
-
- self
- openHelp: #SqueakProjectHelp
- topic: #extendingTheSystem!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>extrasMenuOn: (in category 'submenu - extras') -----
- extrasMenuOn: aDockingBar
-
- aDockingBar addItem: [ :it|
- it contents: 'Extras' translated;
- addSubMenu: [:menu|
- menu addItem:[:item|
- item
- contents: 'Recover Changes' translated;
- help: 'Recover changes after a crash' translated;
- icon: MenuIcons smallDocumentClockIcon;
- target: ChangeList;
- selector: #browseRecentLog].
- menu addItem:[:item|
- item
- contents: 'Recover Method Versions' translated;
- help: 'Recover versions of deleted methods' translated;
- target: ChangeList;
- selector: #browseMethodVersions].
- menu addLine.
- menu addItem:[:item|
- item
- contents: 'Themes & Colors' translated;
- subMenuUpdater: self
- selector: #themesAndWindowColorsOn: ].
- menu addItem:[:item|
- item
- contents: 'Scale Factor' translated;
- subMenuUpdater: self
- selector: #scaleFactorsOn:].
- menu addItem:[:item|
- item
- contents: 'Language' translated;
- subMenuUpdater: self
- selector: #languageTranslatorsOn: ].
- menu addItem:[:item|
- item
- contents: 'Set Author Initials' translated;
- help: 'Sets the author initials' translated;
- icon: MenuIcons smallUserQuestionIcon;
- target: Utilities;
- selector: #setAuthorInitials].
- menu addItem:[:item|
- item
- contents: 'Restore Display (r)' translated;
- help: 'Redraws the entire display' translated;
- target: Project current;
- selector: #restoreDisplay].
- menu addItem:[:item|
- item
- contents: 'Rebuild Menus' translated;
- help: 'Rebuilds the menu bar' translated;
- target: TheWorldMainDockingBar;
- selector: #updateInstances].
- menu addLine.
- menu addItem:[:item|
- item
- contents: 'Start Profiler' translated;
- help: 'Starts the profiler' translated;
- icon: MenuIcons smallTimerIcon;
- target: self;
- selector: #startMessageTally].
- menu addItem:[:item|
- item
- contents: 'Collect Garbage' translated;
- help: 'Run the garbage collector and report space usage' translated;
- target: Utilities;
- selector: #garbageCollectAndReport].
- menu addItem:[:item|
- item
- contents: 'Purge Undo Records' translated;
- help: 'Save space by removing all the undo information remembered in all projects' translated;
- target: CommandHistory;
- selector: #resetAllHistory].
- menu addItem:[:item|
- item
- contents: 'VM statistics' translated;
- help: 'Virtual Machine information' translated;
- target: self;
- selector: #vmStatistics].
- menu addLine.
- menu addItem:[:item|
- item
- contents: 'Graphical Imports' translated;
- help: 'View the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList' translated;
- target: (Imports default);
- selector: #viewImages].
- menu addItem:[:item|
- item
- contents: 'Standard Graphics Library' translated;
- help: 'Lets you view and change the system''s standard library of graphics' translated;
- target: ScriptingSystem;
- selector: #inspectFormDictionary].
- menu addItem:[:item|
- item
- contents: 'Annotation Setup' translated;
- help: 'Click here to get a little window that will allow you to specify which types of annotations, in which order, you wish to see in the annotation panes of browsers and other tools' translated;
- target: Preferences;
- selector: #editAnnotations].
- menu addItem:[:item|
- item
- contents: 'Browse My Changes' translated;
- help: 'Browse all of my changes since the last time #condenseSources was run.' translated;
- target: SystemNavigation new;
- selector: #browseMyChanges].
- ] ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>feedbackMenuItemOn: (in category 'submenu - squeak') -----
- feedbackMenuItemOn: menu
-
- menu addItem: [ :item |
- item
- contents: 'Send Feedback...' translated;
- help: 'Report bugs, requests, and other issues' translated;
- target: self;
- selector: #sendFeedback ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>fileListMenuItemOn: (in category 'submenu - tools') -----
- fileListMenuItemOn: menu
-
- menu addItem: [ :item |
- item
- contents: 'File List' translated;
- help: 'Open a file list' translated;
- icon: (self colorIcon: FileList basicNew windowColorToUse);
- target: StandardToolSet;
- selector: #openFileList ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>fillDockingBar: (in category 'construction') -----
- fillDockingBar: aDockingBar
- "Private - fill the given docking bar"
-
- self menusOn: aDockingBar.
- aDockingBar addSpacer.
- self changesMenuOn: aDockingBar.
- aDockingBar addSpacer.
- self rightSideOn: aDockingBar.
- aDockingBar
- setProperty: #mainDockingBarTimeStamp
- toValue: self class timeStamp.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>findWorkspace (in category 'submenu - windows') -----
- findWorkspace
-
- | allWorkspaces labels values |
- allWorkspaces := Set new.
- Project allMorphicProjects do:
- [:project|
- (self allVisibleWindowsIn: project world) do:
- [:window|
- (window model isKindOf: Workspace) ifTrue:
- [allWorkspaces add:
- { window model.
- window.
- project.
- window model contents ifEmpty:
- [(window model dependents detect: [:d| d isTextView] ifNone: nil) textMorph contents] }]]].
- allWorkspaces isEmpty ifTrue:
- [^ self inform: 'No workspaces found.' translated].
- "Sort workspaces with non-empty ones first..."
- labels := OrderedCollection new.
- values := OrderedCollection new.
- (allWorkspaces sorted:
- [:t1 :t2|
- t1 last isEmpty == t2 last isEmpty
- ifTrue: [t1 second label <= t2 second label]
- ifFalse: [t1 last notEmpty]]) do:
- [:tuple|
- labels add: tuple second label, ': ', ((tuple last asString contractTo: 512) ifEmpty: ['(empty)']).
- values add: (MessageSend receiver: self selector: #selectWorkspace:window:inProject:contents: arguments: tuple)].
- (Project uiManager
- chooseFrom: labels
- values: values
- title: 'Find Workspace' translated) value.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>fontSizeSummary (in category 'submenu - help') -----
- fontSizeSummary
-
- self
- openHelp: #SqueakToolsHelp
- topic: #fontSizeSummary!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>fontToUse (in category 'private') -----
- fontToUse
-
- ^ self userInterfaceTheme font ifNil: [TextStyle defaultFont]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>gitInfrastructureMenuItemOn: (in category 'submenu - tools') -----
- gitInfrastructureMenuItemOn: menu
-
- menu addItem: [:item |
- item
- contents: ((Smalltalk hasClassNamed: #SquitBrowser)
- ifTrue: ['Git Browser' translated]
- ifFalse: ['Git Browser (click to install)' translated]);
- help: 'Browse repositories on github.com' translated;
- icon: (self colorIcon: ((Smalltalk classNamed: #SquitBrowser) ifNil: Model)
- basicNew windowColorToUse);
- target: self;
- selector: #installAndOpenGitBrowser]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>helpMenuOn: (in category 'submenu - help') -----
- helpMenuOn: aDockingBar
-
- aDockingBar addItem: [ :it |
- it contents: 'Help' translated;
- addSubMenu: [ :menu |
- menu addItem: [:item |
- item
- contents: 'Squeak Help' translated;
- help: 'Integrated Help System' translated;
- target: self;
- selector: #squeakHelp].
- self feedbackMenuItemOn: menu.
-
- menu addLine.
-
- menu addItem:[:item|
- item
- contents: 'Online Resources' translated;
- help: 'Online resources for Squeak' translated;
- target: self;
- icon: MenuIcons smallHelpIcon;
- selector: #squeakOnlineResources].
- menu addItem:[:item|
- item
- contents: 'Squeak Swiki' translated;
- help: 'A very simple way to access Squeak Swiki resources in the image' translated;
- target: self;
- selector: #swiki].
- menu addItem:[:item|
- item
- contents: 'Keyboard Shortcuts' translated;
- help: 'Keyboard bindings used in Squeak' translated;
- target: self;
- selector: #commandKeyHelp ].
- menu addItem:[:item|
- item
- contents: 'Font Size Summary' translated;
- help: 'Font size summary.' translated;
- target: self;
- selector: #fontSizeSummary ].
- menu addItem:[:item|
- item
- contents: 'Useful Expressions' translated;
- help: 'Useful expressions' translated;
- target: self;
- selector: #usefulExpressions ].
- menu addLine.
- menu addItem:[:item|
- item
- contents: 'Terse Guide to Squeak' translated;
- help: 'Concise information about language and environment' translated;
- target: self;
- selector: #terseGuideToSqueak].
- menu addItem:[:item|
- item
- contents: 'Extending the system' translated;
- help: 'Includes code snippets to evaluate for extending the system' translated;
- target: self;
- icon: MenuIcons smallHelpIcon;
- selector: #extendingTheSystem].
- menu addLine.
-
- menu addItem:[:item|
- item
- contents: 'Release Notes' translated;
- help: 'Changes in this release' translated ;
- target: self;
- selector: #releaseNotes].
- menu addItem:[:item|
- item
- contents: 'Working With Squeak' translated;
- help: 'Information for new users' ;
- target: self;
- selector: #workingWithSqueak].
- menu addItem:[:item|
- item
- contents: 'The Squeak User Interface' translated;
- help: 'Descriptions of some of the more-unusual UI elements in Squeak' ;
- target: self;
- selector: #squeakUserInterface].
- menu addItem:[:item|
- item
- contents: 'License Information' translated;
- help: String empty ;
- target: self;
- selector: #licenseInformation].
-
-
- menu addLine.
- self aboutMenuItemOn: menu.
- ]]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>installAndOpenGitBrowser (in category 'menu actions') -----
- installAndOpenGitBrowser
-
- (Smalltalk hasClassNamed: #SquitBrowser)
- ifFalse: [ (UIManager default
- confirm: 'The Git infrastructure and browser is not yet installed.\\Do you want to install the Git Browser?\\(Note that this step requires an internet connection and may take several minutes.)' translated withCRs
- title: 'Confirm Installation Request' )
- ifTrue: [ Installer
- ensureRecentMetacello;
- installGitInfrastructure.
- TheWorldMainDockingBar updateInstances ]
- ifFalse: [ ^self ] ].
- (Smalltalk classNamed: #SquitBrowser) open.
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar>>installAndOpenSqueakInboxTalk (in category 'menu actions') -----
- installAndOpenSqueakInboxTalk
-
- (Smalltalk hasClassNamed: #TalkInboxBrowser)
- ifFalse: [ (Project uiManager
- confirm: 'Squeak Inbox Talk is not yet installed.\\Do you want to install it?\\(Note that this step requires an internet connection and may take several minutes.)' withCRs translated
- title: 'Confirm Installation Request' )
- ifTrue: [ Installer
- ensureRecentMetacello;
- installSqueakInboxTalk.
- TheWorldMainDockingBar updateInstances ]
- ifFalse: [ ^self ] ].
- (Smalltalk classNamed: #TalkInboxBrowser) open.
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar>>jumpToProjectMenuItemOn: (in category 'submenu - projects') -----
- jumpToProjectMenuItemOn: menu
-
- menu addItem: [ :item |
- item
- contents: 'Enter Project' translated;
- icon: MenuIcons smallProjectJumpIcon;
- subMenuUpdater: self
- selector: #updateJumpToProjectSubMenu: ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>languageTranslatorsOn: (in category 'submenu - extras') -----
- languageTranslatorsOn: menu
-
- | availableLanguages |
- availableLanguages := NaturalLanguageTranslator availableLanguageLocaleIDs
- sorted:[:x :y | x displayName < y displayName].
-
- availableLanguages do: [:localeID |
- menu addUpdating: #stringForLanguageNameIs: target: Locale selector: #switchToID: argumentList: {localeID}].
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar>>licenseInformation (in category 'submenu - help') -----
- licenseInformation
-
- self
- openHelp: #SqueakLicenseHelp
- topic: #officialLicense!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>listAppsOn: (in category 'submenu - apps') -----
- listAppsOn: menu
- "Update the apps list in the menu"
-
- | args |
- TheWorldMenu registeredOpenCommands do:[:spec|
- args := spec second.
- menu addItem: [ :item |
- item
- contents: spec first translated;
- target: args first;
- selector: args second].
- ].
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar>>listChangesOn: (in category 'submenu - changes') -----
- listChangesOn: menu
-
- | fetchChangesBlock |
- {
- 'Browse current change set' translated. #browseChangeSet. nil.
- 'Browse changed methods' translated. #browseChangedMethods. nil.
- nil. nil. nil.
- 'Simple Change Sorter' translated. #browseChanges. ChangeSorter.
- 'Dual Change Sorter' translated. #browseChangesDual. DualChangeSorter.
- nil. nil. nil.
- } groupsDo: [:label :selector :modelClass |
- label ifNil: [menu addLine] ifNotNil: [
- menu addItem: [:item |
- item
- contents: label;
- icon: ((modelClass ifNotNil: [self colorIcon: modelClass basicNew windowColorToUse])
- ifNil: [MenuIcons blankIcon]);
- target: self;
- selector: selector]] ].
-
- fetchChangesBlock := [ | latestMethodChanges latestClassChanges updateBlock |
- self flag: #concurrency. "mt: Is this safe enough given the current update frequency of change sets and when this code is executed?"
- latestMethodChanges := (Array streamContents: [:s |
- ChangeSet current changedMethodsDo: [:method :changeType :dateAndTime :category |
- s nextPut: { dateAndTime. method. changeType. category }]])
- sorted: [:a :b | a first >= b first].
- latestClassChanges := (Array streamContents: [:s |
- ChangeSet current changedClassesDo: [:class :changeTypes :dateAndTime :category |
- "We are not interested in classes whose method's did only change."
- changeTypes ifNotEmpty: [s nextPut: { dateAndTime. class. changeTypes. category }]]])
- sorted: [:a :b | a first >= b first].
- updateBlock := [self listMethodChanges: latestMethodChanges andClassChanges: latestClassChanges on: menu].
- Project current uiProcess == Processor activeProcess
- ifTrue: updateBlock
- ifFalse: [Project current addDeferredUIMessage: [
- menu isInWorld ifTrue: [menu lastItem delete. updateBlock value]] ]].
-
- ChangeSet current numberOfChanges <= 30
- ifTrue: fetchChangesBlock ifFalse: [
- "We have too much data to process. Do it in the background to keep the UI responsive."
- menu add: '... fetching changes ...' translated action: nil.
- menu lastItem isEnabled: false.
- fetchChangesBlock forkAt: Processor userBackgroundPriority].!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>listCommonRequestsOn: (in category 'submenu - do') -----
- listCommonRequestsOn: aMenu
-
- | strings |
- aMenu add: 'edit this list' translated target: Utilities action: #editCommonRequestStrings.
- aMenu addLine.
-
- strings := Utilities commonRequestStrings contents.
- strings asString linesDo: [:aString |
- aString = '-'
- ifTrue: [aMenu addLine]
- ifFalse: [aMenu add: (aString ifEmpty: [' ']) target: Utilities selector: #eval: argument: aString]].!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>listMethodChanges:andClassChanges:on: (in category 'submenu - changes') -----
- listMethodChanges: methodChanges andClassChanges: classChanges on: menu
-
- | latestMethodChanges latestClassChanges |
- latestMethodChanges := methodChanges.
-
- 1 to: (10 min: latestMethodChanges size) do: [:index | | spec method |
- spec := latestMethodChanges at: index.
- method := spec second.
- menu addItem: [:item |
- item
- contents: ('{1} {2} \{{3}\} \{{4}\}' format: {method methodClass. method selector. spec fourth. method methodClass category}) ;
- target: ToolSet;
- balloonText: spec third asString;
- icon: ((#(remove addedThenRemoved) includes: spec third) ifTrue: [MenuIcons smallDeleteIcon] ifFalse: [
- spec third = #add ifTrue: [MenuIcons smallNewIcon] ifFalse: [MenuIcons blankIcon]]);
- selector: (method isInstalled ifTrue: [#browseMethod:] ifFalse: [#browseMethodVersion:]);
- arguments: {method}]].
-
- latestClassChanges := classChanges.
-
- latestClassChanges ifNotEmpty: [menu addLine].
- 1 to: (10 min: latestClassChanges size) do: [:index | | spec class |
- spec := latestClassChanges at: index.
- class := spec second.
- menu addItem: [:item |
- item
- contents: ('{1} \{{2}\}' format: {class name. spec fourth }) ;
- target: ToolSet;
- balloonText: (spec third sorted joinSeparatedBy: Character space);
- icon: ((spec third includesAnyOf: #(remove addedThenRemoved))
- ifTrue: [MenuIcons smallDeleteIcon]
- ifFalse: [
- (spec third includes: #add)
- ifTrue: [MenuIcons smallNewIcon]
- ifFalse: [MenuIcons blankIcon]]);
- selector: ((spec third includes: #remove) ifTrue: [#inspect:] ifFalse: [#browseClass:]);
- arguments: {class}]]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>listWindowsOn: (in category 'submenu - windows') -----
- listWindowsOn: menu
-
- | windows |
- menu
- addLine;
- add: 'Collapse all windows' target: (Project current world) selector: #collapseAllWindows;
- addItem: [:item | item
- contents: 'Find Workspace...';
- target: self;
- selector: #findWorkspace];
- addLine;
- add: 'Close all windows' target: self selector: #closeAllWindowsUnsafe;
- addItem: [:item | item
- contents: 'Close all windows without changes';
- target: self;
- icon: MenuIcons smallBroomIcon;
- selector: #closeAllWindows];
- add: 'Close all windows but workspaces' target: self selector: #closeAllWindowsButWorkspaces;
- addLine.
-
- windows := self allVisibleWindows sorted: [:winA :winB |
- ((winA model isNil or: [winB model isNil]) or: [winA model name = winB model name])
- ifTrue: [winA label < winB label]
- ifFalse: [winA model name < winB model name]].
- windows ifEmpty: [
- menu addItem: [ :item |
- item
- contents: 'No Windows' translated;
- isEnabled: false ] ].
- windows do: [ :each |
- | windowColor |
- windowColor := (each model respondsTo: #windowColorToUse)
- ifTrue: [each model windowColorToUse]
- ifFalse: [UserInterfaceTheme current get: #uniformWindowColor for: Model].
- menu addItem: [ :item |
- item
- contents: (self windowMenuItemLabelFor: each);
- icon: (self colorIcon: windowColor);
- target: each;
- selector: #comeToFront;
- subMenuUpdater: self
- selector: #windowMenuFor:on:
- arguments: { each };
- action: [ each beKeyWindow; expand ] ] ].!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>loadProject (in category 'menu actions') -----
- loadProject
-
- Project current world worldMenu loadProject!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>loadProjectMenuItemOn: (in category 'submenu - projects') -----
- loadProjectMenuItemOn: menu
-
- menu addItem: [ :item |
- item
- contents: 'Load Project' translated;
- help: 'Load a project from a file and enter it on success' translated;
- target: self;
- selector: #loadProject ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>menusOn: (in category 'construction') -----
- menusOn: aDockingBar
-
- self class showMainMenuInWorldMainDockingBar ifTrue: [
- self squeakMenuOn: aDockingBar].
-
- self class showProjectsMenuInWorldMainDockingBar ifTrue: [
- self projectsMenuOn: aDockingBar].
-
- self class showToolsMenuInWorldMainDockingBar ifTrue: [
- self toolsMenuOn: aDockingBar].
-
- self class showAppsMenuInWorldMainDockingBar ifTrue: [
- self appsMenuOn: aDockingBar].
-
- self class showDoMenuInWorldMainDockingBar ifTrue: [
- self doMenuOn: aDockingBar].
-
- self class showExtrasMenuInWorldMainDockingBar ifTrue: [
- self extrasMenuOn: aDockingBar].
-
- self class showWindowsMenuInWorldMainDockingBar ifTrue: [
- self windowsMenuOn: aDockingBar].
-
- self class showHelpMenuInWorldMainDockingBar ifTrue: [
- self helpMenuOn: aDockingBar].!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>messageNamesMenuItemOn: (in category 'submenu - tools') -----
- messageNamesMenuItemOn: menu
-
- menu addItem: [:item |
- item
- contents: 'Message Names' translated;
- help: 'Open the Message Names tool' translated;
- icon: (self colorIcon: MessageNames basicNew windowColorToUse);
- target: StandardToolSet;
- selector: #openMessageNames]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>methodFinderMenuItemOn: (in category 'submenu - tools') -----
- methodFinderMenuItemOn: menu
-
- menu addItem: [:item |
- item
- contents: 'Method Finder' translated;
- help: 'Open the Method Finder' translated;
- icon: (self colorIcon: SelectorBrowser basicNew windowColorToUse);
- target: StandardToolSet;
- selector: #openSelectorBrowser]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>monticelloBrowserMenuItemOn: (in category 'submenu - tools') -----
- monticelloBrowserMenuItemOn: menu
-
- menu addItem: [ :item |
- item
- contents: 'Monticello Browser' translated;
- help: 'Open a Monticello Browser' translated;
- icon: (self colorIcon: MCTool basicNew windowColorToUse);
- target: MCWorkingCopyBrowser;
- selector: #open ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>monticelloConfigurationsMenuItemOn: (in category 'submenu - tools') -----
- monticelloConfigurationsMenuItemOn: menu
-
- menu addItem: [ :item |
- item
- contents: 'Monticello Configurations' translated;
- help: 'Open a Monticello Configurations Editor' translated;
- icon: (self colorIcon: MCConfigurationBrowser basicNew windowColorToUse);
- target: MCConfigurationBrowser;
- selector: #open ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>newProject: (in category 'menu actions') -----
- newProject: projectClass
- "Create a new project of the given type"
- | newProject |
- "Allow the project to return nil from #new to indicate that it was canceled."
- newProject := projectClass new ifNil:[^self].
- ProjectViewMorph openOn: newProject.
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar>>newProjectMenuItemOn: (in category 'submenu - projects') -----
- newProjectMenuItemOn: menu
-
- Project allSubclasses do: [ :each |
- menu addItem: [ :item |
- item
- contents: ('Create ', each name) translated;
- help: ('Create a new ', each name, ' and open a viewer for it.') translated;
- target: self;
- selector: #newProject:;
- arguments: { each } ] ] !
Item was removed:
- ----- Method: TheWorldMainDockingBar>>openHelp:topic: (in category 'submenu - help') -----
- openHelp: bookSymbol topic: topicSymbol
- "If a suitable seeming class named bookSymbol exists in the image we open it on the given topic, or on the first page should topic be nil"
- (Smalltalk classNamed: 'HelpBrowser')
- ifNil: [self inform: 'Sorry, there is no help system installed.' translated]
- ifNotNil: [:helpClass |
- (Smalltalk classNamed: bookSymbol)
- ifNil: [self inform: 'Sorry, the help book you requested does not exist.']
- ifNotNil: [:book |
- topicSymbol
- ifNil: [(helpClass openOn: book) model showFirstTopic]
- ifNotNil: [(helpClass openOn: book) model showTopicNamed: topicSymbol]]]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>parentProjectMenuItemOn: (in category 'submenu - projects') -----
- parentProjectMenuItemOn: menu
-
- menu addUpdatingItem: [ :item |
- item
- contents: 'Enter Parent Project' translated;
- help: 'Return to the parent project' translated;
- target: self;
- selector: #enterParentProject;
- enablementSelector: #canEnterParentProject ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>preferenceBrowserMenuItemOn: (in category 'submenu - tools') -----
- preferenceBrowserMenuItemOn: menu
- Smalltalk at: #PreferenceBrowser ifPresent:[:pb|
- menu addItem: [ :item |
- item
- contents: 'Preferences' translated;
- help: 'Open a Preferences Browser' translated;
- icon: (self colorIcon: pb basicNew windowColorToUse);
- target: pb;
- selector: #open ]
- ].!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>previousProjectMenuItemOn: (in category 'submenu - projects') -----
- previousProjectMenuItemOn: menu
-
- menu addUpdatingItem: [ :item |
- item
- contents: 'Enter Previous Project' translated;
- help: 'Return to the most-recently-visited project' translated;
- target: self;
- selector: #enterPreviousProject;
- enablementSelector: #canEnterPreviousProject ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>processBrowserMenuItemOn: (in category 'submenu - tools') -----
- processBrowserMenuItemOn: menu
-
- menu addItem: [ :item |
- item
- contents: 'Process Browser' translated;
- help: 'Open a Process Browser' translated;
- icon: (self colorIcon: ProcessBrowser basicNew windowColorToUse);
- target: ProcessBrowser;
- selector: #open ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>projectsMenuOn: (in category 'construction') -----
- projectsMenuOn: aDockingBar
-
- aDockingBar addItem: [ :item |
- item
- contents: 'Projects' translated;
- addSubMenu: [ :menu |
- self newProjectMenuItemOn: menu.
- menu addLine.
- self
- saveProjectMenuItemOn: menu;
- loadProjectMenuItemOn: menu.
- menu addLine.
- self
- parentProjectMenuItemOn: menu;
- previousProjectMenuItemOn: menu;
- jumpToProjectMenuItemOn: menu.
- menu addLine.
- self closeProjectMenuItemOn: menu ] ]
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar>>quitMenuItemOn: (in category 'submenu - squeak') -----
- quitMenuItemOn: menu
-
- menu addItem: [ :item |
- item
- contents: 'Quit' translated;
- help: 'Quit out of Squeak' translated;
- icon: MenuIcons smallQuitNoSaveIcon;
- target: self;
- selector: #quitSqueak ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>quitSqueak (in category 'menu actions') -----
- quitSqueak
-
- ^Smalltalk
- snapshot: (
- UserDialogBoxMorph
- confirm: 'Save changes before quitting?' translated
- orCancel: [ ^self ]
- at: Project current world center)
- andQuit: true
-
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar>>releaseNotes (in category 'submenu - help') -----
- releaseNotes
-
- self
- openHelp: #SqueakReleaseNotes
- topic: nil!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>resetAllThemes (in category 'submenu - extras') -----
- resetAllThemes
-
- (Project uiManager confirm: 'Do you want to reset all UI themes to their original state?\\(The current theme and scale factor will be restored if possible.)' translated withCRs title: 'Reset All Themes')
- ifTrue: [UserInterfaceTheme cleanUpAndReset].!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>restoreThemeBackground (in category 'submenu - extras') -----
- restoreThemeBackground
-
- Project current world removeProperty: #hasCustomBackground.
- UserInterfaceTheme current applyTo: {Project current}.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>rightSideOn: (in category 'construction') -----
- rightSideOn: aDockingBar
-
- self
- searchBarOn: aDockingBar;
- clockOn: aDockingBar;
- toggleFullScreenOn: aDockingBar.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>save (in category 'menu actions') -----
- save
-
- Smalltalk snapshot: true andQuit: false!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>saveAndQuitMenuItemOn: (in category 'submenu - squeak') -----
- saveAndQuitMenuItemOn: menu
-
- menu addItem: [ :item |
- item
- contents: 'Save And Quit' translated;
- help: 'Save the current state of Squeak on disk, and quit out of Squeak' translated;
- target: self;
- selector: #saveAndQuitSqueak ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>saveAndQuitSqueak (in category 'menu actions') -----
- saveAndQuitSqueak
-
- Smalltalk snapshot: true andQuit: true!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>saveAsMenuItemOn: (in category 'submenu - squeak') -----
- saveAsMenuItemOn: menu
-
- menu addItem: [ :item |
- item
- contents: 'Save As...' translated;
- help: 'Save the current state of Squeak on disk under a new name' translated;
- target: self;
- selector: #saveImageAs ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>saveAsNewVersion (in category 'menu actions') -----
- saveAsNewVersion
-
- Smalltalk saveAsNewVersion!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>saveAsNewVersionMenuItemOn: (in category 'submenu - squeak') -----
- saveAsNewVersionMenuItemOn: menu
-
- menu addItem: [ :item |
- item
- contents: 'Save As New Version' translated;
- help: 'Save the current state of Squeak on disk under a version-stamped name' translated;
- target: self;
- selector: #saveAsNewVersion ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>saveImage (in category 'menu actions') -----
- saveImage
-
- Smalltalk saveSession!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>saveImageAs (in category 'menu actions') -----
- saveImageAs
-
- Smalltalk saveAs!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>saveMenuItemOn: (in category 'submenu - squeak') -----
- saveMenuItemOn: menu
-
- menu addItem: [ :item |
- item
- contents: 'Save' translated;
- help: 'Save the current state of Squeak on disk' translated;
- icon: MenuIcons smallSaveIcon;
- target: self;
- selector: #saveImage ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>saveProjectMenuItemOn: (in category 'submenu - projects') -----
- saveProjectMenuItemOn: menu
-
- menu addItem: [ :item |
- item
- contents: 'Save Project' translated;
- help: 'Save this project on a file' translated;
- target: Project current world;
- selector: #saveOnFile ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>scaleFactorsOn: (in category 'submenu - extras') -----
- scaleFactorsOn: menu
-
- | showsRelative presets currentScaleFactor currentPlatformScaleFactor |
- showsRelative := DisplayScreen relativeScaleFactorEnabled.
- currentScaleFactor := (Display relativeUiScaleFactor * 100) rounded.
- currentPlatformScaleFactor := Display platformScaleFactorKnown
- ifTrue: [(Display platformScaleFactor * 100) rounded].
- showsRelative
- ifFalse: [presets := 75 to: 300 by: 25]
- ifTrue: [presets := 100 to: 200 by: 25].
-
- presets do: [:scale |
- showsRelative ifFalse: [
- scale = 100 ifTrue: [menu addLine]. "Normal scales."
- scale = 175 ifTrue: [menu addLine]. "TTCFont used after this line..."].
- menu addItem: [:item|
- item
- contents: ('{1}{2}%{3}' format: {
- currentScaleFactor = scale ifTrue: ['<yes>'] ifFalse: ['<no>'].
- scale.
- showsRelative ifTrue: [''] ifFalse: [
- scale = currentPlatformScaleFactor
- ifTrue: [' (recommended)' translated] ifFalse: ['']] });
- target: Display;
- selector: #relativeUiScaleFactor:;
- arguments: {scale / 100}]].
-
- menu addLine.
- menu addItem: [:item |
- item
- contents: ((presets includes: currentScaleFactor) not ifTrue: ['<yes>' , 'Custom: ' translated, currentScaleFactor, '% ...'] ifFalse: ['<no>' , 'Other scale factor...' translated]);
- target: self;
- selector: #chooseCustomScaleFactor].!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>searchBarOn: (in category 'right side') -----
- searchBarOn: aDockingBar
-
- aDockingBar
- addMorphBack: (SearchBar build
- hResizing: #rigid; vResizing: #rigid;
- width: (TextStyle defaultFont widthOf: $x) * 30; "Optimized for #scaleFactor * (1024 at 764) -- thus not full-screen mode..."
- height: ToolBuilder default inputFieldHeight;
- yourself);
- addDefaultSpace!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>selectWorkspace:window:inProject:contents: (in category 'submenu - windows') -----
- selectWorkspace: aWorkspace window: aSystemWindow inProject: aMorphicProject contents: contents
- aMorphicProject
- addDeferredUIMessage: [aSystemWindow comeToFront];
- enter "Does nothing if already the current project..."
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar>>sendFeedback (in category 'menu actions') -----
- sendFeedback
-
- | url os vm hash image |
- url := 'https://github.com/squeak-smalltalk/squeak-object-memory/issues'.
- ([Smalltalk vm platformSourceVersion] on: Warning do: ["Ignore"])
- ifNotNil: [:info | | tokens |
- tokens := info findTokens.
- vm := tokens at: 2.
- hash := tokens atLast: 4].
- os := Smalltalk os platformName, ' ', Smalltalk os osVersion, ' ', Smalltalk os platformSubtype.
- image := SystemVersion current version, ' #', SystemVersion current highestUpdate.
-
- self inform: ('Please visit the following website to report on bugs, requests, and other issues:<br><br> <a href="{1}">{1}</a><br><br>Make sure that you always include information about your current environment such as:<br><br> OS: {2}<br> VM: {3} ({4})<br> SQ: {5} ({6} bit)<br><br>You can find more in the <a href="code://SystemReporter open">System Reporter</a>.' translated format: {url. os. vm. hash. image. Smalltalk image wordSize * 8}) asTextFromHtml!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>simpleChangeSorterMenuItemOn: (in category 'submenu - tools') -----
- simpleChangeSorterMenuItemOn: menu
-
- menu addItem: [ :item |
- item
- contents: 'Simple Change Sorter' translated;
- help: 'Open a Change Sorter' translated;
- icon: (self colorIcon: ChangeSorter basicNew windowColorToUse);
- target: ChangeSorter;
- selector: #open ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>squeakHelp (in category 'submenu - help') -----
- squeakHelp
-
- (Smalltalk classNamed: 'HelpBrowser')
- ifNil: [self inform: 'Sorry, there is no help system installed.' translated]
- ifNotNil: [:helpClass | helpClass open].!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>squeakInboxTalkMenuItemOn: (in category 'submenu - tools') -----
- squeakInboxTalkMenuItemOn: menu
-
- menu addItem: [:item |
- item
- contents: ((Smalltalk hasClassNamed: #TalkInboxBrowser)
- ifTrue: ['Squeak Inbox Talk' translated]
- ifFalse: ['Squeak Inbox Talk (click to install)' translated]);
- help: 'Engage with our community from within Squeak using tools that integrate our mailing lists such as squeak-dev and vm-dev' translated;
- icon: (self colorIcon: ((Smalltalk classNamed: #TalkInboxBrowser) ifNil: Model)
- basicNew windowColorToUse);
- target: self;
- selector: #installAndOpenSqueakInboxTalk]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>squeakMenuOn: (in category 'construction') -----
- squeakMenuOn: aDockingBar
- "Private - fill the given docking bar"
-
- aDockingBar addItem: [ :item |
- item
- contents: '';
- icon: (MenuIcons squeakLogoIcon dyed:
- (self userInterfaceTheme logoColor ifNil: [Color black]));
- selectedIcon: (MenuIcons squeakLogoIcon dyed:
- (self userInterfaceTheme selectionLogoColor ifNil: [Color white]));
- addSubMenu: [ :menu |
- self
- aboutMenuItemOn: menu;
- updateMenuItemOn: menu.
- menu addLine.
- self feedbackMenuItemOn: menu.
- menu addLine.
- self
- saveMenuItemOn: menu;
- saveAsMenuItemOn: menu;
- saveAsNewVersionMenuItemOn: menu.
- menu addLine.
- self
- saveAndQuitMenuItemOn: menu;
- quitMenuItemOn: menu ] ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>squeakOnlineResources (in category 'submenu - help') -----
- squeakOnlineResources
-
- self
- openHelp: #SqueakProjectHelp
- topic: #squeakResourcesOnline!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>squeakUserInterface (in category 'submenu - help') -----
- squeakUserInterface
-
- self
- openHelp: #SqueakProjectHelp
- topic: #squeakUserInterface!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>startMessageTally (in category 'menu actions') -----
- startMessageTally
- | world |
- world := Project current world.
- (self confirm: 'MessageTally will start now,
- and stop when the cursor goes
- to the top of the screen') ifTrue:
- [MessageTally spyOn:
- [[Sensor peekPosition y > 0] whileTrue: [world doOneCycle]]]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>swiki (in category 'submenu - help') -----
- swiki
-
- self
- openHelp: #SWikiHelp
- topic: nil!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>terseGuideToSqueak (in category 'submenu - help') -----
- terseGuideToSqueak
-
- self
- openHelp: #TerseGuideHelp
- topic: nil!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>testRunnerMenuItemOn: (in category 'submenu - tools') -----
- testRunnerMenuItemOn: menu
- Smalltalk at: #TestRunner ifPresent:[:aClass|
- menu addItem: [ :item |
- item
- contents: 'Test Runner' translated;
- help: 'Open the Test Runner' translated;
- icon: (self colorIcon: aClass basicNew windowColorToUse);
- target: aClass;
- selector: #open ]
- ].!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>themesAndWindowColorsOn: (in category 'submenu - extras') -----
- themesAndWindowColorsOn: menu
- | themes |
- menu addItem:[:item|
- item
- contents: 'Fonts' translated;
- subMenuUpdater: Preferences
- selector: #fontConfigurationMenu:;
- icon: MenuIcons smallFontsIcon].
- menu addLine.
- menu addItem:[:item|
- item
- contents: (Model useColorfulWindows ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Colorful Windows' translated;
- target: self;
- selector: #toggleColorfulWindows].
- menu addItem:[:item|
- item
- contents: (SystemWindow gradientWindow not ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Flat Widget Look' translated;
- target: self;
- selector: #toggleGradients].
- menu addLine.
- menu addItem:[:item |
- item
- contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow]) ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Soft Shadows' translated;
- target: self;
- selector: #toggleSoftShadows].
- menu addItem:[:item |
- item
- contents: (((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow not]) ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Hard Shadows' translated;
- target: self;
- selector: #toggleHardShadows].
- menu addLine.
- menu addItem:[:item |
- item
- contents: (SystemWindow roundedWindowCorners ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Rounded Window/Dialog Look' translated;
- target: self;
- selector: #toggleRoundedWindowLook].
- menu addItem:[:item |
- item
- contents: (PluggableButtonMorph roundedButtonCorners ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Rounded Button/Scrollbar/Menu Look' translated;
- target: self;
- selector: #toggleRoundedButtonLook].
- menu addLine.
- themes := UserInterfaceTheme allThemes asArray sort: #name ascending.
- themes := themes select: [ :each | each isGenuine].
- themes ifEmpty: [
- menu addItem: [ :item |
- item
- contents: '(No UI themes found.)' translated;
- isEnabled: false ] ].
- themes do: [ :each |
- menu addItem: [ :item |
- item
- contents: (UserInterfaceTheme current name = each name ifTrue: ['<yes>'] ifFalse: ['<no>']), each name;
- target: each;
- selector: #applyScaled ] ].
- menu
- addLine;
- add: 'Set Etoys Mode' translated target: ReleaseBuilderSqueakland selector: #setEtoysMode.
- menu
- addLine;
- add: 'Restore UI theme background' translated target: self selector: #restoreThemeBackground;
- add: 'Reset all UI themes' translated target: self selector: #resetAllThemes;
- add: 'Edit current UI theme...' translated target: self selector: #editCurrentTheme.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>toggleColorfulWindows (in category 'submenu - extras') -----
- toggleColorfulWindows
-
- Model useColorfulWindows: Model useColorfulWindows not.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>toggleFullScreenOn: (in category 'right side') -----
- toggleFullScreenOn: aDockingBar
-
- | toggleMorph onIcon offIcon box bgColor |
- offIcon := (MenuIcons fullscreenWireframeIcon dyed:
- (self userInterfaceTheme logoColor ifNil: [Color black])) scaleIconToDisplay.
- onIcon := (MenuIcons fullscreenWireframeIcon dyed:
- (self userInterfaceTheme selectionLogoColor ifNil: [Color white])) scaleIconToDisplay.
- bgColor := (UserInterfaceTheme current get: #selectionColor for: #DockingBarItemMorph) ifNil: [Color blue].
-
- toggleMorph := offIcon asMorph.
-
- box := Morph new
- color: Color transparent;
- hResizing: #shrinkWrap;
- vResizing: #spaceFill;
- balloonText: 'toggle full screen mode' translated;
- changeTableLayout;
- listCentering: #center;
- layoutInset: (ToolBuilder default inputFieldHeight "searchBar" - toggleMorph width // 2);
-
- addMorph: toggleMorph.
-
- toggleMorph setToAdhereToEdge: #rightCenter.
-
- box
- on: #mouseUp
- send: #value
- to:
- [ DisplayScreen toggleFullScreen.
- "toggleMorph image: MenuIcons smallFullscreenOffIcon" ] ;
-
- on: #mouseEnter
- send: #value
- to: [
- toggleMorph image: onIcon.
- box color: bgColor; borderColor: bgColor];
-
- on: #mouseLeave
- send: #value
- to: [
- toggleMorph image: offIcon.
- box color: Color transparent; borderColor: Color transparent].
-
- aDockingBar addMorphBack: box!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>toggleGradients (in category 'submenu - extras') -----
- toggleGradients
-
- | switch |
- switch := SystemWindow gradientWindow not.
-
- SystemWindow gradientWindow: switch.
- DialogWindow gradientDialog: switch.
- MenuMorph gradientMenu: switch.
- ScrollBar gradientScrollBar: switch.
- PluggableButtonMorph gradientButton: switch.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>toggleHardShadows (in category 'submenu - extras') -----
- toggleHardShadows
-
- ((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow])
- ifFalse: [Preferences toggle: #menuAppearance3d].
- Morph useSoftDropShadow: false.
-
- SystemWindow refreshAllWindows; reconfigureWindowsForFocus.
- self class updateInstances.
- SystemProgressMorph reset.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>toggleRoundedButtonLook (in category 'submenu - extras') -----
- toggleRoundedButtonLook
-
- | switch |
- switch := PluggableButtonMorph roundedButtonCorners not.
-
- PluggableButtonMorph roundedButtonCorners: switch.
- ScrollBar roundedScrollBarLook: switch.
- MenuMorph roundedMenuCorners: switch.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>toggleRoundedWindowLook (in category 'submenu - extras') -----
- toggleRoundedWindowLook
-
- | switch |
- switch := SystemWindow roundedWindowCorners not.
-
- SystemWindow roundedWindowCorners: switch.
- DialogWindow roundedDialogCorners: switch.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>toggleSoftShadows (in category 'submenu - extras') -----
- toggleSoftShadows
-
- ((Preferences valueOfFlag: #menuAppearance3d ifAbsent: [false]) and: [Morph useSoftDropShadow not])
- ifFalse: [Preferences toggle: #menuAppearance3d].
- Morph useSoftDropShadow: true.
-
- SystemWindow refreshAllWindows; reconfigureWindowsForFocus.
- self class updateInstances.
- SystemProgressMorph reset.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>toolsMenuOn: (in category 'construction') -----
- toolsMenuOn: aDockingBar
-
- aDockingBar addItem: [ :item |
- item
- contents: 'Tools' translated;
- addSubMenu: [ :menu |
- self
- browserMenuItemOn: menu;
- workspaceMenuItemOn: menu;
- transcriptMenuItemOn: menu;
- testRunnerMenuItemOn: menu;
- methodFinderMenuItemOn: menu;
- messageNamesMenuItemOn: menu.
- menu addLine.
- self
- simpleChangeSorterMenuItemOn: menu;
- dualChangeSorterMenuItemOn: menu;
- monticelloBrowserMenuItemOn: menu;
- monticelloConfigurationsMenuItemOn: menu.
- menu addLine.
- self
- gitInfrastructureMenuItemOn: menu;
- squeakInboxTalkMenuItemOn: menu.
- menu addLine.
- self
- processBrowserMenuItemOn: menu;
- preferenceBrowserMenuItemOn: menu;
- fileListMenuItemOn: menu.
- ] ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>transcriptMenuItemOn: (in category 'submenu - tools') -----
- transcriptMenuItemOn: menu
-
- menu addItem: [ :item |
- item
- contents: 'Transcript' translated;
- help: 'Open the Transcript' translated;
- icon: (self colorIcon: Transcript windowColorToUse);
- target: Transcript;
- selector: #open ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>updateIfNeeded: (in category 'private') -----
- updateIfNeeded: aDockingBar
- "Update the given docking bar if needed"
- | timeStamp |
- timeStamp := aDockingBar
- valueOfProperty: #mainDockingBarTimeStamp
- ifAbsent: [].
- timeStamp ~= self class timeStamp
- ifTrue:
- [aDockingBar
- release;
- removeAllMorphs.
- self fillDockingBar: aDockingBar]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>updateJumpToProjectSubMenu: (in category 'submenu - projects') -----
- updateJumpToProjectSubMenu: subMenu
-
- subMenu defaultTarget: Project.
- Project current buildJumpToMenu: subMenu!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>updateMenuItemOn: (in category 'submenu - squeak') -----
- updateMenuItemOn: menu
-
- | firstCustomUpdater |
- menu addItem: [ :item |
- item
- contents: 'Update Squeak' translated;
- help: 'Load latest code updates via the internet' translated;
- icon: MenuIcons smallChangesIcon;
- target: self;
- selector: #updateSqueak ].
-
- firstCustomUpdater := true.
- TheWorldMainDockingBar methodsDo: [:method |
- (method pragmaAt: #updater:) ifNotNil: [:pragma |
- firstCustomUpdater ifTrue: [
- menu addLine.
- firstCustomUpdater := false].
- menu addItem: [ :item |
- item
- contents: (pragma argumentAt: 1) translated;
- target: self;
- selector: method selector]]].!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>updateSqueak (in category 'menu actions') -----
- updateSqueak
- MCMcmUpdater updateFromServer.!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>usefulExpressions (in category 'submenu - help') -----
- usefulExpressions
-
- self
- openHelp: #SqueakTutorials
- topic: #usefulExpressions!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>vmStatistics (in category 'menu actions') -----
- vmStatistics
- "Open a string view on a report of vm statistics"
-
- (StringHolder new contents: Smalltalk vmStatisticsReportString)
- openLabel: 'VM Statistics'!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>windowMenuFor:on: (in category 'submenu - windows') -----
- windowMenuFor: window on: menu
- menu
- addItem: [ :item |
- item
- contents: 'Close' translated ;
- target: window;
- selector: #delete ];
- addItem: [ :item |
- item
- contents: 'Close all like this' translated ;
- target: self;
- selector: #closeAllWindowsLike:;
- arguments: { window } ];
- addItem: [ :item |
- item
- contents: 'Close all but this' translated ;
- target: self;
- selector: #closeAllWindowsBut:;
- arguments: { window } ];
- addItem: [ :item |
- item
- contents: 'Expand or Contract' translated ;
- target: window;
- selector: #expandBoxHit ]!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>windowMenuItemLabelFor: (in category 'submenu - windows') -----
- windowMenuItemLabelFor: window
- | s |
- s := WriteStream on: String new.
- window model canDiscardEdits ifFalse: [ s nextPut: $* ].
- window isCollapsed ifTrue: [ s nextPut: $( ].
- s nextPutAll: window label.
- window isCollapsed ifTrue: [ s nextPut: $) ].
- ^s contents contractTo: 50!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>windowsMenuOn: (in category 'construction') -----
- windowsMenuOn: aDockingBar
-
- aDockingBar addItem: [ :item |
- item
- contents: 'Windows' translated;
- subMenuUpdater: self
- selector: #listWindowsOn: ]
- !
Item was removed:
- ----- Method: TheWorldMainDockingBar>>workingWithSqueak (in category 'submenu - help') -----
- workingWithSqueak
-
- self
- openHelp: #SqueakProjectHelp
- topic: #workingWithSqueak!
Item was removed:
- ----- Method: TheWorldMainDockingBar>>workspaceMenuItemOn: (in category 'submenu - tools') -----
- workspaceMenuItemOn: menu
-
- menu addItem: [ :item |
- item
- contents: 'Workspace' translated;
- help: 'Open a Workspace' translated;
- icon: (self colorIcon: Workspace basicNew windowColorToUse);
- target: StandardToolSet;
- selector: #openWorkspace ]!
Item was removed:
- Object subclass: #TheWorldMenu
- instanceVariableNames: 'myProject myWorld myHand'
- classVariableNames: 'OpenMenuRegistry'
- poolDictionaries: ''
- category: 'Morphic-Kernel'!
-
- !TheWorldMenu commentStamp: 'sw 10/5/2002 00:44' prior: 0!
- Instances of TheWorldMenu serve to present the primary Squeak menu obtained by clicking on open desktop, which is variously spoken of as the "screen menu", the "desktop menu", or the "world menu".
-
- myProject is the Project I pertain to.
- myWorld is the world, a PasteUpMorph, that I pertain to.
- myHand is the hand that invoked the menu.!
Item was removed:
- ----- Method: TheWorldMenu class>>cleanUp (in category 'class initialization') -----
- cleanUp
- "Flush out obsolete entries"
-
- self removeObsolete!
Item was removed:
- ----- Method: TheWorldMenu class>>loadSqueakMap (in category 'open-menu registry') -----
- loadSqueakMap
- "Load the externally-maintained SqueakMap package if it is not already loaded. Based on code by Göran Hultgren"
-
- | server |
- Socket initializeNetwork.
- server := #('map1.squeakfoundation.org' 'map2.squeakfoundation.org' 'map.squeak.org' 'map.bluefish.se' 'marvin.bluefish.se:8000')
- detect: [:srv | | addr answer |
- addr := NetNameResolver addressForName: (srv upTo: $:) timeout: 5.
- addr notNil and: [
- answer := HTTPSocket httpGet: ('http://', srv, '/sm/ping').
- answer isString not and: [answer contents = 'pong']]]
- ifNone: [^ self inform: 'Sorry, no SqueakMap master server responding.'].
- server ifNotNil: ["Ok, found an SqueakMap server"
- ChangeSet newChangesFromStream:
- ((('http://', server, '/sm/packagebyname/squeakmap/downloadurl')
- asUrl retrieveContents content) asUrl retrieveContents content unzipped
- readStream)
- named: 'SqueakMap']!
Item was removed:
- ----- Method: TheWorldMenu class>>openPackageLoader (in category 'open-menu registry') -----
- openPackageLoader
- "If this method is reached, it means that SMLoader has not yet been loaded; after SqueakMap has come into the image, a different receiver/selector will have been installed under 'Package Loader'; if this method is reached when theoretically SqueakMap is already loaded, presumably this is a grandfathered menu item in a still-up menu, so get the message on to its appropriate recipient."
-
- | loaderClass |
- ((loaderClass := Smalltalk at: #SMLoader ifAbsent: [nil]) isKindOf: Class)
- ifTrue:
- [^ loaderClass open].
-
- (self confirm:
- 'This requires that you first install "SqueakMap" into your image.
- SqueakMap is a new architecture for finding, installing, and
- publishing packages in Squeak.
- Would you like to install SqueakMap now?' )
- ifTrue:
- [self loadSqueakMap]!
Item was removed:
- ----- Method: TheWorldMenu class>>registerOpenCommand: (in category 'open-menu registry') -----
- registerOpenCommand: anArray
- "The array received should be of form {'A Label String'. {TargetObject. #command} 'A Help String'} ; the final element is optional but if present will be used to supply balloon help for the menu item in the Open menu.
- If any previous registration of the same label string is already known, delete the old one."
-
- self unregisterOpenCommand: anArray first.
- OpenMenuRegistry addLast: anArray!
Item was removed:
- ----- Method: TheWorldMenu class>>registeredOpenCommands (in category 'open-menu registry') -----
- registeredOpenCommands
- "Answer the list of dynamic open commands, sorted by description"
-
- ^self registry asArray sort: [ :a :b | a first asLowercase < b first asLowercase ]!
Item was removed:
- ----- Method: TheWorldMenu class>>registry (in category 'open-menu registry') -----
- registry
- "Answer the registry of dynamic open commands"
-
- ^OpenMenuRegistry ifNil: [OpenMenuRegistry := OrderedCollection new].
- !
Item was removed:
- ----- Method: TheWorldMenu class>>removeObsolete (in category 'open-menu registry') -----
- removeObsolete
- "Remove all obsolete commands"
- self registry removeAllSuchThat: [:e | e second first class isObsolete].!
Item was removed:
- ----- Method: TheWorldMenu class>>unregisterOpenCommand: (in category 'open-menu registry') -----
- unregisterOpenCommand: label
- "Remove the open command with the given label from the registry"
-
- self registry removeAllSuchThat: [:e | e first = label]!
Item was removed:
- ----- Method: TheWorldMenu class>>unregisterOpenCommandWithReceiver: (in category 'open-menu registry') -----
- unregisterOpenCommandWithReceiver: aReceiver
- "Remove the open command with the given object as receiver from the registry"
-
- self registry removeAllSuchThat: [:e | e second first == aReceiver]!
Item was removed:
- ----- Method: TheWorldMenu>>addGestureHelpItemsTo: (in category 'menu') -----
- addGestureHelpItemsTo: aMenuMorph
- !
Item was removed:
- ----- Method: TheWorldMenu>>addObjectsAndTools: (in category 'construction') -----
- addObjectsAndTools: menu
- self
- fillIn: menu
- from: {
- nil.
- { 'objects (o)'. { #myWorld. #activateObjectsTool }. 'A tool for finding and obtaining many kinds of objects' }.
- { 'new morph...'. { self. #newMorph }. 'Offers a variety of ways to create new objects' }.
- nil.
- { 'authoring tools...'. { self. #scriptingDo }. 'A menu of choices useful for authoring' }.
- { 'playfield options...'. { self. #playfieldDo }. 'A menu of options pertaining to this object as viewed as a playfield' }.
- { 'flaps...'. { self. #flapsDo }. 'A menu relating to use of flaps. For best results, use "keep this menu up"' }.
- { 'projects...'. { self. #projectDo }. 'A menu of commands relating to use of projects' }.
- { 'telemorphic...' . {self. #remoteDo}. 'commands for doing multi-machine "telemorphic" experiments'}.
- nil
- }!
Item was removed:
- ----- Method: TheWorldMenu>>addPrintAndDebug: (in category 'construction') -----
- addPrintAndDebug: menu
- Preferences simpleMenus ifFalse: [
- self
- fillIn: menu
- from: {
- { 'make screenshot'. {self. #saveScreenshot}. 'makes a screenshot and saves it to disk'}.
- "{ 'print PS to file...'. { self. #printWorldOnFile }. 'write the world into a postscript file' }."
- { 'debug...'. { self. #debugDo }. 'a menu of debugging items' }
- } ]!
Item was removed:
- ----- Method: TheWorldMenu>>addProjectEntries: (in category 'construction') -----
- addProjectEntries: menu
- self
- fillIn: menu
- from: {
- nil.
- { 'previous project'. { #myWorld. #goBack }. 'return to the most-recently-visited project' }.
- { 'jump to project...'. { #myWorld. #jumpToProject }. 'put up a list of all projects, letting me choose one to go to' }.
- { 'save project on file...'. { #myWorld. #saveOnFile }. 'save this project on a file' }.
- {'load project from file...'. {self. #loadProject}. 'load a project from a file' }.
- nil
- }!
Item was removed:
- ----- Method: TheWorldMenu>>addRestoreDisplay: (in category 'construction') -----
- addRestoreDisplay: menu
- self
- fillIn: menu
- from: {
- {'restore display (r)'. { Project current. #restoreDisplay }. 'repaint the screen -- useful for removing unwanted display artifacts, lingering cursors, etc.' }.
- nil
- }!
Item was removed:
- ----- Method: TheWorldMenu>>addSaveAndQuit: (in category 'construction') -----
- addSaveAndQuit: menu
- self
- fillIn: menu
- from: {
- nil.
- { 'save'. { Smalltalk. #saveSession }. 'save the current version of the image on disk' }.
- { 'save as...'. { Smalltalk. #saveAs }. 'save the current version of the image on disk under a new name.' }.
- { 'save as new version'. { Smalltalk. #saveAsNewVersion }. 'give the current image a new version-stamped name and save it under that name on disk.' }.
- { 'save and quit'. { self. #saveAndQuit }. 'save the current image on disk, and quit out of Squeak.' }.
- { 'quit'. { self. #quitSession }. 'quit out of Squeak.' }
- }!
Item was removed:
- ----- Method: TheWorldMenu>>addUtilities: (in category 'construction') -----
- addUtilities: menu
- Preferences simpleMenus ifFalse: [
- self
- fillIn: menu
- from: {
- { 'open...'. { self. #openWindow } }.
- { 'windows...'. { self. #windowsDo } }.
- { 'changes...'. { self. #changesDo } }
- } ].
- self
- fillIn: menu
- from: {
- { 'help...'. { self. #helpDo }. 'puts up a menu of useful items for updating the system, determining what version you are running, and much else' }.
- { 'appearance...'. { self. #appearanceDo }. 'put up a menu offering many controls over appearance.' }
- }.
- Preferences simpleMenus ifFalse: [
- self
- fillIn: menu
- from: {
- { 'do...'. { Utilities. #offerCommonRequests }. 'put up an editible list of convenient expressions, and evaluate the one selected.' }
- } ]!
Item was removed:
- ----- Method: TheWorldMenu>>alphabeticalMorphMenu (in category 'construction') -----
- alphabeticalMorphMenu
- | list splitLists menu firstChar lastChar subMenu |
- list := Morph withAllSubclasses select: [:m | m includeInNewMorphMenu].
- list := list sorted: [:c1 :c2 | c1 name < c2 name].
- splitLists := self splitNewMorphList: list depth: 3.
- menu := MenuMorph new defaultTarget: self.
- 1 to: splitLists size
- do:
- [:i |
- firstChar := i = 1
- ifTrue: [$A]
- ifFalse:
- [((splitLists at: i - 1) last name first asInteger + 1)
- asCharacter].
- lastChar := i = splitLists size
- ifTrue: [$Z]
- ifFalse: [(splitLists at: i) last name first].
- subMenu := MenuMorph new.
- (splitLists at: i) do:
- [:cl |
- subMenu
- add: cl name
- target: self
- selector: #newMorphOfClass:event:
- argument: cl].
- menu add: firstChar asString , ' - ' , lastChar asString subMenu: subMenu].
- ^menu!
Item was removed:
- ----- Method: TheWorldMenu>>appearanceDo (in category 'popups') -----
- appearanceDo
- "Build and show the appearance menu for the world."
-
- self doPopUp: self appearanceMenu!
Item was removed:
- ----- Method: TheWorldMenu>>appearanceMenu (in category 'construction') -----
- appearanceMenu
- "Build the appearance menu for the world."
-
- ^self fillIn: (self menu: 'appearance...') from: {
-
- {'preferences...' . { self . #openPreferencesBrowser} . 'Opens a "Preferences Browser" which allows you to alter many settings' } .
- {'preferences wizard...' . { self . #openPreferencesWizard} . 'Opens a "Preferences Wizard" which allows you to alter many settings in a guided fashion' } .
- {'choose set of preferences...' . { Preferences . #offerThemesMenu} . 'Presents you with a menu of sets or preferences; each item''s balloon-help will tell you about the particular set. If you choose one, many different preferences that come along are set at the same time; you can subsequently change any settings by using a Preferences Panel'} .
- nil .
- {'system fonts...' . { self . #standardFontDo} . 'Choose the standard fonts to use for code, lists, menus, window titles, etc.'}.
- nil.
- {#menuColorString . { self . #toggleMenuColorPolicy} . 'Governs whether menu colors should be derived from the desktop color.'}.
- {#roundedCornersString . { self . #toggleRoundedCorners} . 'Governs whether morphic windows and menus should have rounded corners.'}.
- nil.
- {'full screen on' . { DisplayScreen . #fullScreenOn} . 'puts you in full-screen mode, if not already there.'}.
- {'full screen off' . { DisplayScreen . #fullScreenOff} . 'if in full-screen mode, takes you out of it.'}.
- nil.
- {'set display depth...' . {self. #setDisplayDepth} . 'choose how many bits per pixel.'}.
- {'set desktop color...' . {self. #changeBackgroundColor} . 'choose a uniform color to use as desktop background.'}.
- {'set gradient color...' . {self. #setGradientColor} . 'choose second color to use as gradient for desktop background.'}.
- {'use texture background' . { #myWorld . #setStandardTexture} . 'apply a graph-paper-like texture background to the desktop.'}.
- nil.
- {'clear turtle trails from desktop' . { #myWorld . #clearTurtleTrails} . 'remove any pigment laid down on the desktop by objects moving with their pens down.'}.
- {'pen-trail arrowhead size...' . { Preferences. #setArrowheads} . 'choose the shape to be used in arrowheads on pen trails.'}.
-
- }!
Item was removed:
- ----- Method: TheWorldMenu>>buildWorldMenu (in category 'construction') -----
- buildWorldMenu
- "Build the menu that is put up when the screen-desktop is clicked on"
- | menu |
- menu := MenuMorph new defaultTarget: self.
- menu commandKeyHandler: self.
- self colorForDebugging: menu.
- menu addStayUpItem.
- self makeConvenient: menu.
- Smalltalk at: #ServiceGUI ifPresent:[:sgui|
- sgui worldMenu: menu.
- sgui onlyServices ifTrue: [^ menu].
- ].
- self addProjectEntries: menu.
- myWorld addUndoItemsTo: menu.
- self addRestoreDisplay: menu.
- self addUtilities: menu.
- self addObjectsAndTools: menu.
- self addPrintAndDebug: menu.
- self addSaveAndQuit: menu.
- ^ menu!
Item was removed:
- ----- Method: TheWorldMenu>>changeBackgroundColor (in category 'commands') -----
- changeBackgroundColor
- "Let the user select a new background color for the world"
- myWorld
- changeColorTarget: myWorld
- selector: #setAsBackground:
- originalColor: myWorld fillStyle asColor
- hand: myWorld activeHand!
Item was removed:
- ----- Method: TheWorldMenu>>changesDo (in category 'popups') -----
- changesDo
- "Build the changes menu for the world."
-
- self doPopUp: self changesMenu!
Item was removed:
- ----- Method: TheWorldMenu>>changesMenu (in category 'construction') -----
- changesMenu
- "Build the changes menu for the world."
-
- | menu |
- menu := self menu: 'changes...'.
- self fillIn: menu from: {
- { 'file out current change set' . { ChangeSet current . #verboseFileOut}.
- 'Write the current change set out to a file whose name reflects the change set name and the current date & time.'}.
- { 'create new change set...' . { ChangeSet . #newChangeSet}. 'Create a new change set and make it the current one.'}.
- { 'browse changed methods' . { ChangeSet . #browseChangedMessages}. 'Open a message-list browser showing all methods in the current change set'}.
- { 'check change set for slips' . { self . #lookForSlips}.
- 'Check the current change set for halts, references to the Transcript, etc., and if any such thing is found, open up a message-list browser detailing all possible slips.'}.
-
- nil.
- { 'simple change sorter' . {self. #openChangeSorter1}. 'Open a 3-paned changed-set viewing tool'}.
- { 'dual change sorter' . {self. #openChangeSorter2}.
- 'Open a change sorter that shows you two change sets at a time, making it easy to copy and move methods and classes between them.'}.
- { 'find a change sorter (C)' . { #myWorld . #findAChangeSorter: }. 'Brings an open change sorter to the front, creating one if necessary, and makes it the active window'}.
- nil.
- { 'browse recent submissions (R)' . { Utilities . #browseRecentSubmissions}.
- 'Open a new recent-submissions browser. A recent-submissions browser is a message-list browser that shows the most recent methods that have been submitted. If you submit changes within that browser, it will keep up-to-date, always showing the most recent submissions.'}.
- { 'browse my changes' . { SystemNavigation new . #browseMyChanges }.
- 'Browse all of my changes since the last time #condenseSources was run.'}.
- nil.
- { 'recently logged changes...' . { self . #browseRecentLog}.'Open a change-list browser on the latter part of the changes log. You can use this browser to recover logged changes which were not saved in your image, in the event of a crash or other interruption.'}.
-
- { 'recent log file...' . { Smalltalk . #writeRecentToFile}.
- 'Create a file holding the logged changes (going as far back as you wish), and open a window on that file.'}.
-
- nil.
- { 'save world as morph file' . {self. #saveWorldInFile}. 'Save a file that, when reloaded, reconstitutes the current World.'}.
- nil.
- }.
- ^ menu!
Item was removed:
- ----- Method: TheWorldMenu>>cleanUpWorld (in category 'commands') -----
- cleanUpWorld
- (UIManager default confirm:
- 'This will remove all windows except those
- containing unsubmitted text edits, and will
- also remove all non-window morphs (other
- than flaps) found on the desktop. Are you
- sure you want to do this?' translated)
- ifFalse: [^ self].
-
- myWorld allNonFlapRelatedSubmorphs do:
- [:m | m delete].
- (SystemWindow windowsIn: myWorld satisfying: [:w | w model canDiscardEdits])
- do: [:w | w delete]!
Item was removed:
- ----- Method: TheWorldMenu>>colorForDebugging: (in category 'construction') -----
- colorForDebugging: aMenu
-
- "aMenu color: self myMenuColor"
-
- "aMenu color: Color lightRed"
-
- !
Item was removed:
- ----- Method: TheWorldMenu>>commandKeyTypedIntoMenu: (in category 'action') -----
- commandKeyTypedIntoMenu: evt
- "The user typed a command-key into the given menu; dispatch it"
-
- myWorld keystrokeInWorld: evt !
Item was removed:
- ----- Method: TheWorldMenu>>debugDo (in category 'popups') -----
- debugDo
-
- self doPopUp: self debugMenu!
Item was removed:
- ----- Method: TheWorldMenu>>debugMenu (in category 'construction') -----
- debugMenu
-
- | menu |
-
- menu := self menu: 'debug...'.
- self fillIn: menu from: {
- { 'inspect world' . { #myWorld . #inspect } }.
- { 'explore world' . { #myWorld . #explore } }.
- { 'inspect model' . { myWorld model . #inspect } }.
- " { 'talk to world...' . { self . #typeInMessageToWorld } }."
- { 'start MessageTally' . { self . #startMessageTally } }.
- { 'start/browse MessageTally' . { self . #startThenBrowseMessageTally } }.
- { 'open process browser' . { self . #openProcessBrowser } }.
- nil.
- "(self hasProperty: #errorOnDraw) ifTrue: Later make this come up only when needed."
- { 'start drawing again' . { #myWorld . #resumeAfterDrawError } }.
- { 'start stepping again' . { #myWorld . #resumeAfterStepError } }.
- nil.
- { 'call #tempCommand' . { #myWorld . #tempCommand } }.
- { 'define #tempCommand' . { #myWorld . #defineTempCommand } }.
- }.
- self haltOnceEnabled
- ifTrue: [menu
- add: 'disable halt/inspect once' translated
- target: menu
- action: #clearHaltOnce]
- ifFalse: [menu
- add: 'enable halt/inspect once' translated
- target: menu
- action: #setHaltOnce].
- ^menu
- !
Item was removed:
- ----- Method: TheWorldMenu>>doMenuItem:with: (in category 'action') -----
- doMenuItem: aCollection with: event
- | realTarget selector nArgs |
- selector := aCollection second.
- nArgs := selector numArgs.
- realTarget := aCollection first.
- realTarget == #myWorld ifTrue: [realTarget := myWorld].
- realTarget == #myHand ifTrue: [realTarget := myHand].
- realTarget == #myProject ifTrue: [realTarget := self projectForMyWorld].
- ^nArgs = 0
- ifTrue:[realTarget perform: selector]
- ifFalse:[realTarget perform: selector with: event].
- !
Item was removed:
- ----- Method: TheWorldMenu>>doPopUp: (in category 'popups') -----
- doPopUp: aMenu
-
- aMenu popUpForHand: myHand in: myWorld.
- !
Item was removed:
- ----- Method: TheWorldMenu>>fillIn:from: (in category 'construction') -----
- fillIn: aMenu from: dataForMenu
- "A menu constructor utility by RAA. dataForMenu is a list of items which mean:
- nil Indicates to add a line
-
- first element is symbol Add updating item with the symbol as the wording selector
- second element is a list second element has the receiver and selector
-
- first element is a string Add menu item with the string as its wording
- second element is a list second element has the receiver and selector
-
- a third element exists Use it as the balloon text
- a fourth element exists Use it as the enablement selector (updating case only)"
-
-
- dataForMenu do: [ :itemData | | item |
- itemData ifNil: [aMenu addLine] ifNotNil:
- [item := itemData first isSymbol
- ifTrue:
- [aMenu
- addUpdating: itemData first
- target: self
- selector: #doMenuItem:with:
- argumentList: {itemData second}]
- ifFalse:
- [aMenu
- add: itemData first translated
- target: self
- selector: #doMenuItem:with:
- argumentList: {itemData second}].
- itemData size >= 3 ifTrue:
- [aMenu balloonTextForLastItem: itemData third translated.
- itemData size >= 4 ifTrue:
- [item enablementSelector: itemData fourth]]]].
-
- ^ aMenu!
Item was removed:
- ----- Method: TheWorldMenu>>garbageCollect (in category 'commands') -----
- garbageCollect
- "Do a garbage collection, and report results to the user."
-
- Utilities garbageCollectAndReport!
Item was removed:
- ----- Method: TheWorldMenu>>helpDo (in category 'popups') -----
- helpDo
- "Build and show the help menu for the world."
-
- self doPopUp: self helpMenu!
Item was removed:
- ----- Method: TheWorldMenu>>helpMenu (in category 'construction') -----
- helpMenu
- "Build the help menu for the world."
- | menu |
-
- menu := self menu: 'help...'.
-
- self fillIn: menu from:
- {
- {'about this system...'. {Smalltalk. #aboutThisSystem}. 'current version information.'}.
- {'update code from server'. {MCMcmUpdater. #updateFromServer}. 'load latest code updates via the internet'}.
- {'preferences...'. {self. #openPreferencesBrowser}. 'view and change various options.'}.
- {'set language...' . {Project. #chooseNaturalLanguage}. 'choose the language in which tiles should be displayed.'} .
- nil.
- {'command-key help'. { TheWorldMainDockingBar instance . #commandKeyHelp}. 'summary of keyboard shortcuts.'}
- }.
-
- self addGestureHelpItemsTo: menu.
-
- self fillIn: menu from:
- {
- {'world menu help'. { self . #worldMenuHelp}. 'helps find menu items buried in submenus.'}.
- "{'info about flaps' . { Utilities . #explainFlaps}. 'describes how to enable and use flaps.'}."
- {'font size summary' . { TextStyle . #fontSizeSummary}. 'summary of names and sizes of available fonts.'}.
- {'useful expressions' . { Utilities . #openStandardWorkspace}. 'a window full of useful expressions.'}.
- {'annotation setup...' . { Preferences . #editAnnotations}. 'Click here to get a little window that will allow you to specify which types of annotations, in which order, you wish to see in the annotation panes of browsers and other tools'}.
- nil.
- {'graphical imports' . { Imports default . #viewImages}. 'view the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList'}.
- {'standard graphics library' . { ScriptingSystem . #inspectFormDictionary}. 'lets you view and change the system''s standard library of graphics.'}.
- nil.
- {'telemorphic...' . {self. #remoteDo}. 'commands for doing multi-machine "telemorphic" experiments'}.
- {#soundEnablingString . { SoundService . #toggleSoundEnabled}. 'turning sound off will completely disable Squeak''s use of sound.'}.
- nil.
-
- {'set author initials...' . { Utilities . #setAuthorInitials }. 'supply initials to be used to identify the author of code and other content.'}.
- {'vm statistics' . { self . #vmStatistics}. 'obtain some intriguing data about the vm.'}.
- nil.
- {'purge undo records' . { CommandHistory . #resetAllHistory }. 'save space by removing all the undo information remembered in all projects.'}.
- {'space left' . { self . #garbageCollect}. 'perform a full garbage-collection and report how many bytes of space remain in the image.'}.
- }.
-
- ^menu
-
- !
Item was removed:
- ----- Method: TheWorldMenu>>loadProject (in category 'commands') -----
- loadProject
-
- | fName |
- "Put up a Menu and let the user choose a '.project' file to load. Create a thumbnail and jump into the project."
-
- Project canWeLoadAProjectNow ifFalse: [^ self].
- fName := UIManager default chooseFileMatchingSuffixes: #('pr' 'project').
- fName ifNil:[^nil].
-
- FileDirectory splitName: fName to:[:dir :file|
- ProjectLoading
- openFromDirectory: dir
- andFileName: file]
- !
Item was removed:
- ----- Method: TheWorldMenu>>lookForSlips (in category 'commands') -----
- lookForSlips
-
- ChangeSet current lookForSlips!
Item was removed:
- ----- Method: TheWorldMenu>>makeConvenient: (in category 'construction') -----
- makeConvenient: menu
- self
- fillIn: menu
- from: {
- { 'Browser'. { StandardToolSet. #openClassBrowser }. 'open a browser' }.
- { 'Workspace'. { Workspace. #open }. 'open a workspace' }.
- { 'Transcript'. { Transcript. #open }. 'open a transcript' }.
- Smalltalk at: #TestRunner ifPresent:[:aClass|
- { 'Test Runner'. { aClass. #open }. 'open a test runner' }.
- ].
- nil
- }!
Item was removed:
- ----- Method: TheWorldMenu>>menu: (in category 'mechanics') -----
- menu: titleString
- "Create a menu with the given title, ready for filling"
-
- | menu |
- (menu := MenuMorph entitled: titleString translated)
- defaultTarget: self;
- addStayUpItem;
- commandKeyHandler: self.
- self colorForDebugging: menu.
- ^ menu
- !
Item was removed:
- ----- Method: TheWorldMenu>>menuColorString (in category 'action') -----
- menuColorString
-
- ^ Preferences menuColorString!
Item was removed:
- ----- Method: TheWorldMenu>>mvcProjectsAllowed (in category 'commands') -----
- mvcProjectsAllowed
-
- ^Preferences mvcProjectsAllowed and: [Smalltalk includesKey: #StandardSystemView]!
Item was removed:
- ----- Method: TheWorldMenu>>newMorph (in category 'construction') -----
- newMorph
- "The user requested 'new morph' from the world menu. Put up a menu that allows many ways of obtaining new morphs."
-
- | menu |
-
- menu := self menu: 'Add a new morph'.
- menu
- add: 'from paste buffer' translated target: myHand action: #pasteMorph;
- add: 'from alphabetical list' translated subMenu: self alphabeticalMorphMenu;
- add: 'from a file...' translated target: self action: #readMorphFromAFile.
- menu addLine.
- menu add: 'grab rectangle from screen' translated target: myWorld action: #grabDrawingFromScreen:;
- add: 'grab with lasso from screen' translated target: myWorld action: #grabLassoFromScreen:;
- add: 'grab rubber band from screen' translated target: myWorld action: #grabRubberBandFromScreen:;
- add: 'grab flood area from screen' translated target: myWorld action: #grabFloodFromScreen:.
- menu addLine.
- menu add: 'make new drawing' translated target: myWorld action: #newDrawingFromMenu:;
- add: 'make link to project...' translated target: self action: #projectThumbnail.
-
- self doPopUp: menu.
- !
Item was removed:
- ----- Method: TheWorldMenu>>newMorphOfClass:event: (in category 'commands') -----
- newMorphOfClass: morphClass event: evt
- "Attach a new morph of the given class to the invoking hand."
-
- | m |
- m := morphClass new.
- m installModelIn: myWorld. "a chance to install model pointers"
- m wantsToBeOpenedInWorld
- ifTrue:[myWorld addMorph: m]
- ifFalse:[evt hand attachMorph: m].
- myWorld startSteppingSubmorphsOf: m.
- !
Item was removed:
- ----- Method: TheWorldMenu>>openBrowser (in category 'commands') -----
- openBrowser
- "Create and schedule a Browser view for browsing code."
- ToolSet browse: nil selector: nil!
Item was removed:
- ----- Method: TheWorldMenu>>openFileDirectly (in category 'commands') -----
- openFileDirectly
-
- FileList openFileDirectly!
Item was removed:
- ----- Method: TheWorldMenu>>openFileList (in category 'commands') -----
- openFileList
- FileList open.!
Item was removed:
- ----- Method: TheWorldMenu>>openMVCProject (in category 'commands') -----
- openMVCProject
- "Open a new MVC project (only if MVC is present)"
- Smalltalk at: #MVCProject ifPresent:[:projClass|
- ProjectViewMorph openOn: projClass new.
- ].!
Item was removed:
- ----- Method: TheWorldMenu>>openMenu (in category 'construction') -----
- openMenu
- "Build the open window menu for the world."
-
- | menu |
- menu := self menu: 'open...'.
- menu defaultTarget: ToolSet default.
- menu addList: ToolSet menuItems.
- menu defaultTarget: self.
- self fillIn: menu from: {
- nil.
- {'file...' . { self . #openFileDirectly} . 'Lets you open a window on a single file'}.
- {'transcript (t)' . {self . #openTranscript}. 'A window used to report messages sent to Transcript' }.
- "{'inner world' . { WorldWindow . #test1} }."
- nil.
- }.
- self fillIn: menu from: self class registeredOpenCommands.
- menu addLine.
-
- self mvcProjectsAllowed ifTrue:
- [self fillIn: menu from: { {'mvc project' . {self. #openMVCProject} . 'Creates a new project of the classic "mvc" style'} }].
-
- self fillIn: menu from: {
- {'morphic project' . {self. #openMorphicProject} . 'Creates a new morphic project'}.
- }.
- Smalltalk at: #SMxMorphicProject ifPresent: [:p |
- self fillIn: menu from: {
- { 'simple morphic project' . { self . #openSMxMorphicProject } . 'Creates a new simple morphic project' }.
- }
- ].
- ^menu
- !
Item was removed:
- ----- Method: TheWorldMenu>>openMorphicProject (in category 'commands') -----
- openMorphicProject
- "Open a morphic project from within a morphic project"
- MorphicProject openViewOn: nil
- !
Item was removed:
- ----- Method: TheWorldMenu>>openPreferencesBrowser (in category 'commands') -----
- openPreferencesBrowser
- "Open a preferences browser"
- ^Smalltalk at: #PreferenceBrowser ifPresent:[:pb| pb open].
- !
Item was removed:
- ----- Method: TheWorldMenu>>openPreferencesWizard (in category 'commands') -----
- openPreferencesWizard
-
- ^ (self environment classNamed: #PreferenceWizardMorph) ifNotNil: [:pw | pw open]!
Item was removed:
- ----- Method: TheWorldMenu>>openTranscript (in category 'commands') -----
- openTranscript
-
- Transcript openLabel: 'Transcript'!
Item was removed:
- ----- Method: TheWorldMenu>>openWindow (in category 'popups') -----
- openWindow
-
- self doPopUp: self openMenu!
Item was removed:
- ----- Method: TheWorldMenu>>openWorkspace (in category 'commands') -----
- openWorkspace
-
- UIManager default edit: '' label: 'Workspace'!
Item was removed:
- ----- Method: TheWorldMenu>>projectDo (in category 'popups') -----
- projectDo
- "Build and show the project menu for the world."
-
- self doPopUp: self projectMenu!
Item was removed:
- ----- Method: TheWorldMenu>>projectForMyWorld (in category 'commands') -----
- projectForMyWorld
-
- ^myProject ifNil: [myProject := myWorld project]!
Item was removed:
- ----- Method: TheWorldMenu>>projectMenu (in category 'construction') -----
- projectMenu
- "Build the project menu for the world."
- | menu |
-
- self flag: #bob0302.
-
- menu := self menu: 'projects...'.
- self fillIn: menu from: {
- { 'save on server (also makes a local copy)' . { #myProject . #storeOnServer } }.
- { 'save to a different server' . { #myProject . #saveAs } }.
- { 'save project on local file only' . { #myWorld . #saveOnFile } }.
- { 'see if server version is more recent...' . { #myProject . #loadFromServer } }.
- { 'load project from file...' . { self . #loadProject } }.
- nil.
- }.
-
- self mvcProjectsAllowed ifTrue: [
- self fillIn: menu from: {
- { 'create new mvc project'. { self . #openMVCProject } }.
- }
- ].
- self fillIn: menu from: {
- { 'create new morphic project' . { self . #openMorphicProject } }.
- }.
- Smalltalk at: #SMxMorphicProject ifPresent: [:p |
- self fillIn: menu from: {
- { 'create new simple morphic project' . { self . #openSMxMorphicProject } }.
- }
- ].
- self fillIn: menu from: {
- nil.
- { 'go to previous project' . { Project . #returnToPreviousProject } }.
- { 'go to next project' . { Project . #advanceToNextProject } }.
- { 'jump to project...' . { #myWorld . #jumpToProject } }.
- }.
- Preferences simpleMenus ifFalse: [
- self fillIn: menu from: {
- nil.
- { 'save for future revert' . { #myProject . #saveForRevert } }.
- { 'revert to saved copy' . { #myProject . #revert } }.
- }.
- ].
-
- ^ menu!
Item was removed:
- ----- Method: TheWorldMenu>>projectThumbnail (in category 'action') -----
- projectThumbnail
- "Offer the user a menu of project names. Attach to the hand a thumbnail of the project the user selects."
-
- | projName pr names values |
- names := OrderedCollection with: Project current name, ' (current)'.
- values := OrderedCollection with: Project current name.
- Project allNames do: [:n | names add: n. values add: n].
- projName := UIManager default
- chooseFrom: names values: values lines: #(1) title: 'Select a project'.
- projName ifNotNil:
- [(pr := Project named: projName)
- ifNotNil: [myHand attachMorph: (ProjectViewMorph on: pr)]
- ifNil: [self inform: 'can''t seem to find that project']].!
Item was removed:
- ----- Method: TheWorldMenu>>quitSession (in category 'commands') -----
- quitSession
-
- Smalltalk
- snapshot: (UserDialogBoxMorph
- confirm: 'Save changes before quitting?' translated
- orCancel: [^ self]
- at: Project current world center)
- andQuit: true!
Item was removed:
- ----- Method: TheWorldMenu>>readMorphFromAFile (in category 'commands') -----
- readMorphFromAFile
- "Produce a morph from a file -- either a saved .morph file or a graphics file"
-
- | morphOrList ff aName f m |
- aName := UIManager default chooseFileMatchingSuffixes: (Form allTypicalFileExtensions add: 'morph'; yourself) label: 'Choose a file to load' translated.
- aName ifNil: [^ self]. "User made no choice"
-
- (aName asLowercase endsWith: '.morph')
- ifTrue:
- [ff := FileStream readOnlyFileNamed: aName.
- morphOrList := ff fileInObjectAndCode. "code filed in is the Model class"
- "the file may contain either a single morph or an array of morphs"
- myWorld addMorphsAndModel: morphOrList]
- ifFalse:
- [f := Form fromFileNamed: aName.
- f ifNil: [^ self error: 'unrecognized image file format' translated].
- m := myWorld drawingClass new form: f.
- myHand attachMorph: m]
- !
Item was removed:
- ----- Method: TheWorldMenu>>remoteDo (in category 'popups') -----
- remoteDo
-
- self doPopUp: self remoteMenu!
Item was removed:
- ----- Method: TheWorldMenu>>remoteMenu (in category 'construction') -----
- remoteMenu
- "Build the Telemorphic menu for the world."
-
- ^self fillIn: (self menu: 'Telemorphic' translatedNoop) from: {
- { 'local host address' translatedNoop. { #myWorld . #reportLocalAddress } }.
- { 'connect remote user' translatedNoop. { #myWorld . #connectRemoteUser } }.
- { 'disconnect remote user' translatedNoop. { #myWorld . #disconnectRemoteUser } }.
- { 'disconnect all remote users' translatedNoop. { #myWorld . #disconnectAllRemoteUsers } }.
- }!
Item was removed:
- ----- Method: TheWorldMenu>>roundedCornersString (in category 'action') -----
- roundedCornersString
-
- ^ (((SystemWindow roundedWindowCorners)
- ifTrue: ['stop']
- ifFalse: ['start']) , ' rounding window corners') translated!
Item was removed:
- ----- Method: TheWorldMenu>>saveAndQuit (in category 'commands') -----
- saveAndQuit
-
- Smalltalk snapshot: true andQuit: true!
Item was removed:
- ----- Method: TheWorldMenu>>saveScreenshot (in category 'action') -----
- saveScreenshot
- "Make a screenshot of the world and save it to a file"
-
- SampledSound playSoundNamed: 'camera'.
- PNGReadWriter putForm: myWorld imageForm onFileNamed:
- (FileDirectory default nextNameFor: 'SqueakScreen' extension:'png').
- !
Item was removed:
- ----- Method: TheWorldMenu>>saveWorldInFile (in category 'commands') -----
- saveWorldInFile
- "Save the world's submorphs, model, and stepList in a file. "
-
- | fileName fileStream aClass |
- fileName := UIManager default request: 'File name for this morph?'.
- fileName isEmpty ifTrue: [^ self]. "abort"
-
- "Save only model, stepList, submorphs in this world"
- myWorld submorphsDo: [:m |
- m allMorphsDo: [:subM | subM prepareToBeSaved]]. "Amen"
-
- fileStream := FileStream newFileNamed: fileName, '.morph'.
- aClass := myWorld model ifNil: [nil] ifNotNil: [myWorld model class].
- fileStream fileOutClass: aClass andObject: myWorld.
- !
Item was removed:
- ----- Method: TheWorldMenu>>setDisplayDepth (in category 'commands') -----
- setDisplayDepth
- "Let the user choose a new depth for the display. "
-
- | menu effect oldDepth allDepths allLabels hasBoth |
- oldDepth := Display nativeDepth.
- allDepths := #(1 -1 2 -2 4 -4 8 -8 16 -16 32 -32) select: [:d | Display supportsDisplayDepth: d].
- hasBoth := (allDepths anySatisfy:[:d| d > 0]) and:[allDepths anySatisfy:[:d| d < 0]].
- allLabels := allDepths collect:[:d|
- String streamContents:[:s|
- s nextPutAll: (d = oldDepth ifTrue:['<on>'] ifFalse:['<off>']).
- s print: d abs.
- hasBoth ifTrue:[s nextPutAll: (d > 0 ifTrue:[' (big endian)'] ifFalse:[' (little endian)'])].
- ]].
- effect := [:choice | | newDepth |
- newDepth := allDepths at: choice.
- Display newDepth: newDepth].
- oldDepth := oldDepth abs.
- (Smalltalk isMorphic and: [(Display depth < 4) ~= (oldDepth < 4)])
- ifTrue:
- ["Repaint windows since they look better all white in depth < 4"
- (SystemWindow windowsIn: myWorld satisfying: [:w | true]) do:
- [:w |
- oldDepth < 4
- ifTrue: [w restoreDefaultPaneColor]
- ifFalse: [w updatePaneColors]]].
- menu := MenuMorph new
- title: 'Choose a display depth' translated;
- target: effect;
- yourself.
- allLabels withIndexDo: [:label :index |
- menu add: label action: #value:.
- menu lastItem arguments: {index}].
- menu
- invokeAt: self currentHand position
- in: self currentWorld
- allowKeyboard: true.!
Item was removed:
- ----- Method: TheWorldMenu>>setGradientColor (in category 'action') -----
- setGradientColor
-
- myWorld setGradientColor: myHand lastEvent!
Item was removed:
- ----- Method: TheWorldMenu>>soundEnablingString (in category 'action') -----
- soundEnablingString
-
- ^ SoundService soundEnablingString!
Item was removed:
- ----- Method: TheWorldMenu>>splitNewMorphList:depth: (in category 'commands') -----
- splitNewMorphList: list depth: d
- | middle c prev next out |
- d <= 0 ifTrue: [^Array with: list].
- middle := list size // 2 + 1.
- c := (list at: middle) name first.
- prev := middle - 1.
- [prev > 0 and: [(list at: prev) name first = c]]
- whileTrue: [prev := prev - 1].
- next := middle + 1.
- [next <= list size and: [(list at: next) name first = c]]
- whileTrue: [next := next + 1].
- "Choose the better cluster"
- middle := middle - prev < (next - middle)
- ifTrue: [prev + 1]
- ifFalse: [next].
- middle = 1 ifTrue: [middle := next].
- middle >= list size ifTrue: [middle := prev + 1].
- (middle = 1 or: [middle >= list size]) ifTrue: [^Array with: list].
- out := WriteStream on: Array new.
- out nextPutAll: (self splitNewMorphList: (list copyFrom: 1 to: middle - 1)
- depth: d - 1).
- out
- nextPutAll: (self splitNewMorphList: (list copyFrom: middle to: list size)
- depth: d - 1).
- ^out contents!
Item was removed:
- ----- Method: TheWorldMenu>>staggerPolicyString (in category 'action') -----
- staggerPolicyString
-
- ^ Preferences staggerPolicyString!
Item was removed:
- ----- Method: TheWorldMenu>>standardFontDo (in category 'popups') -----
- standardFontDo
- "Build and show the standard font menu"
-
- self doPopUp: Preferences fontConfigurationMenu!
Item was removed:
- ----- Method: TheWorldMenu>>startMessageTally (in category 'commands') -----
- startMessageTally
- | world |
- world := Project current world.
- (self confirm: 'MessageTally will start now,
- and stop when the cursor goes
- to the top of the screen') ifTrue:
- [MessageTally spyOn:
- [[Sensor peekPosition y > 0] whileTrue: [world doOneCycle]]]!
Item was removed:
- ----- Method: TheWorldMenu>>suppressFlapsString (in category 'windows & flaps menu') -----
- suppressFlapsString
- "Answer the wording of the suppress-flaps item"
-
- ^ Project current suppressFlapsString!
Item was removed:
- ----- Method: TheWorldMenu>>toggleMenuColorPolicy (in category 'action') -----
- toggleMenuColorPolicy
-
- Preferences toggle: #menuColorFromWorld.!
Item was removed:
- ----- Method: TheWorldMenu>>toggleRoundedCorners (in category 'action') -----
- toggleRoundedCorners
-
- SystemWindow roundedWindowCorners: SystemWindow roundedWindowCorners not.!
Item was removed:
- ----- Method: TheWorldMenu>>toggleWindowPolicy (in category 'action') -----
- toggleWindowPolicy
-
- Preferences toggle: #reverseWindowStagger.!
Item was removed:
- ----- Method: TheWorldMenu>>vmStatistics (in category 'commands') -----
- vmStatistics
- "Open a string view on a report of vm statistics"
-
- (StringHolder new contents: Smalltalk vmStatisticsReportString)
- openLabel: 'VM Statistics'!
Item was removed:
- ----- Method: TheWorldMenu>>windowsDo (in category 'windows & flaps menu') -----
- windowsDo
- "Build the windows menu for the world."
-
- self doPopUp: self windowsMenu!
Item was removed:
- ----- Method: TheWorldMenu>>windowsMenu (in category 'windows & flaps menu') -----
- windowsMenu
- "Build the windows menu for the world."
-
- ^ self fillIn: (self menu: 'windows' translatedNoop) from: {
- { 'find window' translatedNoop. { #myWorld . #findWindow: }. 'Presents a list of all windows; if you choose one from the list, it becomes the active window.' translatedNoop}.
-
- { 'find changed browsers...' translatedNoop. { #myWorld . #findDirtyBrowsers: }. 'Presents a list of browsers that have unsubmitted changes; if you choose one from the list, it becomes the active window.' translatedNoop}.
-
- { 'find changed windows...' translatedNoop. { #myWorld . #findDirtyWindows: }. 'Presents a list of all windows that have unsubmitted changes; if you choose one from the list, it becomes the active window.' translatedNoop}.
- nil.
-
- { 'find a transcript (t)' translatedNoop. { #myWorld . #findATranscript: }. 'Brings an open Transcript to the front, creating one if necessary, and makes it the active window' translatedNoop}.
-
- { 'find a fileList (L)' translatedNoop. { #myWorld . #findAFileList: }. 'Brings an open fileList to the front, creating one if necessary, and makes it the active window' translatedNoop}.
-
- { 'find a change sorter (C)' translatedNoop. { #myWorld . #findAChangeSorter: }. 'Brings an open change sorter to the front, creating one if necessary, and makes it the active window' translatedNoop}.
-
- { 'find message names (W)' translatedNoop. { #myWorld . #findAMessageNamesWindow: }. 'Brings an open MessageNames window to the front, creating one if necessary, and makes it the active window' translatedNoop}.
-
- nil.
- { #staggerPolicyString . { self . #toggleWindowPolicy }. 'stagger: new windows positioned so you can see a portion of each one.
- tile: new windows positioned so that they do not overlap others, if possible.' translatedNoop}.
-
- nil.
- { 'collapse all windows' translatedNoop. { #myWorld . #collapseAll }. 'Reduce all open windows to collapsed forms that only show titles.' translatedNoop}.
- { 'expand all' translatedNoop. { #myWorld . #expandAll }. 'Expand all collapsed windows and other collapsed objects back to their expanded forms.' translatedNoop}.
-
- { 'close top window (w)' translatedNoop. { SystemWindow . #closeTopWindow }. 'Close the topmost window if possible.' translatedNoop}.
- { 'send top window to back (\)' translatedNoop. { SystemWindow . #sendTopWindowToBack }. 'Make the topmost window become the backmost one, and activate the window just beneath it.' translatedNoop}.
- { 'move windows onscreen' translatedNoop. { #myWorld . #bringWindowsFullOnscreen }. 'Make all windows fully visible on the screen' translatedNoop}.
-
- nil.
- { 'delete unchanged windows' translatedNoop. { #myWorld . #closeUnchangedWindows }. 'Deletes all windows that do not have unsaved text edits.' translatedNoop}.
- { 'delete non-windows' translatedNoop. { #myWorld . #deleteNonWindows }. 'Deletes all non-window morphs lying on the world.' translatedNoop}.
- { 'delete both of the above' translatedNoop. { self . #cleanUpWorld }. 'deletes all unchanged windows and also all non-window morphs lying on the world, other than flaps.' translatedNoop}.
-
- }!
Item was removed:
- ----- Method: TheWorldMenu>>world:project:hand: (in category 'mechanics') -----
- world: aWorld project: aProject hand: aHand
-
- myWorld := aWorld.
- myProject := aProject.
- myHand := aHand.!
Item was removed:
- ----- Method: TheWorldMenu>>worldMenuHelp (in category 'commands') -----
- worldMenuHelp
- | explanation aList |
- "self currentWorld primaryHand worldMenuHelp"
-
- aList := OrderedCollection new.
- #(helpMenu changesMenu openMenu debugMenu projectMenu scriptingMenu windowsMenu playfieldMenu appearanceMenu flapsMenu)
- with:
- #('help' 'changes' 'open' 'debug' 'projects' 'authoring tools' 'windows' 'playfield options' 'appearance' 'flaps') do:
- [:sel :title | | aMenu |
- aMenu := self perform: sel.
- aMenu items do:
- [:it | | cnts |
- (((cnts := it contents) = 'keep this menu up') or: [cnts isEmpty])
- ifFalse: [aList add: (cnts, ' - ', title translated)]]].
- aList sort: [:a :b | a caseInsensitiveLessOrEqual: b ].
-
- explanation := String streamContents: [:aStream | aList do:
- [:anItem | aStream nextPutAll: anItem; cr]].
-
- (StringHolder new contents: explanation)
- openLabel: 'Where in the world menu is...' translated!
Item was removed:
- ImageMorph subclass: #ThreePhaseButtonMorph
- instanceVariableNames: 'offImage pressedImage state target actionSelector arguments actWhen label font textColor'
- classVariableNames: 'AuthorModeOwner'
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !ThreePhaseButtonMorph commentStamp: '<historical>' prior: 0!
- A button morph with separate images for on, off, and pressed with the mouse.
-
- When the event actWhen occurs, send actionSelector with 'arguments' to target. For other events, default to my eventHandler. The current event is not supplied in the arguments to the actionSelector.
-
- image (a.k.a. onImage) may not be nil. offImage and pressedImage may be nil. nil there means be transparent and show the underlying object.
-
- Tools for debugging:
- Display the images momentarily under program control (for positioning) (self is an instance).
- self state: #on. self state: #off.
- self state: #pressed. self state: #off.
- Display a rectangle where the button is.
- Display fillWithColor: bounds + (self world viewBox origin).
- self invalidRect: bounds.!
Item was removed:
- ----- Method: ThreePhaseButtonMorph class>>checkBox (in category 'instance creation') -----
- checkBox
- "Answer a button pre-initialized with checkbox images."
- | f |
- ^self new
- onImage: (f := (MenuIcons checkBoxOn dyed: Color red) scaleIconToDisplay);
- pressedImage: (MenuIcons checkBoxPressed dyed: Color black) scaleIconToDisplay;
- offImage: (MenuIcons checkBoxOff dyed: Color black) scaleIconToDisplay;
- extent: f extent + (2 at 0);
- setDefaultParameters;
- yourself
- !
Item was removed:
- ----- Method: ThreePhaseButtonMorph class>>initialize (in category 'class initialization') -----
- initialize
- "ThreePhaseButtonMorph initialize"
- | extent inset |
- extent := 12 at 12.
- inset := 3.
-
- #('CheckBoxOff' 'CheckBoxOn' 'CheckBoxPressed') do: [:button |
- | f r |
- f := ColorForm extent: extent depth: 1.
- f colors: {Color transparent. Color black}.
- f borderWidth: 1.
- r := f boundingBox insetBy: inset.
- button = 'CheckBoxPressed' ifTrue: [f border: r width: 1].
- button = 'CheckBoxOn' ifTrue: [f fillBlack: r].
- ScriptingSystem saveForm: f atKey: button].
-
- #('RadioButtonOff' 'RadioButtonOn' 'RadioButtonPressed') do: [:button |
- | f r c |
- f := ColorForm extent: extent depth: 1.
- f colors: {Color transparent. Color black}.
- r := f boundingBox.
- c := f getCanvas.
- c frameOval: r color: Color black.
- r := r insetBy: inset.
- button = 'RadioButtonPressed' ifTrue:
- [c frameOval: r color: Color black].
- button = 'RadioButtonOn' ifTrue:
- [c fillOval: r color: Color black].
- ScriptingSystem saveForm: f atKey: button]!
Item was removed:
- ----- Method: ThreePhaseButtonMorph class>>radioButton (in category 'instance creation') -----
- radioButton
- "Answer a button pre-initialized with radiobutton images."
- | f |
- ^self new
- onImage: (f := (MenuIcons radioButtonOn dyed: Color black) scaleIconToDisplay);
- pressedImage: (MenuIcons radioButtonPressed dyed: Color black) scaleIconToDisplay;
- offImage: (MenuIcons radioButtonOff dyed: Color black) scaleIconToDisplay;
- extent: f extent + (2 at 0);
- setDefaultParameters;
- yourself
- !
Item was removed:
- ----- Method: ThreePhaseButtonMorph class>>themeProperties (in category 'preferences') -----
- themeProperties
-
- ^ super themeProperties, {
- { #color. 'Colors'. 'Color of the button.' }.
- { #font. 'Fonts'. 'Font for button title.' }.
- { #textColor. 'Colors'. 'Color for the button title label.' }.
- }!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>actWhen: (in category 'submorphs - add/remove') -----
- actWhen: condition
- "Accepts symbols: #buttonDown, #buttonUp, and #whilePressed"
- actWhen := condition!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>actionSelector (in category 'accessing') -----
- actionSelector
-
- ^ actionSelector
- !
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>actionSelector: (in category 'accessing') -----
- actionSelector: aSymbolOrString
-
- (nil = aSymbolOrString or:
- ['nil' = aSymbolOrString or:
- [aSymbolOrString isEmpty]])
- ifTrue: [^ actionSelector := nil].
-
- actionSelector := aSymbolOrString asSymbol.
- !
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>applyUserInterfaceTheme (in category 'updating') -----
- applyUserInterfaceTheme
-
- super applyUserInterfaceTheme.
- self setDefaultParameters.!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>arguments (in category 'accessing') -----
- arguments
- ^ arguments!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>arguments: (in category 'accessing') -----
- arguments: aCollection
-
- arguments := aCollection asArray copy.
- !
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>color: (in category 'accessing') -----
- color: c
-
- self onImage ifNotNil: [:form |
- self onImage: ((form asFormOfDepth: 32) collectColors: [:col | c alpha: col alpha])].
- self offImage ifNotNil: [:form |
- self offImage: ((form asFormOfDepth: 32) collectColors: [:col | c alpha: col alpha])].
- self pressedImage ifNotNil: [:form |
- self pressedImage: ((form asFormOfDepth: 32) collectColors: [:col | c alpha: col alpha])].
-
- ^ super color: c!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>currentImage (in category 'accessing') -----
- currentImage
-
- state == #off ifTrue: [^ offImage].
- state == #pressed ifTrue: [^ pressedImage].
- state == #on ifTrue: [^ image].
- ^ image!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>doButtonAction (in category 'button') -----
- doButtonAction
- "Perform the action of this button. Subclasses may override this method. The default behavior is to send the button's actionSelector to its target object with its arguments."
-
- | args |
- (target notNil and: [actionSelector notNil]) ifTrue: [
- args := actionSelector numArgs > arguments size
- ifTrue: [arguments copyWith: self currentEvent]
- ifFalse: [arguments].
- Cursor normal showWhile: [
- target perform: actionSelector withArguments: args].
- target isMorph ifTrue: [target changed]].!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>doButtonAction: (in category 'event handling') -----
- doButtonAction: evt
-
- "Perform the action of this button. Subclasses may override this method. The default behavior is to send the button's actionSelector to its target object with its arguments."
-
- target ifNil: [^self].
- actionSelector ifNil: [^self].
- Cursor normal showWhile: [ | moreArgs |
- moreArgs := actionSelector numArgs > arguments size ifTrue: [
- arguments copyWith: evt
- ] ifFalse: [
- arguments
- ].
- target perform: actionSelector withArguments: moreArgs
- ]!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- | imageToUse |
-
- imageToUse := self currentImage.
-
- imageToUse ifNotNil: [aCanvas translucentImage: imageToUse at: bounds origin].
-
- self label ifNotNil: [:lbl |
- aCanvas
- drawString: lbl
- at: bounds origin + (imageToUse ifNil: [0 at 0] ifNotNil: [:form | (form width @ 0) + (3 at 0)])
- font: self font
- color: self textColor].!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>extent: (in category 'geometry') -----
- extent: aPoint
- "Do it normally"
-
- self changed.
- bounds := bounds topLeft extent: aPoint.
- self layoutChanged.
- self changed.
- !
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>font (in category 'accessing') -----
- font
- ^ font ifNil: [TextStyle defaultFont]!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>font: (in category 'accessing') -----
- font: aFont
- font := aFont.
- super extent: self preferredExtent.!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: evt
-
- ^ true
- !
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>handlesMouseStillDown: (in category 'event handling') -----
- handlesMouseStillDown: evt
- ^actWhen == #whilePressed!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>initialize (in category 'initialization') -----
- initialize
- super initialize.
- state := #off.
- target := nil.
- actionSelector := #flash.
- arguments := Array empty.
- actWhen := #buttonUp
-
- "self on: #mouseStillDown send: #dragIfAuthoring: to: self."
- "real move should include a call on dragIfAuthoring: "!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>isButton (in category 'classification') -----
- isButton
-
- ^ true
- !
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>isOn (in category 'testing') -----
- isOn
- ^ state == #on!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>label (in category 'accessing') -----
- label
- ^ label!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>label: (in category 'accessing') -----
- label: aString
- label := aString.
- super extent: self preferredExtent.!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>mouseDown: (in category 'event handling') -----
- mouseDown: evt
- | now dt |
- actWhen == #buttonDown
- ifTrue: [self doButtonAction].
- actWhen == #buttonUp
- ifTrue: [self state: #pressed].
- actWhen == #whilePressed
- ifTrue:
- [self state: #pressed.
- now := Time millisecondClockValue.
- "Allow on:send:to: to set the response to events other than actWhen"
- dt := Time millisecondClockValue - now max: 0. "Time it took to do"
- "NOTE: this delay is temporary disabled because it makes event reaction delay,
- e.g. the action is not stopped even if you release the button... - Takashi"
- [dt < 200 ifTrue: [(Delay forMilliseconds: 200-dt) wait]].
- self mouseStillDown: evt].
- super mouseDown: evt!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>mouseMove: (in category 'event handling') -----
- mouseMove: evt
- (#(#buttonUp #whilePressed ) includes: actWhen)
- ifTrue: [(self containsPoint: evt cursorPoint)
- ifTrue: [self state: #pressed]
- ifFalse: [self state: #off]].
- super mouseMove: evt!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>mouseStillDown: (in category 'event handling') -----
- mouseStillDown: evt
- actWhen == #whilePressed ifFalse:[^self].
- (self containsPoint: evt cursorPoint) ifTrue:[self doButtonAction].!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>mouseUp: (in category 'event handling') -----
- mouseUp: evt
- "Allow on:send:to: to set the response to events other than actWhen"
- actWhen == #buttonDown
- ifTrue: [super mouseUp: evt].
- actWhen == #buttonUp
- ifTrue: [(self containsPoint: evt cursorPoint)
- ifTrue: [self state: #on.
- self doButtonAction: evt.
- super mouseUp: evt]
- ifFalse: [self state: #off.
- target
- ifNotNil: ["Allow owner to keep it selected for radio
- buttons"
- target mouseUpBalk: evt]]].
- actWhen == #whilePressed
- ifTrue: [self state: #off.
- super mouseUp: evt]!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>offImage (in category 'accessing') -----
- offImage
- ^ offImage!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>offImage: (in category 'accessing') -----
- offImage: aForm
- offImage := aForm.
- self invalidRect: self bounds.!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>onImage (in category 'accessing') -----
- onImage
- ^ image!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>onImage: (in category 'accessing') -----
- onImage: aForm
- image := aForm.
- self invalidRect: self bounds.!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>preferredExtent (in category 'accessing') -----
- preferredExtent
-
- | iw ih lw lh |
- self currentImage ifNil: [^ 1 at 1].
- iw := self currentImage width.
- ih := self currentImage height.
- lw := self font widthOfString: (self label ifNil: ['']).
- lh := self font height.
- ^ (iw + 3 + lw) @ (ih max: lh)!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>pressedImage (in category 'accessing') -----
- pressedImage
- ^ pressedImage!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>pressedImage: (in category 'accessing') -----
- pressedImage: aForm
- pressedImage := aForm.
- self invalidRect: self bounds.!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>printOn: (in category 'printing') -----
- printOn: aStream
- | string |
- aStream nextPutAll: '3PButton'.
- arguments notEmpty
- ifTrue: [string := arguments at: (2 min: arguments size)].
- aStream nextPutAll: '('.
- (string notNil and: [string ~~ self])
- ifTrue:
- [aStream
- print: string;
- space]
- ifFalse:
- [aStream
- print: actionSelector;
- space].
- aStream
- print: self identityHash;
- nextPutAll: ')'!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>setDefaultParameters (in category 'initialization') -----
- setDefaultParameters
-
- self
- color: (self userInterfaceTheme color ifNil: [Color black]);
- font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]);
- textColor: (self userInterfaceTheme textColor ifNil: [Color black]).!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>state: (in category 'accessing') -----
- state: newState
- "Change the image and invalidate the rect."
-
- newState == state ifTrue: [^ self].
- state := newState.
- self invalidRect: bounds. "All three images must be the same size"!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>step (in category 'stepping and presenter') -----
- step
- (self hasProperty: #doesButtonAction) ifTrue:[
- self doButtonAction.
- self setProperty: #didButtonAction toValue: true.
- ].!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>stepTime (in category 'stepping and presenter') -----
- stepTime
- (self hasProperty: #doesButtonAction) ifTrue:[^1].
- ^super stepTime!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>target (in category 'accessing') -----
- target
-
- ^ target
- !
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>target: (in category 'accessing') -----
- target: anObject
-
- target := anObject
- !
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>textColor (in category 'accessing') -----
- textColor
- ^ textColor ifNil: [Color black]!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>textColor: (in category 'accessing') -----
- textColor: aColor
- textColor := aColor.!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>veryDeepFixupWith: (in category 'copying') -----
- veryDeepFixupWith: deepCopier
- "If target and arguments fields were weakly copied, fix them here. If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"
-
- super veryDeepFixupWith: deepCopier.
- target := deepCopier references at: target ifAbsent: [target].
- arguments := arguments collect: [:each |
- deepCopier references at: each ifAbsent: [each]].
- !
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>veryDeepInner: (in category 'copying') -----
- veryDeepInner: deepCopier
- "Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment."
-
- super veryDeepInner: deepCopier.
- offImage := offImage veryDeepCopyWith: deepCopier.
- pressedImage := pressedImage veryDeepCopyWith: deepCopier.
- state := state veryDeepCopyWith: deepCopier.
- "target := target. Weakly copied"
- "actionSelector := actionSelector. Symbol"
- "arguments := arguments. Weakly copied"
- actWhen := actWhen. "Symbol"!
Item was removed:
- ----- Method: ThreePhaseButtonMorph>>wantsSteps (in category 'stepping and presenter') -----
- wantsSteps
- ^(self hasProperty: #doesButtonAction) or:[super wantsSteps]!
Item was removed:
- ImageMorph subclass: #ThumbnailImageMorph
- instanceVariableNames: 'imagePopupMorph desiredExtent isPopup'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Basic'!
-
- !ThumbnailImageMorph commentStamp: 'wiz 2/19/2006 18:10' prior: 0!
- A ThumbnailImageMorph is variant of Lex Spoon's CDScreenShotMorph. It displays a thumbnail of the image stored in imagePopupMorph. As a super class of PopupThumbnail morph it is meant to be a thumbnail w/o the popup action. Basicly it provides a scalable thumbnail with the usual morph event behaviors.
-
- A menu item allows for "photographing" any morph on the screen to become the subject of our images.
-
- Instance Variables
- imagePopupMorph: <anImageMorph>
- image: <aForm>
- desiredExtent <aPoint>
- isPopup <aBool>
- imagePopupMorph
- - an ImageMorph containing the full sized image.
- - it can be set from a morph image via the sight target menu item.
- image
- - holds the scaled thumbnail form of our imagePopupMorph image.
- desiredExtent
- - holds the desired extent that the thumbnail is expected to fit within.
- - it is guarded to be positive and non-zero.
- - it can be set by extent: so that the yellow halo handle works.
- isPopup
- - true when popup feature is on.
- - toggled from red halo menu
-
- Setting the size of the thumbnail works somewhat excentrically because the extent of the thumbnail depends both on the desiredExtent and the aspect ratio of the current popup image.
-
- With the popup feature off this morph can be picked up and dropped with the mouse.
- When the feature is on, a full sized snapshot will be seen when the mouse is pressed.
- Since the mouse can't be used for two things at once, moving the morph must be done with the grab halo or brown move halo.!
Item was removed:
- ----- Method: ThumbnailImageMorph class>>ofDisplay (in category 'examples') -----
- ofDisplay
- "ThumbnailImageMorph ofDisplay openInHand"
- ^self new initializeWithDisplay .!
Item was removed:
- ----- Method: ThumbnailImageMorph>>addCustomMenuItems:hand: (in category 'menu commands') -----
- addCustomMenuItems: aCustomMenu hand: aHandMorph
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- self addWorldTargetSightingItems: aCustomMenu hand: aHandMorph .
- self addPopupMenuItems: aCustomMenu hand: aHandMorph!
Item was removed:
- ----- Method: ThumbnailImageMorph>>addPopupMenuItems:hand: (in category 'menu commands') -----
- addPopupMenuItems: aCustomMenu hand: aHandMorph
- " Show and toggle the popUp boolean menu item."
-
- aCustomMenu addLine.
-
- aCustomMenu addUpdating: #popupFeatureString target: self
- selector: #togglePopupFeature argumentList: #() .
-
- !
Item was removed:
- ----- Method: ThumbnailImageMorph>>extent: (in category 'accessing') -----
- extent: anExtentPoint
- "Set the desired extetnt for the thumbnail. It is guarenteed to fit within the desired extent.
- The desitedExtent is guarded to prevent deviant forms from being attempted."
-
- self changed . "We might be bigger before we change."
- desiredExtent := anExtentPoint guarded.
- self newThumbnail: imagePopupMorph image .
- !
Item was removed:
- ----- Method: ThumbnailImageMorph>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: evt
- ^isPopup == true!
Item was removed:
- ----- Method: ThumbnailImageMorph>>initialize (in category 'initialization') -----
- initialize
- super initialize .
- desiredExtent := 90 asPoint.
- self newImage: DefaultForm!
Item was removed:
- ----- Method: ThumbnailImageMorph>>initializeWithDisplay (in category 'initialization') -----
- initializeWithDisplay
- super initialize .
- desiredExtent := 90 asPoint.
- self newImage: Display!
Item was removed:
- ----- Method: ThumbnailImageMorph>>mouseDown: (in category 'event handling') -----
- mouseDown: evt
-
-
- imagePopupMorph center: (self localPointToGlobal: evt position).
- imagePopupMorph bounds: (imagePopupMorph bounds translatedAndSquishedToBeWithin: self world bounds).
- imagePopupMorph openInWorld
- !
Item was removed:
- ----- Method: ThumbnailImageMorph>>mouseUp: (in category 'event handling') -----
- mouseUp: evt
- imagePopupMorph ifNotNil: [
- imagePopupMorph delete .
- ]!
Item was removed:
- ----- Method: ThumbnailImageMorph>>newImage: (in category 'accessing') -----
- newImage: aForm
- "Use aForm as the new popupImage and update the thumbnail image."
-
- imagePopupMorph
- ifNil: [ imagePopupMorph := aForm asMorph]
- ifNotNil: [ imagePopupMorph image: aForm ] .
-
- self newThumbnail: aForm
-
- !
Item was removed:
- ----- Method: ThumbnailImageMorph>>newThumbnail: (in category 'accessing') -----
- newThumbnail: aForm
- "Use aForm as the new popupImage and update the thumbnail image."
- | scale thumbForm border smoothing |
-
- scale := aForm extent scaleTo: desiredExtent .
- smoothing := (scale x < 1.0 or: [ scale y < 1.0 ]) ifTrue: [ 2 ] ifFalse: [ 1 ] .
-
- thumbForm := aForm magnify: aForm boundingBox by: scale smoothing: smoothing .
-
- self image: thumbForm . "heres where we put in a thumbnail"
- "We need the following to keep the border the right size. Otherwise it will shrink."
- (border := self borderStyle) == BorderStyle default ifFalse: [ self borderStyle: border ] .
-
- "We have changed clear the old and show the new"
- self invalidRect: self bounds . !
Item was removed:
- ----- Method: ThumbnailImageMorph>>popupFeatureString (in category 'accessing') -----
- popupFeatureString
- "Answer the string to be shown in a menu to represent the
- stickiness status"
- ^ (self yesNoStringFor: (isPopup == true ) )
- , 'Popup feature' translated!
Item was removed:
- ----- Method: ThumbnailImageMorph>>target: (in category 'accessing') -----
- target: aMorph
- "Snap aMorphs current image and show its thumbnail"
-
- self newImage: aMorph imageForm fixAlpha .
- !
Item was removed:
- ----- Method: ThumbnailImageMorph>>togglePopupFeature (in category 'accessing') -----
- togglePopupFeature
- "Change the popup behaviour. Return the new boolean value."
-
- ^isPopup := isPopup ~~ true .
- !
Item was removed:
- ----- Method: ThumbnailImageMorph>>yesNoStringFor: (in category 'accessing') -----
- yesNoStringFor: aBool
- "Answer the string to be shown in a menu to represent the
- yes/no status"
- ^ (aBool
- ifTrue: ['<yes>']
- ifFalse: ['<no>'])
- !
Item was removed:
- BorderGripMorph subclass: #TopGripMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
Item was removed:
- ----- Method: TopGripMorph>>apply: (in category 'target resize') -----
- apply: delta
- | oldBounds |
- oldBounds := self target bounds.
- self target
- bounds: (oldBounds origin + (0 @ delta y) corner: oldBounds corner).
- self flag: #workaround. "mt: Due to a layout-specific 'let us start in the top-left corner of a layout cell'-behavior, we have to go up the owner chain and propagate the delta. See Morph >> #layoutInBounds:positioning: and there section 1.2."
- self target allOwnersDo:
- [:anOwner |
- (anOwner layoutPolicy notNil and: [anOwner ~~ Project current world])
- ifTrue: [anOwner top: anOwner top + delta y]].!
Item was removed:
- ----- Method: TopGripMorph>>defaultHeight (in category 'initialize') -----
- defaultHeight
-
- ^ self class gripThickness!
Item was removed:
- ----- Method: TopGripMorph>>gripLayoutFrame (in category 'accessing') -----
- gripLayoutFrame
- ^ LayoutFrame
- fractions: (0 @ 0 corner: 1 @ 0)
- offsets: (0 @ 0 corner: 0@ 0)!
Item was removed:
- ----- Method: TopGripMorph>>initialize (in category 'initialize') -----
- initialize
- super initialize.
- self hResizing: #spaceFill.!
Item was removed:
- ----- Method: TopGripMorph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
- layoutProportionallyInBounds: layoutBounds positioning: cellPositioning
-
- super layoutProportionallyInBounds: layoutBounds positioning: cellPositioning.
-
- self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
- self top: owner top.!
Item was removed:
- ----- Method: TopGripMorph>>orientation (in category 'accessing') -----
- orientation
-
- ^ #horizontal!
Item was removed:
- ----- Method: TopGripMorph>>ptName (in category 'accessing') -----
- ptName
- ^#top!
Item was removed:
- ----- Method: TopGripMorph>>resizeCursor (in category 'accessing') -----
- resizeCursor
-
- ^ Cursor resizeForEdge: #top!
Item was removed:
- CornerGripMorph subclass: #TopLeftGripMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
-
- !TopLeftGripMorph commentStamp: 'jmv 1/29/2006 17:18' prior: 0!
- I am the handle in the left top of windows used for resizing them.!
Item was removed:
- ----- Method: TopLeftGripMorph>>apply: (in category 'target resize') -----
- apply: delta
- | oldBounds |
- oldBounds := self target bounds.
- self target
- bounds: (oldBounds origin + delta corner: oldBounds corner).
- self flag: #workaround. "mt: Due to a layout-specific 'let us start in the top-left corner of a layout cell'-behavior, we have to go up the owner chain and propagate the delta. See Morph >> #layoutInBounds:positioning: and there section 1.2."
- self target allOwnersDo:
- [:anOwner |
- (anOwner layoutPolicy notNil and: [anOwner ~~ Project current world])
- ifTrue: [anOwner topLeft: anOwner topLeft + delta]].!
Item was removed:
- ----- Method: TopLeftGripMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- super drawOn: aCanvas.
-
- self showHandle ifTrue: [
- aCanvas
- fillRoundRect: ((self topLeft + self handleInset asPoint extent: self class gripThickness @ self height) insetBy: self handleInset)
- radius: 3
- fillStyle: (SolidFillStyle color: self handleColor).
- aCanvas
- fillRoundRect: ((self topLeft + self handleInset asPoint extent: self width @ self class gripThickness) insetBy: self handleInset)
- radius: 3
- fillStyle: (SolidFillStyle color: self handleColor).
-
-
- ].!
Item was removed:
- ----- Method: TopLeftGripMorph>>gripLayoutFrame (in category 'accessing') -----
- gripLayoutFrame
- ^ LayoutFrame
- fractions: (0 @ 0 corner: 0 @ 0)
- offsets: (0 @ 0 corner: 0 @ 0)!
Item was removed:
- ----- Method: TopLeftGripMorph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
- layoutProportionallyInBounds: layoutBounds positioning: cellPositioning
-
- self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
- self topLeft: owner topLeft.!
Item was removed:
- ----- Method: TopLeftGripMorph>>ptName (in category 'accessing') -----
- ptName
- ^#topLeft!
Item was removed:
- ----- Method: TopLeftGripMorph>>resizeCursor (in category 'accessing') -----
- resizeCursor
-
- ^ Cursor resizeForEdge: #topLeft!
Item was removed:
- CornerGripMorph subclass: #TopRightGripMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
-
- !TopRightGripMorph commentStamp: 'jmv 1/29/2006 17:18' prior: 0!
- I am the handle in the right top of windows used for resizing them.!
Item was removed:
- ----- Method: TopRightGripMorph>>apply: (in category 'target resize') -----
- apply: delta
- | oldBounds |
- oldBounds := self target bounds.
- self target
- bounds: (oldBounds origin + (0 at delta y) corner: oldBounds corner + (delta x @ 0)).
- self flag: #workaround. "mt: Due to a layout-specific 'let us start in the top-left corner of a layout cell'-behavior, we have to go up the owner chain and propagate the delta. See Morph >> #layoutInBounds:positioning: and there section 1.2."
- self target allOwnersDo:
- [:anOwner |
- (anOwner layoutPolicy notNil and: [anOwner ~~ Project current world])
- ifTrue: [anOwner top: anOwner top + delta y]].!
Item was removed:
- ----- Method: TopRightGripMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- super drawOn: aCanvas.
-
- self showHandle ifTrue: [
- aCanvas
- fillRoundRect: ((self topRight + ((self handleInset negated + self class gripThickness negated) @ self handleInset) extent: self class gripThickness @ self height) insetBy: self handleInset)
- radius: 3
- fillStyle: (SolidFillStyle color: self handleColor).
- aCanvas
- fillRoundRect: ((self topLeft + (self handleInset negated @ self handleInset) extent: self width @ self class gripThickness) insetBy: self handleInset)
- radius: 3
- fillStyle: (SolidFillStyle color: self handleColor).]!
Item was removed:
- ----- Method: TopRightGripMorph>>gripLayoutFrame (in category 'accessing') -----
- gripLayoutFrame
- ^ LayoutFrame
- fractions: (1 @ 0 corner: 1 @ 0)
- offsets: (0 @ 0 corner: 0 @ 0)!
Item was removed:
- ----- Method: TopRightGripMorph>>layoutProportionallyInBounds:positioning: (in category 'layout') -----
- layoutProportionallyInBounds: layoutBounds positioning: cellPositioning
-
- self flag: #workaround. "mt: We cannot know that our owner has always the correct new bounds at this time."
- self topRight: owner topRight.!
Item was removed:
- ----- Method: TopRightGripMorph>>ptName (in category 'accessing') -----
- ptName
- ^#topRight!
Item was removed:
- ----- Method: TopRightGripMorph>>resizeCursor (in category 'accessing') -----
- resizeCursor
-
- ^ Cursor resizeForEdge: #topRight!
Item was removed:
- ----- Method: Transcripter>>morphicDisplayText (in category '*Morphic') -----
- morphicDisplayText
- para compose: self contents asText
- style: TextStyle default
- from: 1
- in: frame.
- Display
- fill: (frame insetBy: -2) fillColor: self black;
- fill: frame fillColor: self white.
- Display getCanvas
- paragraph: para
- bounds: (4 at 4 + frame topLeft extent: Display extent)
- color: Color black!
Item was removed:
- ----- Method: Transcripter>>morphicInitializeParagraph: (in category '*Morphic') -----
- morphicInitializeParagraph: classParagraph
- para := classParagraph new.
- para compose: self contents asText
- style: TextStyle default
- from: 1
- in: frame
- !
Item was removed:
- Morph subclass: #TransferMorph
- instanceVariableNames: 'transferType passenger draggedMorph source copy'
- classVariableNames: 'CopyPlusIcon'
- poolDictionaries: ''
- category: 'Morphic-Support'!
-
- !TransferMorph commentStamp: 'nk 6/16/2003 16:52' prior: 0!
- This is a Morph that is used to visually indicate the progress of a drag operation, and also as a container for various bits of drag state information.
-
- It polls the shift state in its step method to update its copy state (shift pressed = should copy).
-
- And if you hit the Escape key while dragging, it aborts the drag operation.!
Item was removed:
- ----- Method: TransferMorph class>>initIcons (in category 'class initialization') -----
- initIcons
- "TransferMorph initIcons"
-
- CopyPlusIcon := Form
- extent: 16 at 16
- depth: 8
- fromArray: #( 0 0 65535 0 0 0 16768220 4278190080 0 0 16768220 4278190080 0 255 4294958300 4294967040 0 65500 3705461980 3705462015 0 65500 3705461980 3705462015 0 255 4294958300 4294967295 0 0 16768220 4278190080 0 0 16768220 4278190080 0 0 65535 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
- offset: 0 at 0!
Item was removed:
- ----- Method: TransferMorph class>>initialize (in category 'class initialization') -----
- initialize
- "TransferMorph initialize"
-
- self initIcons!
Item was removed:
- ----- Method: TransferMorph class>>withPassenger: (in category 'instance creation') -----
- withPassenger: anObject
-
- ^ self
- withPassenger: anObject
- from: nil!
Item was removed:
- ----- Method: TransferMorph class>>withPassenger:from: (in category 'instance creation') -----
- withPassenger: anObject from: source
-
- ^ self new
- passenger: anObject;
- source: source;
- yourself!
Item was removed:
- ----- Method: TransferMorph>>aboutToBeGrabbedBy: (in category 'dropping/grabbing') -----
- aboutToBeGrabbedBy: aHand
- "The receiver is being grabbed by a hand.
- Perform necessary adjustments (if any) and return the actual morph
- that should be added to the hand."
- "Since this morph has been initialized automatically with bounds origin
- 0 at 0, we have to move it to aHand position."
- super aboutToBeGrabbedBy: aHand.
-
- self align: self fullBounds topLeft with: aHand position + (aHand extent // 3).
- aHand newKeyboardFocus: self.!
Item was removed:
- ----- Method: TransferMorph>>animationForMoveSuccess: (in category 'private') -----
- animationForMoveSuccess: success
- | start stop slideForm |
- success
- ifTrue: [^ self]
- ifFalse:
- [start := self fullBounds origin.
- stop := self source bounds origin].
- start = stop ifTrue: [^ self].
- slideForm := self imageFormForRectangle: ((self fullBounds origin corner: self fullBounds corner + self activeHand shadowOffset)
- merge: self activeHand bounds).
- slideForm offset: 0 @ 0.
- slideForm
- slideWithFirstFrom: start
- to: stop
- nSteps: 12
- delay: 20!
Item was removed:
- ----- Method: TransferMorph>>applyUserInterfaceTheme (in category 'updating') -----
- applyUserInterfaceTheme
-
- super applyUserInterfaceTheme.
- self setDefaultParameters.!
Item was removed:
- ----- Method: TransferMorph>>createDraggableMorph: (in category 'initialization') -----
- createDraggableMorph: anObject
-
- (anObject respondsTo: #asDraggableMorph)
- ifTrue: [^ anObject asDraggableMorph].
-
- anObject isMorph
- ifTrue: ["Huge or complex morphs have a serious impact on performance while being dragged. Use the thumbnail version."
- ^ anObject thumbnail asMorph].
-
- anObject isText
- ifTrue: [
- ^ anObject copy
- addAttribute: (TextFontReference toFont: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]));
- asMorph].
-
- ^ ((anObject respondsTo: #dragLabel) ifTrue: [anObject dragLabel] ifFalse: [anObject printString]) asMorph
- color: (self userInterfaceTheme textColor ifNil: [Color black]);
- font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont])
- yourself
- !
Item was removed:
- ----- Method: TransferMorph>>doCopy (in category 'event handling') -----
- doCopy
-
- copy := true.
- self updateCopyIcon.!
Item was removed:
- ----- Method: TransferMorph>>doMove (in category 'event handling') -----
- doMove
-
- copy := false.
- self updateCopyIcon.!
Item was removed:
- ----- Method: TransferMorph>>dragTransferType (in category 'accessing') -----
- dragTransferType
- ^transferType!
Item was removed:
- ----- Method: TransferMorph>>dragTransferType: (in category 'accessing') -----
- dragTransferType: aSymbol
- transferType := aSymbol!
Item was removed:
- ----- Method: TransferMorph>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
-
- self
- changeTableLayout;
- disableLayout: true;
- listDirection: #leftToRight;
- hResizing: #shrinkWrap;
- vResizing: #shrinkWrap;
- layoutInset: 3;
- cellGap: 3;
- wrapCentering: #center;
- cellPositioning: #leftCenter;
- setProperty: #indicateKeyboardFocus toValue: #never.
-
- self doMove.
-
- self on: #keyStroke send: #keyStroke: to: self.
- self on: #keyUp send: #updateFromUserInputEvent: to: self.
- self on: #keyDown send: #updateFromUserInputEvent: to: self.
-
- self setDefaultParameters.!
Item was removed:
- ----- Method: TransferMorph>>isTransferMorph (in category 'testing') -----
- isTransferMorph
-
- ^ true!
Item was removed:
- ----- Method: TransferMorph>>justDroppedInto:event: (in category 'dropping/grabbing') -----
- justDroppedInto: targetMorph event: anEvent
- "If only world wants this TransferMorph, treat it as unaccepted (see also >>delete)."
- super
- justDroppedInto: targetMorph
- event: anEvent.
- self animationForMoveSuccess: true.
- self delete!
Item was removed:
- ----- Method: TransferMorph>>keyStroke: (in category 'event handling') -----
- keyStroke: evt
- "Abort the drag on an escape"
-
- evt keyCharacter = Character escape ifTrue: [self delete].!
Item was removed:
- ----- Method: TransferMorph>>morphToDropInPasteUp: (in category 'dropping/grabbing') -----
- morphToDropInPasteUp: aPasteUpMorph
- ^ aPasteUpMorph morphToDropForTransferMorph: self!
Item was removed:
- ----- Method: TransferMorph>>passenger (in category 'accessing') -----
- passenger
- ^passenger!
Item was removed:
- ----- Method: TransferMorph>>passenger: (in category 'accessing') -----
- passenger: anObject
-
- passenger := anObject.
-
- self
- removeAllMorphs;
- addMorph: (self createDraggableMorph: passenger);
- updateCopyIcon;
- setDefaultParameters.!
Item was removed:
- ----- Method: TransferMorph>>setDefaultParameters (in category 'initialization') -----
- setDefaultParameters
-
- self
- borderWidth: ((self userInterfaceTheme borderWidth ifNil: [1]) * RealEstateAgent scaleFactor) truncated;
- borderColor: (self userInterfaceTheme borderColor ifNil: [Color r: 0.46 g: 0.46 b: 0.353]);
- color: (self userInterfaceTheme color ifNil: [Color r: 0.92 g: 0.92 b: 0.706]);
- cornerStyle: (MenuMorph roundedMenuCorners ifTrue: [#rounded] ifFalse: [#square]).
-
- self updateGradient.!
Item was removed:
- ----- Method: TransferMorph>>shouldCopy (in category 'accessing') -----
- shouldCopy
- ^copy!
Item was removed:
- ----- Method: TransferMorph>>shouldMove (in category 'accessing') -----
- shouldMove
- ^ self shouldCopy not!
Item was removed:
- ----- Method: TransferMorph>>source (in category 'accessing') -----
- source
- ^source!
Item was removed:
- ----- Method: TransferMorph>>source: (in category 'accessing') -----
- source: anObject
- source := anObject!
Item was removed:
- ----- Method: TransferMorph>>undoGrabCommand (in category 'dropping/grabbing') -----
- undoGrabCommand
- ^nil!
Item was removed:
- ----- Method: TransferMorph>>updateCopyIcon (in category 'private') -----
- updateCopyIcon
-
- (self submorphNamed: #tmCopyIcon)
- ifNil: [self shouldCopy ifTrue: [
- self addMorphFront: (ImageMorph new image: CopyPlusIcon; name: #tmCopyIcon; yourself)]]
- ifNotNil: [:copyIcon | self shouldCopy ifFalse: [
- copyIcon delete]]!
Item was removed:
- ----- Method: TransferMorph>>updateFromUserInputEvent: (in category 'event handling') -----
- updateFromUserInputEvent: evt
-
- evt shiftPressed
- ifTrue: [self doCopy]
- ifFalse: [self doMove].!
Item was removed:
- ----- Method: TransferMorph>>updateGradient (in category 'updating') -----
- updateGradient
-
- | cc fill |
-
- MenuMorph gradientMenu ifFalse: [^ self].
-
- self fullBounds.
-
- cc := self color.
- fill := GradientFillStyle ramp: {
- 0.0 -> Color white.
- 0.10 -> (cc mixed: 0.5 with: Color white).
- 0.5 -> cc.
- 0.8 -> cc twiceDarker}.
- fill
- origin: self topLeft;
- direction: 0 at self height.
- self fillStyle: fill.!
Item was removed:
- ----- Method: TransferMorph>>wantsToBeDroppedInto: (in category 'dropping/grabbing') -----
- wantsToBeDroppedInto: aMorph
-
- ^ aMorph isWorldMorph
- ifTrue: [aMorph wantsDroppedTransferMorph: self]
- ifFalse: [super wantsToBeDroppedInto: aMorph]!
Item was removed:
- Morph subclass: #TransformMorph
- instanceVariableNames: 'transform smoothing localBounds'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Basic'!
-
- !TransformMorph commentStamp: 'wiz 11/6/2005 15:59' prior: 0!
- A TransformMorph introduces a 2-D transformation between its (global) coordinates and the (local) coordinates of its submorphs, while also clipping all display to its bounds. Specifically, with no offset, angle or scaling, a submorph with coordinates (0 at 0) will appear exactly at the topLeft of the windowMorph (its position). Rotation and scaling are relative to the local origin, (0 at 0).
-
- instance var type description
- transform MorphicTransform The coordinate transform between my coordinates and the
- local coordinates of my submorphs.
- smoothing anInteger in 1..3 Perform smoothing of my contents during drawing
- 1 No smoothing (#smoothingOff)
- 2 Smoothing w/ edge adjacent pixels (#smoothingOn)
- 3 Smoothing w/ edge and corner adj pixels
-
- localBounds Rectangle or nil caches the value of #localSubmorphBounds for performance
-
- TransformMorphs operate with two different display strategies, depending on whether the transformation is a pure translation or not. If so, then they simply use a clipping canvas and display their submorphs with the appropriate offset. If the transformation includes scaling or rotation, then a caching canvas is used, whose active area covers the fullBounds of the submorphs intersected with the source quadrilateral corresponding to the window bounds.!
Item was removed:
- ----- Method: TransformMorph>>addCustomMenuItems:hand: (in category 'menu') -----
- addCustomMenuItems: aCustomMenu hand: aHandMorph
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- smoothing = 1
- ifTrue: [aCustomMenu add: 'turn on smoothing' translated action: #smoothingOn]
- ifFalse: [aCustomMenu add: 'turn off smoothing' translated action: #smoothingOff]!
Item was removed:
- ----- Method: TransformMorph>>angle (in category 'accessing') -----
- angle
- ^ transform angle!
Item was removed:
- ----- Method: TransformMorph>>angle: (in category 'accessing') -----
- angle: newAngle
-
- self changed.
- transform := transform withAngle: newAngle.
- self layoutChanged.
- self changed!
Item was removed:
- ----- Method: TransformMorph>>colorForInsets (in category 'accessing') -----
- colorForInsets
- ^ owner ifNil: [color] ifNotNil: [owner color]!
Item was removed:
- ----- Method: TransformMorph>>containsPoint: (in category 'geometry testing') -----
- containsPoint: aPoint
- (bounds containsPoint: aPoint) ifFalse: [^ false].
- self hasSubmorphs
- ifTrue: [ | localPoint | localPoint := (transform globalPointToLocal: aPoint) .
- self submorphsDo:
- [:m | (m containsPoint: localPoint)
- ifTrue: [^ true]].
- ^ false]
- ifFalse: [^ true]!
Item was removed:
- ----- Method: TransformMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color lightGreen!
Item was removed:
- ----- Method: TransformMorph>>drawSubmorphsOn: (in category 'drawing') -----
- drawSubmorphsOn: aCanvas
-
- aCanvas transformBy: transform
- clippingTo: self innerBounds
- during: [:myCanvas |
- (self angle ~= 0.0 or: [self scale ~= 1.0])
- ifTrue:[
- AbstractFont forceNonSubPixelDuring:[
- submorphs reverseDo:[:m | myCanvas fullDrawMorph: m] ] ]
- ifFalse:[
- submorphs reverseDo:[:m | myCanvas fullDrawMorph: m] ] ]
- smoothing: smoothing!
Item was removed:
- ----- Method: TransformMorph>>grabTransform (in category 'dropping/grabbing') -----
- grabTransform
- "Return the transform for the receiver which should be applied during grabbing"
- ^owner ifNil:[self transform] ifNotNil:[owner grabTransform composedWithLocal: self transform]!
Item was removed:
- ----- Method: TransformMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
-
- smoothing := 1.
- transform := MorphicTransform identity.
- self clipSubmorphs: true.!
Item was removed:
- ----- Method: TransformMorph>>innocuousName (in category 'naming') -----
- innocuousName
-
- | r |
- ^ (r := self renderedMorph) == self
- ifTrue: [super innocuousName]
- ifFalse: [r innocuousName]!
Item was removed:
- ----- Method: TransformMorph>>invalidRect:from: (in category 'change reporting') -----
- invalidRect: damageRect from: aMorph
- "Translate damage reports from submorphs by the scrollOffset."
- aMorph == self
- ifTrue:[super invalidRect: damageRect from: self]
- ifFalse:[super invalidRect: (((transform localBoundsToGlobal: damageRect) intersect: bounds) expanded) from: self].!
Item was removed:
- ----- Method: TransformMorph>>isRenderer (in category 'classification') -----
- isRenderer
-
- ^ submorphs size = 1
- !
Item was removed:
- ----- Method: TransformMorph>>layoutBounds (in category 'layout') -----
- layoutBounds
- "Ignore scaling and offset but move to local origin for my children as reference point. Note that we do not have to adapt #submorphBoundsForShrinkWrap because those are already in local coordinates. See #adjustLayoutBounds and #setLayoutBoundsFromLayout:"
-
- ^ super layoutBounds translateBy: self topLeft negated!
Item was removed:
- ----- Method: TransformMorph>>layoutChanged (in category 'layout') -----
- layoutChanged
-
- "A submorph could have moved, thus changing my localBounds. Invalidate the cache."
- localBounds := nil.
- super layoutChanged.!
Item was removed:
- ----- Method: TransformMorph>>localSubmorphBounds (in category 'geometry') -----
- localSubmorphBounds
- "Answer, in my coordinate system, the bounds of all my submorphs (or nil if no submorphs). We will cache this value for performance. The value is invalidated upon recieving #layoutChanged."
-
- ^ localBounds ifNil: [localBounds := super submorphBounds]!
Item was removed:
- ----- Method: TransformMorph>>morphicLayerNumber (in category 'submorphs - layers') -----
- morphicLayerNumber
-
- ^ self isRenderer
- ifTrue: [self renderedMorph morphicLayerNumber]
- ifFalse: [super morphicLayerNumber]
- !
Item was removed:
- ----- Method: TransformMorph>>morphicLayerNumber: (in category 'submorphs - layers') -----
- morphicLayerNumber: aNumber
-
- ^ self hasSubmorphs
- ifFalse: [super morphicLayerNumber: aNumber]
- ifTrue: [self firstSubmorph morphicLayerNumber: aNumber]!
Item was removed:
- ----- Method: TransformMorph>>numberOfItemsInView (in category 'geometry') -----
- numberOfItemsInView
- "Answer the number of my submorphs whose (transformed) bounds intersect mine.
- This includes items that are only partially visible.
- Ignore visibility of submorphs."
-
- ^(submorphs select: [ :ea | self innerBounds intersects: (transform localBoundsToGlobal: ea bounds) ]) size!
Item was removed:
- ----- Method: TransformMorph>>numberOfItemsPotentiallyInView (in category 'geometry') -----
- numberOfItemsPotentiallyInView
- "Answer the number of items that could potentially be viewed in full,
- computed as my visible height divided by the average height of my submorphs.
- Ignore visibility of submorphs."
-
- ^ self localSubmorphBounds
- ifNil: [0]
- ifNotNil: [:lsBounds |
- self innerBounds height // (lsBounds height / submorphs size)]!
Item was removed:
- ----- Method: TransformMorph>>numberOfItemsPotentiallyInViewWith: (in category 'geometry') -----
- numberOfItemsPotentiallyInViewWith: submorphCount
- "Answer the number of items that could potentially be viewed in full,
- computed as my visible height divided by the average height of my submorphs.
- Ignore visibility of submorphs."
-
- ^ self localSubmorphBounds
- ifNil: [0]
- ifNotNil: [:lsBounds |
- self innerBounds height // (lsBounds height / submorphCount)]!
Item was removed:
- ----- Method: TransformMorph>>offset (in category 'accessing') -----
- offset
- ^ transform offset + self innerBounds topLeft!
Item was removed:
- ----- Method: TransformMorph>>offset: (in category 'accessing') -----
- offset: newOffset
-
- self offset = newOffset ifTrue: [^ self].
- transform := transform withOffset: newOffset - self innerBounds topLeft.
- self changed.!
Item was removed:
- ----- Method: TransformMorph>>privateFullMoveBy: (in category 'private') -----
- privateFullMoveBy: delta
- "Private!! Relocate me, but not my subMorphs."
-
- self privateMoveBy: delta.
- transform := (transform asMorphicTransform) withOffset: (transform offset - delta).
- !
Item was removed:
- ----- Method: TransformMorph>>renderedMorph (in category 'classification') -----
- renderedMorph
- "We are a renderer. Answer appropriately."
-
- ^ self isRenderer
- ifTrue: [self firstSubmorph renderedMorph]
- ifFalse: [super renderedMorph]!
Item was removed:
- ----- Method: TransformMorph>>scale (in category 'accessing') -----
- scale
- ^ transform scale!
Item was removed:
- ----- Method: TransformMorph>>scale: (in category 'accessing') -----
- scale: newScale
-
- self changed.
- transform := transform withScale: newScale.
- self layoutChanged.
- self changed.
- !
Item was removed:
- ----- Method: TransformMorph>>setOffset:angle:scale: (in category 'accessing') -----
- setOffset: newOffset angle: newAngle scale: newScale
-
- transform := MorphicTransform offset: newOffset angle: newAngle scale: newScale.
- self changed!
Item was removed:
- ----- Method: TransformMorph>>smoothing (in category 'accessing') -----
- smoothing
- ^smoothing
- !
Item was removed:
- ----- Method: TransformMorph>>smoothing: (in category 'accessing') -----
- smoothing: cellSize
- smoothing := cellSize.
- self changed!
Item was removed:
- ----- Method: TransformMorph>>smoothingOff (in category 'accessing') -----
- smoothingOff
- smoothing := 1.
- self changed!
Item was removed:
- ----- Method: TransformMorph>>smoothingOn (in category 'accessing') -----
- smoothingOn
- smoothing := 2.
- self changed!
Item was removed:
- ----- Method: TransformMorph>>submorphBounds (in category 'layout') -----
- submorphBounds
- "Answer, in owner coordinates, the bounds of my visible submorphs, or my bounds"
- | box |
- box := self localSubmorphBounds.
- ^(box ifNotNil: [ transform localBoundsToGlobal: box ] ifNil: [ self bounds ]) truncated.
- !
Item was removed:
- ----- Method: TransformMorph>>transform (in category 'accessing') -----
- transform
- ^transform!
Item was removed:
- ----- Method: TransformMorph>>transform: (in category 'accessing') -----
- transform: aTransform
- transform := aTransform.!
Item was removed:
- ----- Method: TransformMorph>>transformFrom: (in category 'event handling') -----
- transformFrom: uberMorph
- "Return a transform to map coorinates of uberMorph, a morph above me in my owner chain, into the coordinates of my submorphs."
-
- (self == uberMorph or: [owner isNil]) ifTrue: [^transform].
- ^(owner transformFrom: uberMorph) composedWithLocal: transform!
Item was removed:
- ----- Method: TransformMorph>>wantsHaloFromClick (in category 'halos and balloon help') -----
- wantsHaloFromClick
-
- ^ self hasSubmorphs not!
Item was removed:
- TransformMorph subclass: #TransformationMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Basic'!
-
- !TransformationMorph commentStamp: 'mk 8/16/2005 11:58' prior: 0!
- A TransformationMorph is like a transformMorph, except that it does not clip, and its bounds include its entire submorph. TransformationMorphs are assumed to have only one submorph -- the idea is that it is a wrapper that enables its submorph to scale and rotate. A TMorph may come to have more than one submorph if, eg, a menu sprouts a sub menu, using the transformationMorph temporarily as its world, but this ability is only sparsely supported (as in layoutChanged).
-
- See TransformationMorph class example1 method.!
Item was removed:
- ----- Method: TransformationMorph class>>example1 (in category 'example') -----
- example1
- | stringMorph transformationMorph |
- stringMorph := 'vertical text' asMorph.
- transformationMorph := TransformationMorph new asFlexOf: stringMorph.
- transformationMorph angle: Float pi / 2.
- transformationMorph position: 5 at 5.
- transformationMorph openInWorld.!
Item was removed:
- ----- Method: TransformationMorph>>addFlexShellIfNecessary (in category 'rotate scale and flex') -----
- addFlexShellIfNecessary
- "I already am a flex shell."!
Item was removed:
- ----- Method: TransformationMorph>>adjustAfter: (in category 'private') -----
- adjustAfter: changeBlock
- "Cause this morph to remain cetered where it was before, and
- choose appropriate smoothing, after a change of scale or rotation."
- | oldRefPos |
- oldRefPos := self referencePosition.
- changeBlock value.
- self chooseSmoothing.
- self penUpWhile: [self position: self position + (oldRefPos - self referencePosition)].
- self layoutChanged.
- owner ifNotNil: [owner invalidRect: bounds]
- !
Item was removed:
- ----- Method: TransformationMorph>>asFlexOf: (in category 'initialization') -----
- asFlexOf: aMorph
- "Initialize me with position and bounds of aMorph,
- and with an offset that provides centered rotation."
- | pos |
- pos := aMorph position.
- self addMorph: aMorph.
- aMorph position: (aMorph extent // 2) negated.
- self position: pos.
- transform := transform withOffset: aMorph position - pos
- !
Item was removed:
- ----- Method: TransformationMorph>>chooseSmoothing (in category 'private') -----
- chooseSmoothing
- "Choose appropriate smoothing, after a change of scale or rotation."
-
- smoothing := (self scale < 1.0 or: [self angle ~= (self angle roundTo: Float pi / 2.0)])
- ifTrue: [ 2]
- ifFalse: [1]!
Item was removed:
- ----- Method: TransformationMorph>>computeBounds (in category 'geometry') -----
- computeBounds
- self hasSubmorphs ifTrue:
- [bounds := (transform localBoundsToGlobal:
- (Rectangle merging:
- (self submorphs collect: [:m | m fullBounds]))) truncated
- expandBy: 1].
- fullBounds := bounds.!
Item was removed:
- ----- Method: TransformationMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- submorphs isEmpty ifTrue: [super drawOn: aCanvas]!
Item was removed:
- ----- Method: TransformationMorph>>extent: (in category 'geometry') -----
- extent: newExtent
-
- self renderedMorph == self
- ifTrue: [super extent: newExtent]
- ifFalse: [
- self adjustAfter: [
- | scaleFactor |
- scaleFactor := (self scale * newExtent r / self fullBounds extent r) max: 0.1.
- self scale: (scaleFactor detentBy: 0.1 atMultiplesOf: 1.0 snap: false)]].!
Item was removed:
- ----- Method: TransformationMorph>>flexing:byTransformation: (in category 'initialization') -----
- flexing: aMorph byTransformation: tfm
- "Initialize me with position and bounds of aMorph,
- and with an offset that provides centered rotation."
-
- (aMorph isKindOf: TransformationMorph)
- ifTrue: [aMorph submorphsDo: [:m | self addMorph: m shallowCopy]]
- ifFalse: [self addMorph: aMorph].
- transform := tfm.
- self chooseSmoothing.
- self layoutChanged.!
Item was removed:
- ----- Method: TransformationMorph>>forwardDirection (in category 'rotate scale and flex') -----
- forwardDirection
- "Return the rendee's forward direction.
- If I have no rendee then return 0.0 degrees "
- | rendee |
- ( rendee := self renderedMorph) == self ifTrue: [ ^ 0.0 ] .
-
- ^ rendee forwardDirection!
Item was removed:
- ----- Method: TransformationMorph>>forwardDirection: (in category 'rotate scale and flex') -----
- forwardDirection: degrees
- "If we have a rendee set its forward direction. Else do nothing."
-
- | rendee |
- ( rendee := self renderedMorph) == self ifTrue: [ ^ self ] .
- ^rendee forwardDirection: degrees!
Item was removed:
- ----- Method: TransformationMorph>>grabTransform (in category 'dropping/grabbing') -----
- grabTransform
- "Return the transform for the receiver which should be applied during grabbing"
- self renderedMorph isWorldMorph
- ifTrue:[^owner ifNil:[IdentityTransform new] ifNotNil:[owner grabTransform]].
- ^owner ifNil:[self transform] ifNotNil:[owner grabTransform composedWithLocal: self transform]!
Item was removed:
- ----- Method: TransformationMorph>>hasNoScaleOrRotation (in category 'accessing') -----
- hasNoScaleOrRotation
-
- ^ transform isPureTranslation
- !
Item was removed:
- ----- Method: TransformationMorph>>heading (in category 'rotate scale and flex') -----
- heading
- "End recusion when necessary."
- | rendee |
- (rendee := self renderedMorph) == self ifTrue: [ ^0.0 ] .
- ^ rendee heading!
Item was removed:
- ----- Method: TransformationMorph>>heading: (in category 'rotate scale and flex') -----
- heading: newHeading
- "If we have a rendee set its heading. Else do nothing."
-
- | rendee |
- ( rendee := self renderedMorph) == self ifTrue: [ ^ self ] .
- ^rendee heading: newHeading!
Item was removed:
- ----- Method: TransformationMorph>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
-
- self
- color: ((Color gray: 0.7) alpha: 0.5);
- borderStyle: (DashedBorder color: (Color gray: 0.4) width: 1).!
Item was removed:
- ----- Method: TransformationMorph>>isFlexMorph (in category 'classification') -----
- isFlexMorph
-
- ^ true
- !
Item was removed:
- ----- Method: TransformationMorph>>isSticky (in category 'testing') -----
- isSticky
- submorphs isEmpty ifFalse: [ ^ submorphs first isSticky ] .
-
- ^false!
Item was removed:
- ----- Method: TransformationMorph>>layoutChanged (in category 'layout') -----
- layoutChanged
- "Recompute bounds as a result of change"
- self computeBounds.
- super layoutChanged!
Item was removed:
- ----- Method: TransformationMorph>>printOn: (in category 'printing') -----
- printOn: aStream
- super printOn: aStream.
- submorphs isEmpty
- ifTrue: [aStream nextPutAll: ' with no transformee!!']
- ifFalse: [aStream nextPutAll: ' on ' , submorphs first printString]!
Item was removed:
- ----- Method: TransformationMorph>>referencePosition (in category 'rotate scale and flex') -----
- referencePosition
- "Answer the receiver's reference position, bullet-proofed against infinite recursion in the unlikely but occasionally-seen case that I am my own renderee"
-
- | rendered |
- ^ (rendered := self renderedMorph) == self
- ifTrue:
- [super referencePosition]
- ifFalse:
- [transform localPointToGlobal: rendered referencePosition]!
Item was removed:
- ----- Method: TransformationMorph>>removeFlexShell (in category 'menu') -----
- removeFlexShell
- "Remove the shell used to make a morph rotatable and scalable."
-
- | oldHalo unflexed pensDown myWorld refPos aPosition |
- self isInWorld ifFalse: [^self].
- refPos := self referencePosition.
- myWorld := self world.
- oldHalo := self halo.
- submorphs isEmpty ifTrue: [^ self delete].
- aPosition := (owner submorphIndexOf: self) ifNil: [1].
- unflexed := self firstSubmorph.
- pensDown := OrderedCollection new.
- self allMorphsDo: "Note any pens down -- must not be down during the move"
- [:m | | player |
- ((player := m player) notNil and: [player getPenDown]) ifTrue:
- [m == player costume ifTrue:
- [pensDown add: player.
- player setPenDown: false]]].
- self submorphs do: [:m |
- m position: self center - (m extent // 2).
- owner addMorph: m asElementNumber: aPosition].
- unflexed absorbStateFromRenderer: self.
- pensDown do: [:p | p setPenDown: true].
- oldHalo ifNotNil: [oldHalo setTarget: unflexed].
- myWorld ifNotNil: [myWorld startSteppingSubmorphsOf: unflexed].
- self delete.
- unflexed referencePosition: refPos.
- ^ unflexed!
Item was removed:
- ----- Method: TransformationMorph>>replaceSubmorph:by: (in category 'submorphs - add/remove') -----
- replaceSubmorph: oldMorph by: newMorph
- | t b |
- t := transform.
- b := bounds.
- super replaceSubmorph: oldMorph by: newMorph.
- transform := t.
- bounds := b.
- self layoutChanged!
Item was removed:
- ----- Method: TransformationMorph>>rotationDegrees (in category 'rotate scale and flex') -----
- rotationDegrees
- "Overwritten because we can directly inform about the rotation."
-
- ^ self angle radiansToDegrees negated!
Item was removed:
- ----- Method: TransformationMorph>>rotationDegrees: (in category 'rotate scale and flex') -----
- rotationDegrees: degrees
- "Overwritten because we know how to rotate our submorphs."
-
- self adjustAfter:[self angle: degrees degreesToRadians negated]!
Item was removed:
- ----- Method: TransformationMorph>>scaleFactor (in category 'accessing') -----
- scaleFactor
- "Answer the scaleFactor"
-
- ^ transform scale!
Item was removed:
- ----- Method: TransformationMorph>>scaleToMatch: (in category 'accessing') -----
- scaleToMatch: aPoint
- | scaleFactor tfm originalScale |
- tfm := transform withScale: 1.0.
- originalScale := ((tfm localBoundsToGlobal: self renderedMorph fullBounds)
- corner - (tfm localPointToGlobal: self renderedMorph referencePosition))
- r.
- "Catch cases where the reference point is on fullBounds corner"
- originalScale := originalScale max: 1.0.
- scaleFactor := (aPoint - self referencePosition) r / originalScale.
- scaleFactor := scaleFactor < 1.0
- ifTrue:
- [scaleFactor
- detentBy: 0.05
- atMultiplesOf: 0.25
- snap: false]
- ifFalse:
- [scaleFactor
- detentBy: 0.1
- atMultiplesOf: 0.5
- snap: false].
- self adjustAfter: [self scale: ((scaleFactor min: 8.0) max: 0.1)]!
Item was removed:
- ----- Method: TransformationMorph>>setDirectionFrom: (in category 'rotate scale and flex') -----
- setDirectionFrom: aPoint
- | delta degrees inner |
- inner := self renderedMorph.
- inner == self ifTrue:[^self].
- delta := (inner transformFromWorld globalPointToLocal: aPoint) - inner referencePosition.
- degrees := delta degrees + 90.0.
- self forwardDirection: (degrees \\ 360) rounded.
- !
Item was removed:
- ----- Method: TransformationMorph>>shouldDropOnMouseUp (in category 'dropping/grabbing') -----
- shouldDropOnMouseUp
-
- ^ self renderedMorph in: [:target |
- target == self
- ifTrue: [super shouldDropOnMouseUp]
- ifFalse: [target shouldDropOnMouseUp]]!
Item was removed:
- ----- Method: TransformationMorph>>simplySetVisible: (in category 'geometry eToy') -----
- simplySetVisible: aBoolean
- "Set the receiver's visibility property. This mild circumlocution is because my own #visible: method would also set the visibility flag of my flexee, which in this case is pointless because it's the flexee that calls this."
-
- super visible: aBoolean!
Item was removed:
- ----- Method: TransformationMorph>>stepTime (in category 'stepping and presenter') -----
- stepTime
- "Answer the stepTime of my rendered morph if posible"
-
- | rendered |
- rendered := self renderedMorph.
- rendered = self ifTrue: [^super stepTime]. "Hack to avoid infinite recursion"
- ^rendered stepTime.
- !
Item was removed:
- ----- Method: TransformationMorph>>transformedBy: (in category 'geometry') -----
- transformedBy: aTransform
- self changed.
- self transform: (self transform composedWithGlobal: aTransform).
- self computeBounds.
- self changed.!
Item was removed:
- ----- Method: TransformationMorph>>visible: (in category 'geometry eToy') -----
- visible: aBoolean
- "Set the receiver's visibility property"
-
- super visible: aBoolean.
- submorphs isEmptyOrNil ifFalse: [submorphs first visible: aBoolean]!
Item was removed:
- Morph subclass: #TranslucentProgessMorph
- instanceVariableNames: 'opaqueBackgroundColor'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
Item was removed:
- ----- Method: TranslucentProgessMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
-
- | revealPercentage revealingStyle revealingColor revealingBounds revealToggle x baseColor revealTimes secondsRemaining stringToDraw where fontToUse innerBounds |
-
- innerBounds := bounds.
- opaqueBackgroundColor ifNotNil: [
- aCanvas
- frameAndFillRectangle: bounds
- fillColor: opaqueBackgroundColor
- borderWidth: 8
- borderColor: Color blue.
- innerBounds := innerBounds insetBy: 8.
- ].
- revealTimes := (self valueOfProperty: #revealTimes) ifNil: [^self].
- revealPercentage := (revealTimes first / revealTimes second) asFloat.
- revealingStyle := self revealingStyle.
- x := self valueOfProperty: #progressStageNumber ifAbsent: [1].
- baseColor := Color perform: (#(red blue green magenta cyan yellow) atPin: x).
- revealingColor := baseColor alpha: 0.2.
- revealingStyle = 3 ifTrue: [ "wrap and change color"
- revealPercentage > 1.0 ifTrue: [
- revealingColor := baseColor alpha: (0.2 + (revealingStyle / 10) min: 0.5).
- ].
- revealPercentage := revealPercentage fractionPart.
- ].
- revealingStyle = 2 ifTrue: [ "peg at 75 and blink"
- revealPercentage > 0.75 ifTrue: [
- revealToggle := self valueOfProperty: #revealToggle ifAbsent: [true].
- self setProperty: #revealToggle toValue: revealToggle not.
- revealToggle ifTrue: [revealingColor := baseColor alpha: 0.8.].
- ].
- revealPercentage := revealPercentage min: 0.75.
- ].
- revealingBounds := innerBounds withLeft: innerBounds left + (innerBounds width * revealPercentage) truncated.
- aCanvas
- fillRectangle: revealingBounds
- color: revealingColor.
- secondsRemaining := (revealTimes second - revealTimes first / 1000) rounded.
- secondsRemaining > 0 ifTrue: [
- fontToUse := StrikeFont familyName: Preferences standardEToysFont familyName size: 24.
- stringToDraw := secondsRemaining printString.
- where := innerBounds corner - ((fontToUse widthOfString: stringToDraw) @ fontToUse height).
- aCanvas
- drawString: stringToDraw
- in: (where corner: innerBounds corner)
- font: fontToUse
- color: Color black.
- aCanvas
- drawString: stringToDraw
- in: (where - (1 at 1) corner: innerBounds corner)
- font: fontToUse
- color: Color white.
- ].
-
-
- !
Item was removed:
- ----- Method: TranslucentProgessMorph>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
- self morphicLayerNumber: self class progressLayer. !
Item was removed:
- ----- Method: TranslucentProgessMorph>>opaqueBackgroundColor: (in category 'accessing') -----
- opaqueBackgroundColor: aColor
-
- opaqueBackgroundColor := aColor!
Item was removed:
- ----- Method: TranslucentProgessMorph>>revealingStyle (in category 'accessing') -----
- revealingStyle
-
- ">>>>
- 1 = original, no change after 100%
- 2 = hold at last 25% and blink until done
- 3 = wrap around from 100% back to 0 and go again. change color after first
- <<<<"
- ^3
- !
Item was removed:
- MenuItemMorph subclass: #UpdatingMenuItemMorph
- instanceVariableNames: 'wordingProvider wordingSelector enablementSelector wordingArgument'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Menus'!
-
- !UpdatingMenuItemMorph commentStamp: '<historical>' prior: 0!
- A menu item whose textual label and whose enablement are updatable. The wordingProvider provides the current wording, upon being being sent the wordingSelector.
-
- The item can also dynamically update whether or not it should be enabled; to do this, give it an enablementSelector, which is also sent to the wordingProvider..!
Item was removed:
- ----- Method: UpdatingMenuItemMorph>>arrangeToStartSteppingIn: (in category 'stepping and presenter') -----
- arrangeToStartSteppingIn: aWorld
- super arrangeToStartSteppingIn: aWorld.
- self updateContents.!
Item was removed:
- ----- Method: UpdatingMenuItemMorph>>decorateOwner (in category 'world') -----
- decorateOwner
-
- MenuIcons decorateMenu: owner.!
Item was removed:
- ----- Method: UpdatingMenuItemMorph>>enablement (in category 'enablement') -----
- enablement
-
- enablementSelector isBlock
- ifTrue: [^ enablementSelector value]
- ifFalse: [enablementSelector numArgs = 0
- ifTrue: [^ wordingProvider perform: enablementSelector]
- ifFalse: [^ wordingProvider perform: enablementSelector
- withArguments: arguments]]!
Item was removed:
- ----- Method: UpdatingMenuItemMorph>>enablementSelector: (in category 'enablement') -----
- enablementSelector: aSelector
- enablementSelector := aSelector isBlock
- ifTrue: [aSelector copyForSaving]
- ifFalse: [aSelector] !
Item was removed:
- ----- Method: UpdatingMenuItemMorph>>step (in category 'stepping and presenter') -----
- step
- super step.
- self updateContents.!
Item was removed:
- ----- Method: UpdatingMenuItemMorph>>stepTime (in category 'stepping and presenter') -----
- stepTime
- ^ 1200!
Item was removed:
- ----- Method: UpdatingMenuItemMorph>>target: (in category 'wording') -----
- target: anObject
- "For us if the old target and wording provider are the same update both."
- target = wordingProvider
- ifTrue: [ wordingProvider := target := anObject ]
- ifFalse: [ target := anObject ] .
- !
Item was removed:
- ----- Method: UpdatingMenuItemMorph>>updateContents (in category 'world') -----
- updateContents
- "Update the receiver's contents"
-
- | newString enablement nArgs |
- ((wordingProvider isNil) or: [wordingSelector isNil]) ifFalse: [
- nArgs := wordingSelector numArgs.
- newString := nArgs = 0
- ifTrue:
- [wordingProvider perform: wordingSelector]
- ifFalse:
- [(nArgs = 1 and: [wordingArgument notNil])
- ifTrue:
- [wordingProvider perform: wordingSelector with: wordingArgument]
- ifFalse:
- [nArgs == arguments size ifTrue:
- [wordingProvider perform: wordingSelector withArguments: arguments]]].
- newString = (self contentString ifNil: [ contents ])
- ifFalse: [self contents: newString.
- self decorateOwner ]].
- enablementSelector ifNotNil:
- [(enablement := self enablement) == isEnabled
- ifFalse: [self isEnabled: enablement]]!
Item was removed:
- ----- Method: UpdatingMenuItemMorph>>wordingArgument: (in category 'wording') -----
- wordingArgument: anArgument
- "Set the receiver's wordingArgument as indicated"
-
- wordingArgument := anArgument!
Item was removed:
- ----- Method: UpdatingMenuItemMorph>>wordingProvider:wordingSelector: (in category 'wording') -----
- wordingProvider: aProvider wordingSelector: aSelector
- wordingProvider := aProvider.
- wordingSelector := aSelector!
Item was removed:
- MenuMorph subclass: #UpdatingMenuMorph
- instanceVariableNames: 'menuUpdater'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Menus'!
Item was removed:
- ----- Method: UpdatingMenuMorph>>activate: (in category 'events') -----
- activate: evt
- "Receiver should be activated; e.g., so that control passes correctly."
-
- self updateMenu.
- super activate: evt!
Item was removed:
- ----- Method: UpdatingMenuMorph>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
- menuUpdater := MenuUpdater new!
Item was removed:
- ----- Method: UpdatingMenuMorph>>updateMenu (in category 'update') -----
- updateMenu
-
- menuUpdater update: self!
Item was removed:
- ----- Method: UpdatingMenuMorph>>updater:updateSelector: (in category 'initialization') -----
- updater: anObject updateSelector: aSelector
-
- menuUpdater updater: anObject updateSelector: aSelector!
Item was removed:
- ----- Method: UpdatingMenuMorph>>updater:updateSelector:arguments: (in category 'initialization') -----
- updater: anObject updateSelector: aSelector arguments: anArray
-
- menuUpdater updater: anObject updateSelector: aSelector arguments: anArray!
Item was removed:
- SimpleButtonMorph subclass: #UpdatingSimpleButtonMorph
- instanceVariableNames: 'wordingProvider wordingSelector'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !UpdatingSimpleButtonMorph commentStamp: '<historical>' prior: 0!
- Adds to SimpleButtonMorph the ability to keep its own wording up to date by send a given message (indicated by its wordingSelector) to a given object (indicated by its wordingTarget, and normally the same as its target.)!
Item was removed:
- ----- Method: UpdatingSimpleButtonMorph>>step (in category 'stepping and presenter') -----
- step
- "If appropriate update the receiver's label"
-
- | newString |
- super step.
- wordingProvider ifNotNil:
- [newString := wordingProvider perform: wordingSelector.
- newString = self label ifFalse: [self labelString: newString; changed]]!
Item was removed:
- ----- Method: UpdatingSimpleButtonMorph>>stepTime (in category 'stepping and presenter') -----
- stepTime
- "Answer the desired time between steps in milliseconds. If the receiver has a wordingProvider that may dynamically provide changed wording for the label, step once every 1.5 seconds"
-
- ^ wordingProvider ifNotNil: [1500] ifNil: [super stepTime]!
Item was removed:
- ----- Method: UpdatingSimpleButtonMorph>>wantsSteps (in category 'stepping and presenter') -----
- wantsSteps
- "Answer whether the receiver wishes to be sent the #step message. In the current case, this decision depends on whether there is a wordingProvider which can dynamically provide fresh wording for the button's label"
-
- ^ wordingProvider notNil!
Item was removed:
- ----- Method: UpdatingSimpleButtonMorph>>wordingSelector: (in category 'accessing') -----
- wordingSelector: aSelector
- wordingSelector := aSelector.
- wordingProvider ifNil: [wordingProvider := target]!
Item was removed:
- StringMorph subclass: #UpdatingStringMorph
- instanceVariableNames: 'format target lastValue getSelector putSelector floatPrecision growable stepTime autoAcceptOnFocusLoss minimumWidth maximumWidth'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
-
- !UpdatingStringMorph commentStamp: '<historical>' prior: 0!
- A StringMorph that constantly tries to show the current data from the target object. When sent #step, it shows what the target objects has (target perform: getSelector). When edited (with shift-click), it writes back to the target.
-
- floatPrecision = 1. to round to integer.
- floatPrecision = .1 to round to 1 decimal place, etc.
-
- Even when ((target == nil) or: [getSelector == nil]), the user would still like to edit the string with shift-click.!
Item was removed:
- ----- Method: UpdatingStringMorph class>>on:selector: (in category 'instance creation') -----
- on: targetObject selector: aSymbol
-
- ^ self new
- getSelector: aSymbol;
- target: targetObject
-
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>acceptContents (in category 'editing') -----
- acceptContents
-
- self informTarget.
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>acceptValue: (in category 'editing') -----
- acceptValue: aValue
-
- self updateContentsFrom: (self acceptValueFromTarget: aValue).
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>acceptValueFromTarget: (in category 'target access') -----
- acceptValueFromTarget: v
- "Accept a value from the target"
-
- lastValue := v.
- self format == #string ifTrue: [^ v asString].
- self format == #symbol ifTrue: [^ v asString translated].
- (format == #default and: [v isNumber]) ifTrue:
- [^ self stringForNumericValue: v].
- ^ v printString translated!
Item was removed:
- ----- Method: UpdatingStringMorph>>addCustomMenuItems:hand: (in category 'editing') -----
- addCustomMenuItems: menu hand: aHandMorph
- | prefix |
- super addCustomMenuItems: menu hand: aHandMorph.
- prefix := (self growable
- ifTrue: ['stop being growable']
- ifFalse: ['start being growable']) translated.
- menu add: prefix action: #toggleGrowability.
- menu add: 'decimal places...' translated action: #setPrecision.
- menu add: 'font size...' translated action: #setFontSize.
- menu add: 'font style...' translated action: #setFontStyle!
Item was removed:
- ----- Method: UpdatingStringMorph>>autoAcceptOnFocusLoss (in category 'accessing') -----
- autoAcceptOnFocusLoss
- ^ autoAcceptOnFocusLoss ~~ false!
Item was removed:
- ----- Method: UpdatingStringMorph>>autoAcceptOnFocusLoss: (in category 'accessing') -----
- autoAcceptOnFocusLoss: aBoolean
- autoAcceptOnFocusLoss := aBoolean!
Item was removed:
- ----- Method: UpdatingStringMorph>>checkTarget (in category 'target access') -----
- checkTarget
- ""
- getSelector ifNil: [^ true].
- ^ getSelector numArgs = 0.
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>decimalPlaces (in category 'accessing') -----
- decimalPlaces
- "Answer the number of decimal places to show."
-
- | places |
- (places := self valueOfProperty: #decimalPlaces) ifNotNil: [^ places].
- self setProperty: #decimalPlaces toValue: (places := Utilities decimalPlacesForFloatPrecision: self floatPrecision).
- ^ places!
Item was removed:
- ----- Method: UpdatingStringMorph>>decimalPlaces: (in category 'accessing') -----
- decimalPlaces: aNumber
- "Set the receiver's number of decimal places to be shown. If my target is a morph or a player, tell it about the change, in case it wants to remember it."
-
- | constrained |
- self setProperty: #decimalPlaces toValue: (constrained := aNumber min: 11).
- self pvtFloatPrecision: (Utilities floatPrecisionForDecimalPlaces: constrained).
- (target isMorph or:[target isPlayer]) ifTrue:
- [target noteDecimalPlaces: constrained forGetter: getSelector]!
Item was removed:
- ----- Method: UpdatingStringMorph>>doneWithEdits (in category 'editing') -----
- doneWithEdits
- "If in a SyntaxMorph, shrink min width after editing"
-
- | editor |
- super doneWithEdits.
- (owner respondsTo: #parseNode) ifTrue: [minimumWidth := 8].
- editor := (submorphs detect: [ :sm | sm isKindOf: StringMorphEditor ] ifNone: [ ^self ]).
- editor delete.!
Item was removed:
- ----- Method: UpdatingStringMorph>>fitContents (in category 'layout') -----
- fitContents
- "Overridden to respect minimum and maximum widfth."
-
- | newExtent |
- newExtent := self measureContents.
- self extent: ((newExtent x max: self minimumWidth) min: self maximumWidth) @ newExtent y.!
Item was removed:
- ----- Method: UpdatingStringMorph>>floatPrecision (in category 'accessing') -----
- floatPrecision
- "Answer the floatPrecision to use:
- 1.0 -> show whole number
- 0.1 -> show one digit of precision
- .01 -> show two digits of precision
- etc.
- Initialize the floatPrecision to 1 if it is not already defined"
-
- floatPrecision isNumber ifFalse:
- [self target: target]. "Fixes up errant cases from earlier bug"
- ^ floatPrecision
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>format (in category 'accessing') -----
- format
- "Answer the receiver's format: #default or #string"
-
- ^ format ifNil: [format := #default]!
Item was removed:
- ----- Method: UpdatingStringMorph>>getSelector (in category 'accessing') -----
- getSelector
-
- ^ getSelector
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>getSelector: (in category 'accessing') -----
- getSelector: aSymbol
-
- getSelector := aSymbol.
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>growable (in category 'accessing') -----
- growable
-
- ^ growable ~~ false
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>growable: (in category 'accessing') -----
- growable: aBoolean
-
- growable := aBoolean.
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>handlerForMouseDown: (in category 'events-processing') -----
- handlerForMouseDown: evt
- "Answer an object to field the mouseDown event provided, or nil if none"
-
- | aHandler |
- aHandler := super handlerForMouseDown: evt.
- aHandler == self ifTrue: [^ self]. "I would get it anyways"
- "Note: This is a hack to allow value editing in viewers"
- ((owner wantsKeyboardFocusFor: self) and:
- [self userEditsAllowed]) ifTrue: [^ self].
- ^ aHandler!
Item was removed:
- ----- Method: UpdatingStringMorph>>handlesMouseDown: (in category 'event handling') -----
- handlesMouseDown: evt
- (owner wantsKeyboardFocusFor: self)
- ifTrue:[^true].
- ^ super handlesMouseDown: evt!
Item was removed:
- ----- Method: UpdatingStringMorph>>informTarget (in category 'target access') -----
- informTarget
- "Obtain a value from my contents, and tell my target about it. The putSelector can take one argument (traditional) or two (as used by Croquet)"
-
- | newValue typeIn |
- (target notNil and: [putSelector notNil])
- ifTrue:
- [typeIn := contents.
- (newValue := self valueFromContents) ifNotNil:
- [self checkTarget.
- putSelector numArgs = 1
- ifTrue: [target perform: putSelector with: newValue].
- putSelector numArgs = 2
- ifTrue:
- [target
- perform: putSelector
- with: newValue
- with: self].
- target isMorph ifTrue: [target changed]].
- self fitContents.
- (format == #default and: [newValue isNumber])
- ifTrue: [self setDecimalPlacesFromTypeIn: typeIn]]!
Item was removed:
- ----- Method: UpdatingStringMorph>>initialize (in category 'initialization') -----
- initialize
- "Initialize the receiver to have default values in its instance variables."
- super initialize.
- ""
- format := #default.
- "formats: #string, #default"
- target := getSelector := putSelector := nil.
- floatPrecision := 1.
- growable := true.
- stepTime := nil.
- autoAcceptOnFocusLoss := true.
- minimumWidth := 8.
- maximumWidth := 366!
Item was removed:
- ----- Method: UpdatingStringMorph>>isEtoyReadout (in category 'target access') -----
- isEtoyReadout
- "Answer whether the receiver can serve as an etoy readout"
-
- ^ true!
Item was removed:
- ----- Method: UpdatingStringMorph>>lostFocusWithoutAccepting (in category 'editing') -----
- lostFocusWithoutAccepting
- "The message is sent when the user, having been in an editing episode on the receiver, changes the keyboard focus -- typically by clicking on some editable text somewhere else -- without having accepted the current edits."
-
- self autoAcceptOnFocusLoss ifTrue: [self doneWithEdits; acceptContents]!
Item was removed:
- ----- Method: UpdatingStringMorph>>maximumWidth (in category 'accessing') -----
- maximumWidth
- "Answer the maximum width that the receiver can have. A nil value means no maximum, and for practical purposes results in a value of 99999 here temporarily, for help in future debugging"
-
- ^ maximumWidth ifNil: [99999]!
Item was removed:
- ----- Method: UpdatingStringMorph>>maximumWidth: (in category 'accessing') -----
- maximumWidth: aValue
- "Set the maximum width that the receiver can have."
-
- maximumWidth := aValue!
Item was removed:
- ----- Method: UpdatingStringMorph>>minWidth (in category 'accessing') -----
- minWidth
- "Answer the minimum width that the receiver can have. A nonzero value here keeps the receiver from degenerating into something that cannot ever be seen or touched again!! Obeyed by fitContents."
-
- ^ minimumWidth ifNil: [minimumWidth := 8]!
Item was removed:
- ----- Method: UpdatingStringMorph>>minWidth: (in category 'accessing') -----
- minWidth: aWidth
- "Set the minimum width that the receiver can have. A nonzero value here keeps the receiver from degenerating into something that cannot ever be seen or touched again!! Obeyed by fitContents."
-
- minimumWidth := aWidth!
Item was removed:
- ----- Method: UpdatingStringMorph>>mouseDown: (in category 'event handling') -----
- mouseDown: evt
- "The mouse went down over the receiver. If appropriate, launch a mini-editor so that the user can commence text-editing here"
-
- (owner wantsKeyboardFocusFor: self) ifTrue:
- [self userEditsAllowed ifTrue:
- [(owner respondsTo: #parseNode)
- ifTrue: "leave space for editing"
- [minimumWidth := (49 max: minimumWidth)].
- self launchMiniEditor: evt]]!
Item was removed:
- ----- Method: UpdatingStringMorph>>putSelector (in category 'accessing') -----
- putSelector
-
- ^ putSelector
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>putSelector: (in category 'accessing') -----
- putSelector: aSymbol
-
- putSelector := aSymbol.
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>pvtFloatPrecision: (in category 'accessing') -----
- pvtFloatPrecision: aNumber
- "Private - Set the floatPrecision instance variable to the given number"
-
- floatPrecision := aNumber!
Item was removed:
- ----- Method: UpdatingStringMorph>>readFromTarget (in category 'target access') -----
- readFromTarget
- "Update my readout from my target"
-
- | v ret places |
- (target isNil or: [getSelector isNil]) ifTrue: [^contents].
- ret := self checkTarget.
- ret ifFalse: [^ '0'].
- ((target isMorph) or:[target isPlayerLike]) ifTrue:[
- places := target decimalPlacesForGetter: getSelector.
- (places ~= nil and: [ places ~= (self valueOfProperty: #decimalPlaces ifAbsent: [0])]) ifTrue: [ self decimalPlaces: places ]].
- v := target perform: getSelector. "scriptPerformer"
- (v isKindOf: Text) ifTrue: [v := v asString].
- ^self acceptValueFromTarget: v!
Item was removed:
- ----- Method: UpdatingStringMorph>>setDecimalPlaces: (in category 'editing') -----
- setDecimalPlaces: places
- "Set the number of decimal places, and update the display."
-
- self decimalPlaces: places.
- self acceptValueFromTarget: lastValue!
Item was removed:
- ----- Method: UpdatingStringMorph>>setDecimalPlacesFromTypeIn: (in category 'target access') -----
- setDecimalPlacesFromTypeIn: typeIn
- "The user has typed in a number as the new value of the receiver. Glean off decimal-places-preference from the type-in"
-
- | decimalPointPosition tail places |
- (typeIn includes: $e) ifTrue: [^ self].
- decimalPointPosition := typeIn indexOf: $. ifAbsent: [nil].
- places := 0.
- decimalPointPosition
- ifNotNil:
- [tail := typeIn copyFrom: decimalPointPosition + 1 to: typeIn size.
- [places < tail size and: [(tail at: (places + 1)) isDigit]]
- whileTrue:
- [places := places + 1]].
-
- self decimalPlaces: places!
Item was removed:
- ----- Method: UpdatingStringMorph>>setFontSize (in category 'editing') -----
- setFontSize
- | sizes reply family |
- family := font ifNil: [TextStyle default] ifNotNil: [font textStyle].
- family ifNil: [family := TextStyle default]. "safety net -- this line SHOULD be unnecessary now"
- sizes := family fontNamesWithPointSizes.
- reply := UIManager default chooseFrom: sizes values: sizes.
- reply ifNotNil:
- [self font: (family fontAt: (sizes indexOf: reply))]!
Item was removed:
- ----- Method: UpdatingStringMorph>>setFontStyle (in category 'editing') -----
- setFontStyle
- | aList reply style |
- aList := (TextConstants select: [:anItem | anItem isKindOf: TextStyle])
- keys asArray.
- reply := UIManager default chooseFrom: aList values: aList.
- reply notNil
- ifTrue:
- [(style := TextStyle named: reply) ifNil:
- [Beeper beep.
- ^true].
- self font: style defaultFont]!
Item was removed:
- ----- Method: UpdatingStringMorph>>setPrecision (in category 'editing') -----
- setPrecision
- "Allow the user to specify a number of decimal places. This UI is invoked from a menu. Nowadays the precision can be set by simple type-in, making this menu approach mostly obsolete. However, it's still useful for read-only readouts, where type-in is not allowed."
-
- | aMenu |
- aMenu := MenuMorph new.
- aMenu addTitle: ('How many decimal places? (currently {1})' translated format: {self decimalPlaces}).
- 0 to: 10 do:
- [:places |
- aMenu add: places asString target: self selector: #setDecimalPlaces: argument: places].
- aMenu popUpInWorld!
Item was removed:
- ----- Method: UpdatingStringMorph>>setToAllowTextEdit (in category 'editing') -----
- setToAllowTextEdit
- "Set up the receiver so that it will be receptive to text editing, even if there is no putSelector provided"
-
- self setProperty: #okToTextEdit toValue: true!
Item was removed:
- ----- Method: UpdatingStringMorph>>step (in category 'stepping and presenter') -----
- step
- | s |
- super step.
- hasFocus ifFalse:
- ["update contents, but only if user isn't editing this string"
- s := self readFromTarget.
- s = contents ifFalse:
- [self updateContentsFrom: s]]
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>stepTime (in category 'stepping and presenter') -----
- stepTime
-
- ^ stepTime ifNil: [200]
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>stepTime: (in category 'stepping') -----
- stepTime: mSecsPerStep
-
- stepTime := mSecsPerStep truncated.
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>stringForNumericValue: (in category 'target access') -----
- stringForNumericValue: aValue
- "Answer a suitably-formatted string representing the value."
-
- | barePrintString |
- ((barePrintString := aValue printString) includes: $e) ifTrue: [^ barePrintString].
- ^ aValue printShowingDecimalPlaces: self decimalPlaces!
Item was removed:
- ----- Method: UpdatingStringMorph>>target (in category 'accessing') -----
- target
-
- ^ target
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>target: (in category 'accessing') -----
- target: anObject
-
- target := anObject.
- getSelector ifNotNil: [floatPrecision := anObject defaultFloatPrecisionFor: getSelector]
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>toggleGrowability (in category 'editing') -----
- toggleGrowability
- growable := self growable not.
- self updateContentsFrom: self readFromTarget.
- growable ifTrue: [self fitContents]!
Item was removed:
- ----- Method: UpdatingStringMorph>>updateContentsFrom: (in category 'stepping') -----
- updateContentsFrom: aValue
- self growable
- ifTrue:
- [self contentsFitted: aValue]
- ifFalse:
- [self contentsClipped: aValue]!
Item was removed:
- ----- Method: UpdatingStringMorph>>useDefaultFormat (in category 'formats') -----
- useDefaultFormat
- "Use the object's own printString format."
-
- format := #default.
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>useStringFormat (in category 'formats') -----
- useStringFormat
-
- format := #string.!
Item was removed:
- ----- Method: UpdatingStringMorph>>useSymbolFormat (in category 'formats') -----
- useSymbolFormat
-
- format := #symbol.!
Item was removed:
- ----- Method: UpdatingStringMorph>>userEditsAllowed (in category 'editing') -----
- userEditsAllowed
- "Answer whether user-edits are allowed to this field"
-
- ^ putSelector notNil or: [self hasProperty: #okToTextEdit]!
Item was removed:
- ----- Method: UpdatingStringMorph>>valueFromContents (in category 'accessing') -----
- valueFromContents
- "Return a new value from the current contents string."
-
- "
- | expression tilePadMorphOrNil asNumberBlock |
- asNumberBlock := [:string | [string asNumber]
- on: Error
- do: []].
- format = #string
- ifTrue: [^ contents].
- (format = #default
- and: [self owner isKindOf: NumericReadoutTile])
- ifTrue: [^ asNumberBlock value: contents].
- tilePadMorphOrNil := self ownerThatIsA: TilePadMorph.
- (tilePadMorphOrNil notNil
- and: [tilePadMorphOrNil type = #Number])
- ifTrue: [^ asNumberBlock value: contents].
- expression := Vocabulary eToyVocabulary translationKeyFor: contents.
- expression isNil
- ifTrue: [expression := contents].
- ^ Compiler evaluate: expression
- "
-
- format = #symbol ifTrue: [^ lastValue].
- format = #string ifTrue: [^ contents].
- (owner notNil and: [owner isNumericReadoutTile]) ifTrue: [
- ^ Number readFrom: contents
- ].
- target ifNotNil: [target owner ifNotNil: [
- ((target owner isTilePadMorph) and: [target owner type = #Number])
- ifTrue: [^ Number readFrom: contents]]].
- ^ Compiler evaluate: contents
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>veryDeepFixupWith: (in category 'copying') -----
- veryDeepFixupWith: deepCopier
- "If target field is weakly copied, fix it here. If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"
-
- super veryDeepFixupWith: deepCopier.
- target := deepCopier references at: target ifAbsent: [target].
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>veryDeepInner: (in category 'copying') -----
- veryDeepInner: deepCopier
- "Copy all of my instance variables. Some need to be not copied at all, but shared."
-
- super veryDeepInner: deepCopier.
- format := format veryDeepCopyWith: deepCopier.
- target := target. "Weakly copied"
- lastValue := lastValue veryDeepCopyWith: deepCopier.
- getSelector := getSelector. "Symbol"
- putSelector := putSelector. "Symbol"
- floatPrecision := floatPrecision veryDeepCopyWith: deepCopier.
- growable := growable veryDeepCopyWith: deepCopier.
- stepTime := stepTime veryDeepCopyWith: deepCopier.
- autoAcceptOnFocusLoss := autoAcceptOnFocusLoss veryDeepCopyWith: deepCopier.
- minimumWidth := minimumWidth veryDeepCopyWith: deepCopier.
- maximumWidth := maximumWidth veryDeepCopyWith: deepCopier.
- self setProperty: #decimalPlaces toValue: ((self valueOfProperty: #decimalPlaces ifAbsent: [0]) veryDeepCopyWith: deepCopier).
- !
Item was removed:
- ----- Method: UpdatingStringMorph>>wouldAcceptKeyboardFocus (in category 'event handling') -----
- wouldAcceptKeyboardFocus
- ^ (self hasProperty: #okToTextEdit) or: [super wouldAcceptKeyboardFocus]!
Item was removed:
- ThreePhaseButtonMorph subclass: #UpdatingThreePhaseButtonMorph
- instanceVariableNames: 'getSelector getArgument'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Widgets'!
Item was removed:
- ----- Method: UpdatingThreePhaseButtonMorph>>doButtonAction (in category 'button') -----
- doButtonAction
- "Since the action likely changes our state, do a step so we're updated immediately"
- super doButtonAction.
- self step
- !
Item was removed:
- ----- Method: UpdatingThreePhaseButtonMorph>>getSelector: (in category 'accessing') -----
- getSelector: sel
- getSelector := sel!
Item was removed:
- ----- Method: UpdatingThreePhaseButtonMorph>>mouseUp: (in category 'event handling') -----
- mouseUp: evt
- "Since mouseUp likely changes our state, do a step so we're updated immediately"
- super mouseUp: evt.
- self step!
Item was removed:
- ----- Method: UpdatingThreePhaseButtonMorph>>step (in category 'stepping and presenter') -----
- step
- | newBoolean |
- super step.
- state == #pressed ifTrue: [^ self].
- newBoolean := target perform: getSelector.
- newBoolean == self isOn
- ifFalse:
- [self state: (newBoolean == true ifTrue: [#on] ifFalse: [#off])]!
Item was removed:
- ----- Method: UpdatingThreePhaseButtonMorph>>wantsSteps (in category 'stepping and presenter') -----
- wantsSteps
- ^ true!
Item was removed:
- DialogWindow subclass: #UserDialogBoxMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
-
- !UserDialogBoxMorph commentStamp: 'ar 12/11/2009 22:33' prior: 0!
- A DialogBoxMorph is Morph used in simple yes/no/confirm dialogs. Strongly modal.!
Item was removed:
- ----- Method: UserDialogBoxMorph class>>confirm: (in category 'utilities') -----
- confirm: aString
- "UserDialogBoxMorph confirm: 'Do you like chocolate?'"
- ^self confirm: aString title: 'Please Confirm'!
Item was removed:
- ----- Method: UserDialogBoxMorph class>>confirm:orCancel: (in category 'utilities') -----
- confirm: aString orCancel: cancelBlock
- "UserDialogBoxMorph confirm: 'Do you like chocolate?'"
- ^self confirm: aString orCancel: cancelBlock at: nil!
Item was removed:
- ----- Method: UserDialogBoxMorph class>>confirm:orCancel:at: (in category 'utilities') -----
- confirm: aString orCancel: cancelBlock at: aPointOrNil
- ^self
- confirm: aString
- orCancel: cancelBlock
- title: 'Please Confirm'
- at: aPointOrNil!
Item was removed:
- ----- Method: UserDialogBoxMorph class>>confirm:orCancel:title:at: (in category 'utilities') -----
- confirm: aString orCancel: cancelBlock title: titleString at: aPointOrNil
-
- (self new
- title: titleString;
- message: aString;
- createButton: 'Yes' translated value: true;
- createButton: 'No' translated value: false;
- createButton: 'Cancel' translated value: nil;
- selectedButtonIndex: 1; "YES"
- registerKeyboardShortcuts;
- yourself) in: [:dialog |
- ^ (aPointOrNil
- ifNil: [dialog getUserResponseAtHand]
- ifNotNil: [
- dialog preferredPosition: aPointOrNil.
- dialog getUserResponse])
- ifNil: [ cancelBlock value ]]!
Item was removed:
- ----- Method: UserDialogBoxMorph class>>confirm:title: (in category 'utilities') -----
- confirm: aString title: titleString
- "UserDialogBoxMorph confirm: 'Make your choice carefully' withCRs title: 'Do you like chocolate?'"
- ^self confirm: aString title: titleString at: nil!
Item was removed:
- ----- Method: UserDialogBoxMorph class>>confirm:title:at: (in category 'utilities') -----
- confirm: aString title: titleString at: aPointOrNil
- "UserDialogBoxMorph confirm: 'Make your choice carefully' withCRs title: 'Do you like chocolate?'"
- ^self new
- title: titleString;
- message: aString;
- createButton: 'Yes' translated value: true;
- createCancelButton: 'No' translated value: false;
- selectedButtonIndex: 1; "YES"
- registerKeyboardShortcuts;
- getUserResponseAtHand!
Item was removed:
- ----- Method: UserDialogBoxMorph class>>confirm:title:trueChoice:falseChoice: (in category 'utilities') -----
- confirm: aString title: titleString trueChoice: trueChoice falseChoice: falseChoice
- "UserDialogBoxMorph confirm: 'Make your choice carefully' withCRs title: 'Do you like chocolate?' trueChoice: 'Oh yessir!!' falseChoice: 'Not so much...' "
- ^self confirm: aString title: titleString trueChoice: trueChoice falseChoice: falseChoice at: nil!
Item was removed:
- ----- Method: UserDialogBoxMorph class>>confirm:title:trueChoice:falseChoice:at: (in category 'utilities') -----
- confirm: aString title: titleString trueChoice: trueChoice falseChoice: falseChoice at: aPointOrNil
- "UserDialogBoxMorph confirm: 'Make your choice carefully' withCRs title: 'Do you like chocolate?' trueChoice: 'Oh yessir!!' falseChoice: 'Not so much...'"
- ^self new
- title: titleString;
- message: aString;
- createButton: trueChoice translated value: true;
- createButton: falseChoice translated value: false;
- createCancelButton: 'Cancel' translated translated value: nil;
- selectedButtonIndex: 1;
- registerKeyboardShortcuts;
- preferredPosition: (aPointOrNil ifNil: [Project current world center]);
- getUserResponse!
Item was removed:
- ----- Method: UserDialogBoxMorph class>>confirm:title:trueChoice:falseChoice:default:triggerAfter:at: (in category 'utilities') -----
- confirm: aString title: titleString trueChoice: trueChoice falseChoice: falseChoice default: default triggerAfter: seconds at: aPointOrNil
- "UserDialogBoxMorph confirm: 'I like hot java' title: 'What do you say?' trueChoice: 'You bet!!' falseChoice: 'Nope' default: false triggerAfter: 12 at: 121 at 212"
- ^self new
- title: titleString;
- message: aString;
- createButton: trueChoice translated value: true;
- createButton: falseChoice translated value: false;
- createCancelButton: 'Cancel' translated translated value: nil;
- selectedButtonIndex: (default ifTrue: [1] ifFalse: [2]);
- registerKeyboardShortcuts;
- preferredPosition: (aPointOrNil ifNil: [Project current world center]);
- getUserResponseAfter: seconds!
Item was removed:
- ----- Method: UserDialogBoxMorph class>>confirm:trueChoice:falseChoice: (in category 'utilities') -----
- confirm: aString trueChoice: trueChoice falseChoice: falseChoice
- "UserDialogBoxMorph confirm: 'Do you like chocolate?' trueChoice: 'Oh yessir!!' falseChoice: 'Not so much...' "
- ^self confirm: aString title: 'Please confirm:' trueChoice: trueChoice falseChoice: falseChoice at: nil!
Item was removed:
- ----- Method: UserDialogBoxMorph class>>inform: (in category 'utilities') -----
- inform: aString
- "UserDialogBoxMorph inform: 'Squeak is great!!'"
- ^self inform: aString title: 'Note' translated!
Item was removed:
- ----- Method: UserDialogBoxMorph class>>inform:title: (in category 'utilities') -----
- inform: aString title: titleString
- "UserDialogBoxMorph inform: 'Squeak is great!!' title: 'Will you look at this:'"
- ^self inform: aString title: titleString at: nil!
Item was removed:
- ----- Method: UserDialogBoxMorph class>>inform:title:at: (in category 'utilities') -----
- inform: aString title: titleString at: aPointOrNil
- "UserDialogBoxMorph inform: 'Squeak is great!!' title: 'Will you look at this:'"
-
- ^self new
- title: titleString;
- message: aString;
- createButton: 'OK' translated value: nil;
- getUserResponseAtHand!
Item was removed:
- ----- Method: UserDialogBoxMorph>>label (in category 'accessing') -----
- label
- ^ self message!
Item was removed:
- ----- Method: UserDialogBoxMorph>>label: (in category 'accessing') -----
- label: aString
- self message: aString.!
Item was removed:
- MorphicEvent subclass: #UserInputEvent
- instanceVariableNames: 'type buttons position handler wasHandled wasIgnored'
- classVariableNames: ''
- poolDictionaries: 'EventSensorConstants'
- category: 'Morphic-Events'!
Item was removed:
- ----- Method: UserInputEvent>>anyModifierKeyPressed (in category 'modifier state') -----
- anyModifierKeyPressed
- "ignore, however, the shift keys 'cause that's not REALLY a modifier key "
-
- ^ self buttons anyMask: (2r1110 "cmd | opt | ctrl" bitShift: MouseEvent numButtons)!
Item was removed:
- ----- Method: UserInputEvent>>buttonString (in category 'printing') -----
- buttonString
- "Return a string identifying the currently pressed buttons"
- | string |
- string := ''.
- self redButtonPressed ifTrue:[string := string,'red '].
- self yellowButtonPressed ifTrue:[string := string,'yellow '].
- self blueButtonPressed ifTrue:[string := string,'blue '].
- ^string!
Item was removed:
- ----- Method: UserInputEvent>>buttons (in category 'accessing') -----
- buttons
- "Return the a word encoding the mouse and modifier buttons for this event."
-
- ^ buttons!
Item was removed:
- ----- Method: UserInputEvent>>commandKeyPressed (in category 'modifier state') -----
- commandKeyPressed
- "Answer true if the command key on the keyboard was being held down when this event occurred."
-
- ^ self buttons anyMask: (2r1000 "cmd" bitShift: MouseEvent numButtons)!
Item was removed:
- ----- Method: UserInputEvent>>controlKeyPressed (in category 'modifier state') -----
- controlKeyPressed
- "Answer if the control key on the keyboard was being held down when this event occurred."
-
- ^ self buttons anyMask: (2r0010 "ctrl" bitShift: MouseEvent numButtons)!
Item was removed:
- ----- Method: UserInputEvent>>copyHandlerState: (in category 'initialize') -----
- copyHandlerState: anEvent
- "Copy the handler state from anEvent. Used for quickly transferring handler information between transformed events."
- handler := anEvent handler.
- wasHandled := anEvent wasHandled.!
Item was removed:
- ----- Method: UserInputEvent>>handler (in category 'accessing') -----
- handler
- ^handler!
Item was removed:
- ----- Method: UserInputEvent>>handler: (in category 'accessing') -----
- handler: anObject
- handler := anObject!
Item was removed:
- ----- Method: UserInputEvent>>initialize (in category 'initialize') -----
- initialize
-
- super initialize.
- wasIgnored := false.!
Item was removed:
- ----- Method: UserInputEvent>>modifierString (in category 'printing') -----
- modifierString
- "Return a string identifying the currently pressed modifiers"
- | string |
- string := ''.
- self controlKeyPressed ifTrue:[string := string,'CTRL '].
- self optionKeyPressed ifTrue:[string := string,'OPT '].
- self commandKeyPressed ifTrue:[string := string,'CMD '].
- self shiftPressed ifTrue:[string := string,'SHIFT '].
- ^string!
Item was removed:
- ----- Method: UserInputEvent>>modifiers (in category 'accessing') -----
- modifiers
-
- ^ Array streamContents: [:s |
- self controlKeyPressed ifTrue: [s nextPut: #ctrl].
- self optionKeyPressed ifTrue:[s nextPut: #opt].
- self commandKeyPressed ifTrue:[s nextPut: #cmd].
- self shiftPressed ifTrue:[s nextPut: #shift]]!
Item was removed:
- ----- Method: UserInputEvent>>optionKeyPressed (in category 'modifier state') -----
- optionKeyPressed
- "Answer if the option key on the keyboard was being held down when this event occurred."
-
- ^ self buttons anyMask: (2r0100 "opt" bitShift: MouseEvent numButtons)!
Item was removed:
- ----- Method: UserInputEvent>>position (in category 'accessing') -----
- position
- ^position!
Item was removed:
- ----- Method: UserInputEvent>>resetHandlerFields (in category 'initialize') -----
- resetHandlerFields
- "Reset anything that is used to cross-communicate between two eventual handlers during event dispatch"
- handler := nil.
- wasHandled := false.!
Item was removed:
- ----- Method: UserInputEvent>>setPosition: (in category 'private') -----
- setPosition: aPoint
- position := aPoint!
Item was removed:
- ----- Method: UserInputEvent>>shiftPressed (in category 'modifier state') -----
- shiftPressed
- "Answer true if the shift key on the keyboard was being held down when this event occurred."
-
- ^ self buttons anyMask: (2r0001 "shift" bitShift: MouseEvent numButtons)!
Item was removed:
- ----- Method: UserInputEvent>>transformBy: (in category 'transforming') -----
- transformBy: aMorphicTransform
- "Transform the receiver into a local coordinate system."
- position := aMorphicTransform globalPointToLocal: position.!
Item was removed:
- ----- Method: UserInputEvent>>transformedBy: (in category 'transforming') -----
- transformedBy: aMorphicTransform
- "Return the receiver transformed by the given transform into a local coordinate system."
- ^self shallowCopy transformBy: aMorphicTransform!
Item was removed:
- ----- Method: UserInputEvent>>translateBy: (in category 'transforming') -----
- translateBy: delta
- "add delta to cursorPoint, and return the new event"
- position := position + delta.!
Item was removed:
- ----- Method: UserInputEvent>>translateTo: (in category 'transforming') -----
- translateTo: point
-
- position := point.!
Item was removed:
- ----- Method: UserInputEvent>>translatedBy: (in category 'transforming') -----
- translatedBy: delta
- "add delta to cursorPoint, and return the new event"
- ^self shallowCopy translateBy: delta!
Item was removed:
- ----- Method: UserInputEvent>>type (in category 'accessing') -----
- type
- "Return a symbol indicating the type this event."
-
- ^ type!
Item was removed:
- ----- Method: UserInputEvent>>wasHandled (in category 'accessing') -----
- wasHandled
- ^wasHandled!
Item was removed:
- ----- Method: UserInputEvent>>wasHandled: (in category 'accessing') -----
- wasHandled: aBool
- wasHandled := aBool.!
Item was removed:
- ----- Method: UserInputEvent>>wasIgnored (in category 'accessing') -----
- wasIgnored
- ^ wasIgnored == true!
Item was removed:
- ----- Method: UserInputEvent>>wasIgnored: (in category 'accessing') -----
- wasIgnored: aBoolean
- wasIgnored := aBoolean.!
Item was removed:
- MorphicEvent subclass: #WindowEvent
- instanceVariableNames: 'action rectangle'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Events'!
-
- !WindowEvent commentStamp: '<historical>' prior: 0!
- I'm an event related to the host window, only dispatched to the World. !
Item was removed:
- ----- Method: WindowEvent>>action (in category 'accessing') -----
- action
- ^action!
Item was removed:
- ----- Method: WindowEvent>>action: (in category 'accessing') -----
- action: aValue
- action := aValue.!
Item was removed:
- ----- Method: WindowEvent>>isWindowEvent (in category 'testing') -----
- isWindowEvent
- ^true!
Item was removed:
- ----- Method: WindowEvent>>printOn: (in category 'printing') -----
- printOn: aStream
-
- aStream nextPut: $[.
- aStream nextPutAll: self type; space.
- aStream nextPut: $(; print: self rectangle; nextPut: $).
- aStream nextPut: $].!
Item was removed:
- ----- Method: WindowEvent>>rectangle (in category 'accessing') -----
- rectangle
- ^rectangle!
Item was removed:
- ----- Method: WindowEvent>>rectangle: (in category 'accessing') -----
- rectangle: aValue
- rectangle := aValue.!
Item was removed:
- ----- Method: WindowEvent>>sentTo: (in category 'dispatching') -----
- sentTo:anObject
- "Dispatch the receiver into anObject"
- ^anObject handleWindowEvent: self.!
Item was removed:
- ----- Method: WindowEvent>>type (in category 'accessing') -----
- type
- "This should match the definitions in sq.h"
- ^#(
- windowMetricChange
- windowClose
- windowIconise
- windowActivated
- windowPaint
- windowChangedScreen
- windowDeactivated
- ) at: action ifAbsent: [#windowEventUnknown]!
Item was removed:
- Morph subclass: #WindowHostFocusMorph
- instanceVariableNames: 'active previousFocus previousMouseOverForKeyboardFocus'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Worlds'!
-
- !WindowHostFocusMorph commentStamp: 'ct 5/18/2022 12:41' prior: 0!
- I represent the host system as a focus holder, i.e., I receive the keyboard focus when the VM looses the keyboard focus. See PasteUpMorph>>#windowEvent:.!
Item was removed:
- ----- Method: WindowHostFocusMorph>>active (in category 'accessing') -----
- active
-
- ^ active!
Item was removed:
- ----- Method: WindowHostFocusMorph>>active: (in category 'accessing') -----
- active: aBoolean
- active := aBoolean.
-
- active
- ifTrue: [
- "If #mouseOverForKeyboardFocus is enabled, disable it temporarily because when WindowHostFocusMorph 'has the focus', Squeak as a whole *doesn't*, and we *can't* set the externally controlled keyboard focus."
- self saveMouseOverForKeyboardFocus]
- ifFalse: [
- "Restore the #mouseOverForKeyboardFocus preference that we (maybe) saved when we were activated."
- self restoreMouseOverForKeyboardFocus]!
Item was removed:
- ----- Method: WindowHostFocusMorph>>initialize (in category 'initialization') -----
- initialize
-
- super initialize.
-
- self active: true.!
Item was removed:
- ----- Method: WindowHostFocusMorph>>keyboardFocusDelegate (in category 'event handling') -----
- keyboardFocusDelegate
- "When the receiver was remembered as a prior keyboard focus in place of the previous focus morph, answer that previous morph as a keyboard focus delegate so that re-passing the focus to it works. For instance, this happens when a DialogWindow is invoked while the VM does not have the keyboard focus (e.g., when attempting to close the VM window from the outside)."
-
- self flag: #forLater. "Preferably, we would even *prevent* other morphs from receiving the keyboard focus through this surrogate. However, there is currently no hook #okToChangeKeyboardFocus: in HandMorph>>#newKeyboardFocus: and re-setting the focus unagreedly might cause trouble in other focus holders."
-
- self active ifTrue: [^ self].
- ^ self previousFocus ifNotNil: [:morph | morph keyboardFocusDelegate]!
Item was removed:
- ----- Method: WindowHostFocusMorph>>previousFocus (in category 'accessing') -----
- previousFocus
-
- ^ previousFocus!
Item was removed:
- ----- Method: WindowHostFocusMorph>>previousFocus: (in category 'accessing') -----
- previousFocus: aMorph
-
- previousFocus := aMorph.!
Item was removed:
- ----- Method: WindowHostFocusMorph>>restoreMouseOverForKeyboardFocus (in category 'accessing') -----
- restoreMouseOverForKeyboardFocus
- previousMouseOverForKeyboardFocus ifNotNil: [:value |
- previousMouseOverForKeyboardFocus := nil.
- Preferences setPreference: #mouseOverForKeyboardFocus toValue: value].!
Item was removed:
- ----- Method: WindowHostFocusMorph>>saveMouseOverForKeyboardFocus (in category 'accessing') -----
- saveMouseOverForKeyboardFocus
- Preferences mouseOverForKeyboardFocus ifTrue: [
- previousMouseOverForKeyboardFocus := true.
- Preferences setPreference: #mouseOverForKeyboardFocus toValue: false].!
Item was removed:
- Object subclass: #WorldState
- instanceVariableNames: 'hands viewBox canvas damageRecorder stepList lastStepTime lastStepMessage lastCycleTime commandHistory alarms lastAlarmTime remoteServer multiCanvas interCycleDelay'
- classVariableNames: 'CanSurrenderToOS DeferredUIMessages DisableDeferredUpdates LastCycleTime MinCycleLapse'
- poolDictionaries: ''
- category: 'Morphic-Worlds'!
-
- !WorldState commentStamp: 'ls 7/10/2003 19:30' prior: 0!
- The state of a Morphic world. (This needs some serious commenting!!!!)
-
-
- The MinCycleLapse variable holds the minimum amount of time that a morphic cycle is allowed to take. If a cycle takes less than this, then interCyclePause: will wait until the full time has been used up.!
Item was removed:
- ----- Method: WorldState class>>addDeferredUIMessage: (in category 'class initialization') -----
- addDeferredUIMessage: valuableObject
-
- self deferredUIMessages nextPut: valuableObject.
-
- !
Item was removed:
- ----- Method: WorldState class>>canSurrenderToOS: (in category 'accessing') -----
- canSurrenderToOS: aBoolean
-
- CanSurrenderToOS := aBoolean!
Item was removed:
- ----- Method: WorldState class>>classVersion (in category 'objects from disk') -----
- classVersion
-
- ^2 "force cleanup of alarms and stepList"!
Item was removed:
- ----- Method: WorldState class>>cleanUp: (in category 'class initialization') -----
- cleanUp: aggressive
-
- self allInstancesDo: [:worldState | worldState cleanUp: aggressive].!
Item was removed:
- ----- Method: WorldState class>>deferredExecutionTimeLimit (in category 'accessing') -----
- deferredExecutionTimeLimit
- "Answer the maximum time in milliseconds that should be spent dispatching deferred UI messages in WorldState>>runStepMethodsIn:."
-
- ^ 200!
Item was removed:
- ----- Method: WorldState class>>deferredUIMessages (in category 'class initialization') -----
- deferredUIMessages
-
- ^DeferredUIMessages ifNil: [DeferredUIMessages := SharedQueue new].
- !
Item was removed:
- ----- Method: WorldState class>>disableDeferredUpdates (in category 'preferences') -----
- disableDeferredUpdates
- <preference: 'Disable deferred updates (Morphic only)'
- categoryList: #(Morphic Performance Graphics)
- description: 'When enabled, use an extra image-side buffer for compositing screen contents.
- When deferred updating is used, Morphic performs double-buffered screen updates by telling the VM to de-couple the Display from the hardware display buffer, drawing directly into the Display, and then forcing the changed regions of the Display to be copied to the screen. This saves both time (an extra BitBlt is avoided) and space (an extra display buffer is avoided). However, on platforms on which the Display points directly to the hardware screen buffer, deferred updating can''t be used. In this case, the drawing should be composited into an offscreen FormCanvas and then copied to the hardware display buffer.
- Enable this preference when morphs become invisible while dragging them in the world or when you see ugly flashing while the layers of the drawing are assembled.'
- type: #Boolean>
- ^DisableDeferredUpdates ifNil: [DisableDeferredUpdates := false]
- !
Item was removed:
- ----- Method: WorldState class>>disableDeferredUpdates: (in category 'preferences') -----
- disableDeferredUpdates: aBooleanOrNil
-
- DisableDeferredUpdates = aBooleanOrNil ifTrue: [^ self].
- DisableDeferredUpdates := aBooleanOrNil ifNil: [false].
- Project allMorphicProjects do: [:ea | ea world canvas: nil].!
Item was removed:
- ----- Method: WorldState class>>initialize (in category 'class initialization') -----
- initialize
- "WorldState initialize"
-
- MinCycleLapse := 20. "allows 50 frames per second..."
- DisableDeferredUpdates := false.
- DeferredUIMessages := SharedQueue new.!
Item was removed:
- ----- Method: WorldState class>>lastCycleTime (in category 'accessing') -----
- lastCycleTime
-
- ^LastCycleTime!
Item was removed:
- ----- Method: WorldState class>>lastDeferredUIMessage (in category 'class initialization') -----
- lastDeferredUIMessage
- "Answer the most recently scheduled deferredUIMessage."
-
- ^self deferredUIMessages peekLast!
Item was removed:
- ----- Method: WorldState class>>withClassVersion: (in category 'objects from disk') -----
- withClassVersion: aVersion
- aVersion <= self classVersion ifTrue: [^self].
- ^super withClassVersion: aVersion!
Item was removed:
- ----- Method: WorldState>>addAlarm:withArguments:for:at: (in category 'alarms') -----
- addAlarm: aSelector withArguments: argArray for: aTarget at: scheduledTime
- "Add a new alarm with the given set of parameters"
- self lockAlarmsDuring: [:locked |
- locked add: (MorphicAlarm
- scheduledAt: scheduledTime
- receiver: aTarget
- selector: aSelector
- arguments: argArray).
- ]!
Item was removed:
- ----- Method: WorldState>>addHand: (in category 'hands') -----
- addHand: aHandMorph
- "Add the given hand to the list of hands for this world."
-
- hands := (hands copyWithout: aHandMorph) copyWith: aHandMorph.
- !
Item was removed:
- ----- Method: WorldState>>addRemoteCanvas: (in category 'Nebraska support') -----
- addRemoteCanvas: c
- self canvas: nil. "force recomputation"!
Item was removed:
- ----- Method: WorldState>>adjustAlarmTimes: (in category 'alarms') -----
- adjustAlarmTimes: nowTime
- "Adjust the alarm times after some clock weirdness (such as roll-over, image-startup etc)"
-
- | deltaTime |
- (deltaTime := nowTime - lastAlarmTime) = 0 ifTrue: [ ^self ].
- self lockAlarmsDuring: [ :locked | locked incrementScheduledTimesBy: deltaTime ]!
Item was removed:
- ----- Method: WorldState>>adjustWakeupTimes: (in category 'stepping') -----
- adjustWakeupTimes: now
- "Fix the wakeup times in my step list. This is necessary when this world has been restarted after a pause, say because some other view had control, after a snapshot, or because the millisecond clock has wrapped around. (The latter is a rare occurence with a 32-bit clock!!)"
- | deltaTime |
- deltaTime := now - lastStepTime.
- stepList do:[:entry| entry scheduledTime: entry scheduledTime + deltaTime].
- lastStepTime := now.
- !
Item was removed:
- ----- Method: WorldState>>adjustWakeupTimesIfNecessary (in category 'stepping') -----
- adjustWakeupTimesIfNecessary
- "Fix the wakeup times in my step list if necessary. This is needed after a snapshot, after a long pause (say because some other view had control or because the user was selecting from an MVC-style menu) or when the millisecond clock wraps around (a very rare occurence with a 32-bit clock!!)."
-
- | now |
- now := Time millisecondClockValue.
- ((now < lastStepTime) or: [(now - lastStepTime) > 5000])
- ifTrue: [self adjustWakeupTimes: now]. "clock slipped"
- !
Item was removed:
- ----- Method: WorldState>>alarms (in category 'alarms') -----
- alarms
-
- ^alarms ifNil: [alarms := MorphicAlarmQueue new]!
Item was removed:
- ----- Method: WorldState>>assuredCanvas (in category 'canvas') -----
- assuredCanvas
- remoteServer ifNotNil:[^self assuredRemoteCanvas].
- (canvas isNil or: [(canvas extent ~= viewBox extent) or: [canvas form depth ~= Display depth]])
- ifTrue:
- ["allocate a new offscreen canvas the size of the window"
- self canvas: (Display defaultCanvasClass extent: viewBox extent)].
- ^ self canvas!
Item was removed:
- ----- Method: WorldState>>assuredRemoteCanvas (in category 'Nebraska support') -----
- assuredRemoteCanvas
- | newCanvas |
- (self canvas notNil) ifTrue: [ ^self canvas ].
- newCanvas := MultiCanvas new.
- newCanvas depth: 32.
- newCanvas extent: viewBox extent.
- self remoteCanvasesDo: [ :c | newCanvas addCanvas: c ].
- newCanvas addCanvas: Display getCanvas.
-
- "newCanvas := CachingCanvas on: newCanvas."
- self canvas: newCanvas.
- ^newCanvas!
Item was removed:
- ----- Method: WorldState>>canvas (in category 'canvas') -----
- canvas
-
- ^ canvas!
Item was removed:
- ----- Method: WorldState>>canvas: (in category 'canvas') -----
- canvas: x
- canvas := x.
- damageRecorder isNil
- ifTrue: [damageRecorder := DamageRecorder new]
- ifFalse: [damageRecorder doFullRepaint]!
Item was removed:
- ----- Method: WorldState>>checkIfUpdateNeeded (in category 'update cycle') -----
- checkIfUpdateNeeded
-
- damageRecorder updateIsNeeded ifTrue: [^true].
- hands do: [:h | (h hasChanged and: [h needsToBeDrawn]) ifTrue: [^true]].
- ^false "display is already up-to-date"
- !
Item was removed:
- ----- Method: WorldState>>cleanUp: (in category 'initialization') -----
- cleanUp: aggressive
-
- self clearCommandHistory.
- self handsDo: [:hand | hand cleanUp: aggressive].!
Item was removed:
- ----- Method: WorldState>>cleanseStepListForWorld: (in category 'stepping') -----
- cleanseStepListForWorld: aWorld
- "Remove morphs from the step list that are not in this World. Often were in a flap that has moved on to another world."
-
- | deletions |
- deletions := nil.
- stepList do: [:entry |
- entry receiver world == aWorld ifFalse: [
- (deletions ifNil: [ deletions := OrderedCollection new ])
- addLast: entry ] ].
-
- deletions ifNotNil:[
- deletions do: [:entry|
- self stopStepping: entry receiver]].
-
- self lockAlarmsDuring: [:locked |
- locked alarmsDoSafely: [ :entry |
- | morphToStep |
- morphToStep := entry receiver.
- (morphToStep isMorph and: [morphToStep world == aWorld]) ifFalse: [
- locked removeAlarmWithReceiver: entry receiver selector: entry selector ] ] ]!
Item was removed:
- ----- Method: WorldState>>clearCommandHistory (in category 'undo support') -----
- clearCommandHistory
-
- "useful prior to project saves"
- commandHistory := nil!
Item was removed:
- ----- Method: WorldState>>commandHistory (in category 'undo') -----
- commandHistory
- ^commandHistory ifNil:[commandHistory := CommandHistory new]!
Item was removed:
- ----- Method: WorldState>>convertAlarms (in category 'object fileIn') -----
- convertAlarms
- "We now store the alarms in a MorphicAlarmQueue, rather than a Heap.
- Make sure we have a fresh one. If it is already a MorphicAlarmQueue
- updating it will ensure any block to method references are fresh."
- alarms ifNotNil:
- [:oldAlarms|
- alarms class == MorphicAlarmQueue
- ifTrue:
- [alarms := MorphicAlarmQueue new.
- oldAlarms alarmsDoSafely: [:alarm | alarms add: alarm]]
- ifFalse:
- [alarms := MorphicAlarmQueue new.
- oldAlarms do: [:alarm | alarms add: alarm]]]!
Item was removed:
- ----- Method: WorldState>>convertStepList (in category 'object fileIn') -----
- convertStepList
- "Convert the old-style step list (an Array of Arrays) into the new-style StepMessage heap"
-
- | newList |
- (stepList isKindOf: Heap)
- ifTrue:
- [^stepList sortBlock: self stepListSortBlock "ensure that we have a cleaner block"].
- newList := Heap sortBlock: self stepListSortBlock.
- stepList do:
- [:entry | | wakeupTime morphToStep |
- wakeupTime := entry second.
- morphToStep := entry first.
- newList add: (StepMessage
- scheduledAt: wakeupTime
- stepTime: nil
- receiver: morphToStep
- selector: #stepAt:
- arguments: nil)].
- stepList := newList!
Item was removed:
- ----- Method: WorldState>>convertToCurrentVersion:refStream: (in category 'objects from disk') -----
- convertToCurrentVersion: varDict refStream: smartRefStrm
-
- "Convert the old to new step lists"
- self convertStepList.
- self convertAlarms.
- ^super convertToCurrentVersion: varDict refStream: smartRefStrm.
-
- !
Item was removed:
- ----- Method: WorldState>>displayWorld:submorphs: (in category 'update cycle') -----
- displayWorld: aWorld submorphs: submorphs
- "Update this world's display."
-
- | deferredUpdateMode handsToDraw allDamage handDamageRects worldDamageRects |
-
- aWorld fullBounds. "send #ownerChanged to submorphs."
- submorphs do: [:m | m fullBounds]. "force re-layout if needed"
- self checkIfUpdateNeeded ifFalse: [^ self]. "display is already up-to-date"
-
- deferredUpdateMode := self doDeferredUpdatingFor: aWorld.
- deferredUpdateMode ifFalse: [self assuredCanvas].
-
- worldDamageRects := self drawWorld: aWorld submorphs: submorphs invalidAreasOn: self assuredCanvas. "repair world's damage on canvas"
- "self handsDo:[:h| h noticeDamageRects: worldDamageRects]."
- handsToDraw := self selectHandsToDrawForDamage: worldDamageRects.
- handDamageRects := handsToDraw collect: [:h | h savePatchFrom: canvas].
- allDamage := worldDamageRects, handDamageRects.
-
- handsToDraw reverseDo: [:h | canvas fullDrawMorph: h]. "draw hands onto world canvas"
-
- "*make this true to flash damaged areas for testing*"
- Preferences debugShowDamage ifTrue: [aWorld flashRects: allDamage color: Color black].
-
- canvas finish: allDamage.
-
- "quickly copy altered rects of canvas to Display:"
- deferredUpdateMode
- ifTrue: [self forceDamageToScreen: allDamage]
- ifFalse: [canvas showAt: aWorld viewBox origin invalidRects: allDamage].
- handsToDraw do: [:h | h restoreSavedPatchOn: canvas]. "restore world canvas under hands"
- Display deferUpdates: false; forceDisplayUpdate.
- !
Item was removed:
- ----- Method: WorldState>>displayWorldSafely: (in category 'update cycle') -----
- displayWorldSafely: aWorld
- "Update this world's display and keep track of errors during draw methods."
-
- | finished classesWithErrors |
- finished := false.
-
- [finished] whileFalse: [
- [aWorld displayWorld. finished := true] on: Error, Halt, Warning do: [:ex |
- "Handle a drawing error"
- | err rcvr errCtx errMorph |
- err := ex description.
- rcvr := ex receiver.
-
- errCtx := thisContext.
- [
- errCtx := errCtx sender.
- "Search the sender chain to find the morph causing the problem"
- [errCtx notNil and:[(errCtx receiver isMorph) not]]
- whileTrue:[errCtx := errCtx sender].
- "If we're at the root of the context chain then we have a fatal drawing problem"
- errCtx ifNil:[^Project current fatalDrawingError: err].
- errMorph := errCtx receiver.
- "If the morph causing the problem has already the #drawError flag set,
- then search for the next morph above in the caller chain."
- errMorph hasProperty: #errorOnDraw
- ] whileTrue.
- errMorph setProperty: #errorOnDraw toValue: true.
-
- "Catch all errors, one for each receiver class."
- classesWithErrors ifNil: [classesWithErrors := IdentitySet new].
- (classesWithErrors includes: rcvr class) ifFalse: [
- classesWithErrors add: rcvr class.
- ToolSet debugException: ex].
-
- "Repaint all to catch all errors now and not if the debugger will appear."
- aWorld fullRepaintNeeded.
- ]].!
Item was removed:
- ----- Method: WorldState>>doDeferredUpdatingFor: (in category 'update cycle') -----
- doDeferredUpdatingFor: aWorld
- "If this platform supports deferred updates, then make my canvas be the Display (or a rectangular portion of it), set the Display to deferred update mode, and answer true. Otherwise, do nothing and answer false. One can set the class variable DisableDeferredUpdates to true to completely disable the deferred updating feature."
- | properDisplay |
- DisableDeferredUpdates ifTrue: [^ false].
- (Display deferUpdates: true) ifNil: [^ false]. "deferred updates not supported"
- remoteServer ifNotNil:[
- self assuredCanvas.
- ^true].
- properDisplay := canvas notNil and: [canvas form == Display].
- aWorld == Project current world ifTrue: [ "this world fills the entire Display"
- properDisplay ifFalse: [
- aWorld viewBox: Display boundingBox. "do first since it may clear canvas"
- self canvas: (Display getCanvas copyClipRect: Display boundingBox).
- ]
- ].
- ^ true
- !
Item was removed:
- ----- Method: WorldState>>doFullRepaint (in category 'canvas') -----
- doFullRepaint
-
- damageRecorder doFullRepaint
- !
Item was removed:
- ----- Method: WorldState>>doOneCycleFor: (in category 'update cycle') -----
- doOneCycleFor: aWorld
- "Do one cycle of the interaction loop. This method is called repeatedly when the world is running.
-
- This is a moderately private method; a better alternative is usually either to wait for events or to check the state of things from #step methods."
-
- self interCyclePause: (Preferences higherPerformance ifTrue: [1] ifFalse: [MinCycleLapse]).
- self doOneCycleNowFor: aWorld.!
Item was removed:
- ----- Method: WorldState>>doOneCycleNowFor: (in category 'update cycle') -----
- doOneCycleNowFor: aWorld
- "Immediately do one cycle of the interaction loop.
- This should not be called directly, but only via doOneCycleFor:"
-
- | capturingGesture |
- DisplayScreen checkForNewScreenScaleFactor; checkForNewScreenSize.
- capturingGesture := false.
- "self flag: #bob. " "need to consider remote hands in lower worlds"
-
- "process user input events"
- LastCycleTime := Time millisecondClockValue.
- self handsDo: [:hand |
- hand becomeActiveDuring: [
- hand processEvents.
- capturingGesture := capturingGesture or: [hand isCapturingGesturePoints]]].
-
- "The gesture recognizer needs enough points to be accurate.
- Therefore morph stepping is disabled while capturing points for the recognizer"
- capturingGesture ifFalse: [
- aWorld becomeActiveDuring: [
- aWorld runStepMethods "there are currently some variations here".
- self displayWorldSafely: aWorld]].!
Item was removed:
- ----- Method: WorldState>>doOneSubCycleFor: (in category 'update cycle') -----
- doOneSubCycleFor: aWorld
-
- self flag: #deprecate. "ct: Historically, global state was preserved here. Since the introduction of ActiveHandVariable, this is no longer necessary, so this is equivalent to #doOneCycleFor:. However, let's keep this possibly valuable hook for now."
-
- ^ self doOneCycleFor: aWorld!
Item was removed:
- ----- Method: WorldState>>drawWorld:submorphs:invalidAreasOn: (in category 'update cycle') -----
- drawWorld: aWorld submorphs: submorphs invalidAreasOn: aCanvas
- "Redraw the damaged areas of the given canvas and clear the damage list. Return a collection of the areas that
- were redrawn."
-
- | rectList n morphs rects validList |
- rectList := damageRecorder invalidRectsFullBounds: aWorld viewBox.
- "sort by areas to draw largest portions first"
- rectList := rectList asArray sort: [:r1 :r2 | r1 area > r2 area].
- damageRecorder reset.
- n := submorphs size.
- morphs := OrderedCollection new: n * 2.
- rects := OrderedCollection new: n * 2.
- validList := OrderedCollection new: n * 2.
-
- "This is added in case we are drawing to a form that is to be used as a texture, and we want the background to be translucent."
- aWorld color isTranslucent ifTrue:
- [rectList do: [:r | aCanvas form fill: r fillColor: aWorld color]].
-
- rectList do:
- [:dirtyRect |
- dirtyRect allAreasOutsideList: validList
- do:
- [:r | | mm rectToFill remnants c rect i |
- "Experimental top-down drawing --
- Traverses top to bottom, stopping if the entire area is filled.
- If only a single rectangle remains, then continue with the reduced rectangle."
-
- rectToFill := r.
- i := 1.
- [rectToFill isNil or: [i > n]] whileFalse:
- [mm := submorphs at: i.
- ((mm fullBounds intersects: r) and: [mm visible])
- ifTrue:
- [morphs addLast: mm.
- rects addLast: rectToFill.
- remnants := mm areasRemainingToFill: rectToFill.
- remnants size = 1 ifTrue: [rectToFill := remnants first].
- remnants isEmpty ifTrue: [rectToFill := nil]].
- i := i + 1].
-
- "Now paint from bottom to top, but using the reduced rectangles."
- rectToFill
- ifNotNil: [(c := aCanvas copyClipRect: rectToFill) drawMorph: aWorld].
- [morphs isEmpty] whileFalse:
- [(rect := rects removeLast) == rectToFill
- ifFalse: [c := aCanvas copyClipRect: (rectToFill := rect)].
- c fullDrawMorph: morphs removeLast].
- morphs reset.
- rects reset.
- validList add: r]].
- ^validList!
Item was removed:
- ----- Method: WorldState>>forceDamageToScreen: (in category 'update cycle') -----
- forceDamageToScreen: allDamage
-
- "here for the convenience of NebraskaWorldState"
- Display forceDamageToScreen: allDamage.
- self remoteCanvasesDo: [ :each |
- allDamage do: [:r | each forceToScreen: r].
- each displayIsFullyUpdated.
- ].!
Item was removed:
- ----- Method: WorldState>>hands (in category 'hands') -----
- hands
-
- ^ hands!
Item was removed:
- ----- Method: WorldState>>handsDo: (in category 'hands') -----
- handsDo: aBlock
-
- ^ hands do: aBlock!
Item was removed:
- ----- Method: WorldState>>handsReverseDo: (in category 'hands') -----
- handsReverseDo: aBlock
-
- ^ hands reverseDo: aBlock!
Item was removed:
- ----- Method: WorldState>>initialize (in category 'initialization') -----
- initialize
-
- hands := Array new.
- damageRecorder:= DamageRecorder new.
- stepList := Heap sortBlock: self stepListSortBlock.
- lastStepTime := 0.
- lastAlarmTime := 0.!
Item was removed:
- ----- Method: WorldState>>interCyclePause: (in category 'update cycle') -----
- interCyclePause: milliSecs
- "delay enough that the previous cycle plus the amount of delay will equal milliSecs. If the cycle is already expensive, then no delay occurs. However, if the system is idly waiting for interaction from the user, the method will delay for a proportionally long time and cause the overall CPU usage of Squeak to be low.
- If the preference #serverMode is enabled, always do a complete delay of 50ms, independant of my argument. This prevents the freezing problem described in Mantis #6581"
-
- | millisecondsToWait |
- millisecondsToWait := Preferences serverMode
- ifTrue: [ 50 ]
- ifFalse: [
- (lastCycleTime isNil or: [ CanSurrenderToOS == false ])
- ifTrue: [ 0 ]
- ifFalse: [ milliSecs - (Time millisecondsSince: lastCycleTime) ] ].
- (Preferences serverMode or: [millisecondsToWait > 0 and: [millisecondsToWait <= milliSecs]])
- ifTrue: [
- (interCycleDelay isNil or: [ interCycleDelay beingWaitedOn ])
- ifTrue: [ interCycleDelay := Delay forMilliseconds: millisecondsToWait ]
- ifFalse: [ interCycleDelay delayDuration: millisecondsToWait ].
- interCycleDelay wait ].
- lastCycleTime := Time millisecondClockValue.
- CanSurrenderToOS := true.!
Item was removed:
- ----- Method: WorldState>>isStepping: (in category 'stepping') -----
- isStepping: aMorph
- "Return true if the given morph is in the step list."
- lastStepMessage ifNotNil:[(lastStepMessage receiver == aMorph) ifTrue:[^true]].
- stepList do:[:entry| entry receiver == aMorph ifTrue:[^true]].
- ^ false!
Item was removed:
- ----- Method: WorldState>>isStepping:selector: (in category 'stepping') -----
- isStepping: aMorph selector: aSelector
- "Return true if the given morph is in the step list."
- lastStepMessage ifNotNil:[
- (lastStepMessage receiver == aMorph and:[lastStepMessage selector == aSelector])
- ifTrue:[^true]].
- stepList do:[:entry| (entry receiver == aMorph and:[entry selector == aSelector]) ifTrue:[^true]].
- ^ false!
Item was removed:
- ----- Method: WorldState>>listOfSteppingMorphs (in category 'stepping') -----
- listOfSteppingMorphs
- ^stepList collect:[:entry| entry receiver].
- !
Item was removed:
- ----- Method: WorldState>>lockAlarmsDuring: (in category 'alarms') -----
- lockAlarmsDuring: actionBlock
- "All accesses to the alarms queue is synchronized by a mutex. Answer the result of evaluating the 1-argument 'actionBlock'."
- alarms ifNil: [alarms := MorphicAlarmQueue new].
- ^alarms mutex critical: [
- actionBlock value: alarms
- ]!
Item was removed:
- ----- Method: WorldState>>primaryHand (in category 'hands') -----
- primaryHand
-
- self flag: #deprecated. "ct: Send #primaryHand to #currentWorld instead."
- ^ self currentWorld primaryHand!
Item was removed:
- ----- Method: WorldState>>recordDamagedRect: (in category 'canvas') -----
- recordDamagedRect: damageRect
-
- damageRecorder ifNotNil: [damageRecorder recordInvalidRect: damageRect truncated]
- !
Item was removed:
- ----- Method: WorldState>>releaseRemoteServer (in category 'Nebraska support') -----
- releaseRemoteServer
- "My server has been transferred to some other world. Release pending references"
- remoteServer := nil.
- self canvas: nil.!
Item was removed:
- ----- Method: WorldState>>remoteCanvasesDo: (in category 'Nebraska support') -----
- remoteCanvasesDo: aBlock
- remoteServer ifNil:[^self].
- ^remoteServer clients do:[:client| aBlock value: client canvas]!
Item was removed:
- ----- Method: WorldState>>remoteServer (in category 'Nebraska support') -----
- remoteServer
- ^remoteServer!
Item was removed:
- ----- Method: WorldState>>remoteServer: (in category 'Nebraska support') -----
- remoteServer: aNebraskaServer
- remoteServer ifNotNil:[remoteServer destroy].
- remoteServer := aNebraskaServer.
- self canvas: nil.!
Item was removed:
- ----- Method: WorldState>>removeAlarm:for: (in category 'alarms') -----
- removeAlarm: aSelector for: aTarget
- "Remove the alarm with the given selector"
- self lockAlarmsDuring: [:locked |
- locked removeAlarmWithReceiver: aTarget selector: aSelector ]!
Item was removed:
- ----- Method: WorldState>>removeHand: (in category 'hands') -----
- removeHand: aHandMorph
- "Remove the given hand from the list of hands for this world."
-
- (hands includes: aHandMorph) ifFalse: [^ self].
- self currentHand == aHandMorph ifTrue: [
- self flag: #invalidate. "ct: Should we try to clear ActiveHandVariable here or doesn't this matter? In past, ActiveHand was set to nil at this point."].
- hands := hands copyWithout: aHandMorph.!
Item was removed:
- ----- Method: WorldState>>removeRemoteCanvas: (in category 'Nebraska support') -----
- removeRemoteCanvas: c
- self canvas: nil. "force withdrawal of remote from MultiCanvas"
- !
Item was removed:
- ----- Method: WorldState>>resetDamageRecorder (in category 'canvas') -----
- resetDamageRecorder
-
- damageRecorder reset
- !
Item was removed:
- ----- Method: WorldState>>runLocalStepMethodsIn: (in category 'stepping') -----
- runLocalStepMethodsIn: aWorld
- "Run morph 'step' methods (LOCAL TO THIS WORLD) whose time has come. Purge any morphs that are no longer in this world.
- ar 3/13/1999: Remove buggy morphs from the step list so that they don't raise repeated errors."
-
- | now morphToStep stepTime |
- now := Time millisecondClockValue.
-
- aWorld becomeActiveDuring: [
- self triggerAlarmsBefore: now.
-
- stepList ifEmpty: [^ self].
-
- (now < lastStepTime or: [now - lastStepTime > 5000]) ifTrue: [
- self adjustWakeupTimes: now]. "clock slipped"
-
- [stepList notEmpty and: [stepList first scheduledTime < now]] whileTrue: [
- lastStepMessage := stepList removeFirst.
- morphToStep := lastStepMessage receiver.
- (morphToStep shouldGetStepsFrom: aWorld) ifTrue: [
- lastStepMessage value: now.
- lastStepMessage ifNotNil: [
- stepTime := lastStepMessage stepTime ifNil: [morphToStep stepTime].
- lastStepMessage scheduledTime: now + (stepTime max: 1).
- stepList add: lastStepMessage]].
- lastStepMessage := nil].
-
- lastStepTime := now].!
Item was removed:
- ----- Method: WorldState>>runStepMethodsIn: (in category 'stepping') -----
- runStepMethodsIn: aWorld
- "Perform periodic activity inbetween event cycles"
- | queue msg limit stamp |
- "Limit processing of deferredUIMessages to a max. amount of time"
- limit := self class deferredExecutionTimeLimit.
- stamp := Time millisecondClockValue.
- queue := self class deferredUIMessages.
- [(Time millisecondsSince: stamp) >= limit
- or:[(msg := queue nextOrNil) == nil]]
- whileFalse: [msg value].
- self runLocalStepMethodsIn: aWorld.
- !
Item was removed:
- ----- Method: WorldState>>selectHandsToDrawForDamage: (in category 'hands') -----
- selectHandsToDrawForDamage: damageList
- "Select the set of hands that must be redrawn because either (a) the hand itself has changed or (b) the hand intersects some damage rectangle."
-
- | result |
- result := OrderedCollection new.
- hands do: [:h |
- h needsToBeDrawn ifTrue: [
- h hasChanged
- ifTrue: [result add: h]
- ifFalse: [
- | hBnds |
- hBnds := h fullBounds.
- (damageList anySatisfy: [:r | r intersects: hBnds])
- ifTrue: [result add: h]]]].
- ^ result
- !
Item was removed:
- ----- Method: WorldState>>startStepping:at:selector:arguments:stepTime: (in category 'stepping') -----
- startStepping: aMorph at: scheduledTime selector: aSelector arguments: args stepTime: stepTime
- "Add the given morph to the step list. Do nothing if it is already being stepped."
-
- self stopStepping: aMorph selector: aSelector.
- self adjustWakeupTimesIfNecessary.
- stepList add:(
- StepMessage
- scheduledAt: scheduledTime
- stepTime: stepTime
- receiver: aMorph
- selector: aSelector
- arguments: args)!
Item was removed:
- ----- Method: WorldState>>stepListSize (in category 'initialization') -----
- stepListSize
- ^ stepList size!
Item was removed:
- ----- Method: WorldState>>stepListSortBlock (in category 'initialization') -----
- stepListSortBlock
- ^[ :stepMsg1 :stepMsg2 |
- stepMsg1 scheduledTime <= stepMsg2 scheduledTime.
- ]!
Item was removed:
- ----- Method: WorldState>>stopStepping: (in category 'stepping') -----
- stopStepping: aMorph
- "Remove the given morph from the step list."
- lastStepMessage ifNotNil:[
- (lastStepMessage receiver == aMorph) ifTrue:[lastStepMessage := nil]].
- stepList removeAll: (stepList select:[:stepMsg| stepMsg receiver == aMorph]).
- !
Item was removed:
- ----- Method: WorldState>>stopStepping:selector: (in category 'stepping') -----
- stopStepping: aMorph selector: aSelector
- "Remove the given morph from the step list."
- lastStepMessage ifNotNil:[
- (lastStepMessage receiver == aMorph and:[lastStepMessage selector == aSelector])
- ifTrue:[lastStepMessage := nil]].
- stepList removeAll: (stepList select:[:stepMsg| stepMsg receiver == aMorph and:[stepMsg selector == aSelector]]).!
Item was removed:
- ----- Method: WorldState>>triggerAlarmsBefore: (in category 'alarms') -----
- triggerAlarmsBefore: nowTime
- "Trigger all pending alarms that are to be executed before nowTime."
- | triggered |
- lastAlarmTime ifNil:[lastAlarmTime := nowTime].
- (nowTime < lastAlarmTime or:[nowTime - lastAlarmTime > 10000])
- ifTrue:[self adjustAlarmTimes: nowTime].
- triggered := self lockAlarmsDuring: [:pending |
- pending removeAllAlarmsBefore: nowTime ].
- triggered do: [:alarm | alarm value: nowTime].
- lastAlarmTime := nowTime.!
Item was removed:
- ----- Method: WorldState>>viewBox (in category 'canvas') -----
- viewBox
-
- ^ viewBox!
Item was removed:
- ----- Method: WorldState>>viewBox: (in category 'canvas') -----
- viewBox: x
-
- viewBox := x!
Item was removed:
- (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances. "Updates menu for Windows > Find Workspace ..."'!
More information about the Packages
mailing list