[Pkg] The Trunk: MorphicExtras-pre.242.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Jul 10 12:21:26 UTC 2018
Patrick Rein uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-pre.242.mcz
==================== Summary ====================
Name: MorphicExtras-pre.242
Author: pre
Time: 10 July 2018, 2:20:31.299227 pm
UUID: faafe72b-0932-ae48-86bb-38dd0e666b0d
Ancestors: MorphicExtras-bf.241
Makes the objects tool themeable (at least parts of it)
=============== Diff against MorphicExtras-bf.241 ===============
Item was added:
+ ----- Method: ObjectsTool>>baseBackgroundColor (in category 'constants') -----
+ baseBackgroundColor
+
+ ^ self userInterfaceTheme borderColor ifNil: [Color veryLightGray] !
Item was added:
+ ----- Method: ObjectsTool>>baseBorderColor (in category 'constants') -----
+ baseBorderColor
+
+ ^ self userInterfaceTheme borderColor ifNil: [Color veryLightGray] !
Item was changed:
----- Method: ObjectsTool>>buttonActiveColor (in category 'constants') -----
buttonActiveColor
+ ^ self userInterfaceTheme selectionTextColor ifNil: [Color white]!
- ^ Color white!
Item was changed:
----- Method: ObjectsTool>>buttonColor (in category 'constants') -----
buttonColor
+ ^ self userInterfaceTheme textColor ifNil: [Color black]!
- ^ Color black!
Item was changed:
----- Method: ObjectsTool>>extent: (in category 'layout') -----
extent: anExtent
"The user has dragged the grow box such that the receiver's extent would be anExtent. Do what's needed"
- self extent = anExtent ifTrue: [ ^self ].
super extent: anExtent.
+ self submorphsDo: [:m |
+ m width: anExtent x]!
- self fixLayoutFrames.!
Item was changed:
----- Method: ObjectsTool>>fixLayoutFrames (in category 'layout') -----
fixLayoutFrames
"Adjust the boundary between the tabs or search pane and the parts bin, giving preference to the tabs."
+ | oldY newY aTabsPane aTabsPaneHeight |
+ oldY := ((aTabsPane := self tabsPane
- | oldY newY tp tpHeight |
- oldY := ((tp := self tabsPane
ifNil: [self searchPane])
ifNil: [^ self]) layoutFrame bottomOffset.
+ aTabsPaneHeight := aTabsPane hasSubmorphs
+ ifTrue: [(aTabsPane submorphBounds outsetBy: aTabsPane layoutInset) height]
+ ifFalse: [aTabsPane height].
+ newY := (self buttonPane ifNil: [^ self]) height + aTabsPaneHeight.
+ oldY = newY ifTrue: [^ self].
+ aTabsPane layoutFrame bottomOffset: newY.
+ (self partsBin ifNil: [^ self]) layoutFrame topOffset: newY.
+ submorphs do: [:m | m layoutChanged]!
- tpHeight := tp hasSubmorphs
- ifTrue: [(tp submorphBounds outsetBy: tp layoutInset) height]
- ifFalse: [tp height].
- newY := (self buttonPane
- ifNil: [^ self]) height + tpHeight.
- oldY = newY
- ifTrue: [^ self].
- tp layoutFrame bottomOffset: newY.
- (self partsBin
- ifNil: [^ self]) layoutFrame topOffset: newY.
- submorphs
- do: [:m | m layoutChanged ]!
Item was changed:
----- Method: ObjectsTool>>initializeToStandAlone (in category 'initialization') -----
initializeToStandAlone
"Initialize the receiver so that it can live as a stand-alone morph"
| buttonPane aBin aColor heights tabsPane |
self basicInitialize.
+
-
self layoutInset: 0;
layoutPolicy: ProportionalLayout new;
useRoundedCorners;
hResizing: #rigid;
vResizing: #rigid;
extent: (self minimumWidth @ self minimumHeight).
"mode buttons"
buttonPane := self paneForTabs: self modeTabs.
+ buttonPane color: self baseBackgroundColor.
- buttonPane color: (Color r: 1 g: 0.85 b: 0.975).
buttonPane
vResizing: #shrinkWrap;
setNameTo: 'ButtonPane';
addMorphFront: self dismissButton;
addMorphBack: self helpButton;
color: (aColor := buttonPane color) darker;
layoutInset: 5;
wrapDirection: nil;
width: self width;
layoutChanged; fullBounds.
"Place holder for a tabs or text pane"
tabsPane := Morph new.
tabsPane
+ color: self baseBackgroundColor;
- color: (Color r: 1 g: 0.85 b: 0.975);
setNameTo: 'TabPane';
hResizing: #spaceFill.
heights := { buttonPane height. 40 }.
buttonPane vResizing: #spaceFill.
self
addMorph: buttonPane
fullFrame: (LayoutFrame
fractions: (0 @ 0 corner: 1 @ 0)
offsets: (0 @ 0 corner: 0 @ heights first)).
self
addMorph: tabsPane
fullFrame: (LayoutFrame
fractions: (0 @ 0 corner: 1 @ 0)
offsets: (0 @ heights first corner: 0 @ (heights first + heights second))).
aBin := (PartsBin newPartsBinWithOrientation: #leftToRight from: #())
+ changeTableLayout;
listDirection: #leftToRight;
wrapDirection: #topToBottom;
color: aColor lighter lighter;
+ borderColor: aColor lighter lighter;
setNameTo: 'Parts';
dropEnabled: false;
vResizing: #spaceFill;
yourself.
self
addMorph: aBin
fullFrame: (LayoutFrame
fractions: (0 @ 0 corner: 1 @ 1)
offsets: (0 @ (heights first + heights second) corner: 0 @ 0)).
self
borderWidth: 1;
+ borderColor: self baseBorderColor;
+ color: self baseBackgroundColor;
- borderColor: (Color r: 0.9 g: 0.801 b: 0.2);
- color: (Color r: 1 g: 0.85 b: 0.975);
setNameTo: 'Objects' translated;
showCategories.
!
Item was changed:
----- Method: ObjectsTool>>paneForTabs: (in category 'tabs') -----
paneForTabs: tabList
"Answer a pane bearing tabs for the given list"
| aPane |
tabList do: [:t |
t color: Color transparent.
t borderWidth: 1;
borderColor: Color black].
+ aPane := Morph new
+ changeTableLayout;
+ color: self baseBackgroundColor;
- aPane := AlignmentMorph newRow
- color: (Color r: 1 g: 0.85 b: 0.975);
listDirection: #leftToRight;
wrapDirection: #topToBottom;
vResizing: #spaceFill;
hResizing: #spaceFill;
cellInset: 6;
layoutInset: 4;
listCentering: #center;
listSpacing: #equal;
addAllMorphs: tabList;
yourself.
aPane width: self layoutBounds width.
^ aPane!
Item was changed:
----- Method: PartsBin>>listDirection:quadList:buttonClass: (in category 'initialization') -----
listDirection: aListDirection quadList: quadList buttonClass: buttonClass
"Initialize the receiver to run horizontally or vertically, obtaining its elements from the list of tuples of the form:
(<receiver> <selector> <label> <balloonHelp>)
Used by external package Connectors."
self layoutPolicy: TableLayout new.
self listDirection: aListDirection.
self wrapCentering: #topLeft.
self layoutInset: 2.
self cellPositioning: #bottomCenter.
aListDirection == #leftToRight
ifTrue:
[self vResizing: #rigid.
self hResizing: #spaceFill.
self wrapDirection: #topToBottom]
ifFalse:
[self hResizing: #rigid.
self vResizing: #spaceFill.
self wrapDirection: #leftToRight].
quadList do:
[:tuple |
| aButton aClass |
aClass := Smalltalk at: tuple first.
+ aButton := buttonClass new
+ initializeWithThumbnail: (self class thumbnailForQuad: tuple color: self color) withLabel: tuple third
+ andColor: self color
+ andSend: tuple second
+ to: aClass.
- aButton := buttonClass new initializeWithThumbnail: (self class thumbnailForQuad: tuple color: self color) withLabel: tuple third andColor: self color andSend: tuple second to: aClass.
(tuple size > 3 and: [tuple fourth isEmptyOrNil not]) ifTrue:
[aButton setBalloonText: tuple fourth].
self addMorphBack: aButton]!
More information about the Packages
mailing list