The Trunk: MorphicExtras-pre.242.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
2 messages Options
Reply | Threaded
Open this post in threaded view
|

The Trunk: MorphicExtras-pre.242.mcz

commits-2
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]!


Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: MorphicExtras-pre.242.mcz

Chris Muller-3
Woo hoo, thank you!

On Tue, Jul 10, 2018 at 7:21 AM,  <[hidden email]> wrote:

> 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]!
>
>