The Trunk: EToys-mt.379.mcz

Marcel Taeumel uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-mt.379.mcz

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

Name: EToys-mt.379
Author: mt
Time: 20 February 2020, 12:09:34.55075 pm
UUID: 983b6a29-1ced-b343-9a5d-d4cd423c2c6a
Ancestors: EToys-mt.378

Some functional and visual fixes for Etoys: window title font, etoys preferences, base color for infor panels, label-edit but in sugar text fields, project history morph.

=============== Diff against EToys-mt.378 ===============

Item was changed:
  ----- Method: EToyProjectHistoryMorph>>rebuild (in category 'as yet unclassified') -----
  rebuild
 
  | history r1 |
  history := ProjectHistory currentHistory mostRecentCopy.
  changeCounter := ProjectHistory changeCounter.
  self removeAllMorphs.
+ self rubberBandCells: true.
- self rubberBandCells: false. "enable growing"
  r1 := self addARow: {
  self inAColumn: {
  StringMorph new contents: 'Jump...' translated; lock.
  }.
  }.
  r1 on: #mouseUp send: #jumpToProject to: self.
 
  history do: [ :each |
  (
  self addARow: {
+ (each second scaledToSize: 64@64) asMorph.
+ (self inARow: {
- (self inAColumn: {
- StretchyImageMorph new form: each second; minWidth: 35; minHeight: 35; lock
- }) vResizing: #spaceFill.
- self inAColumn: {
  StringMorph new contents: each first; lock.
  "StringMorph new contents: each fourth first; lock."
+ }) hResizing: #spaceFill; layoutInset: 10@0.
- }.
  (self inAColumn: {
  StringMorph new
  color: Color red;
  contents: 'X';
  on: #mouseDown send: #confirmedDelete:evt:from: to: self withValue: each fourth first
+ }) hResizing: #shrinkWrap.
- }) hResizing: #rigid.
  }
  )
  color: Color paleYellow;
  borderStyle: (BorderStyle raised width: 1);
  vResizing: #spaceFill;
  on: #mouseUp send: #mouseUp:in: to: self;
  on: #mouseDown send: #mouseDown:in: to: self;
  on: #mouseMove send: #mouseMove:in: to: self;
  on: #mouseLeave send: #mouseLeave:in: to: self;
  setProperty: #projectParametersTuple toValue: each;
  setBalloonText: (each third isEmptyOrNil ifTrue: ['not saved'] ifFalse: [each third])
  ].
  "---
  newTuple := {
  aProject name.
  aProject thumbnail.
  aProject url.
  WeakArray with: aProject.
  }.
  ---"!

Item was changed:
  ----- Method: EtoysTheme class>>create (in category 'instance creation') -----
  create
  "doIt: [self create apply.]"
 
  | themeName |
  themeName := 'Etoys'.
  ^ (self named: themeName) in: [:theme |
  theme merge: (self named: 'Squeak') overwrite: true.
  theme name: themeName.
 
  theme set: #background for: #MorphicProject to: (SolidFillStyle color: (Color r: 0.9 g: 0.9 b: 1)).
 
  theme
  set: #standardListFont to: (TTCFont familyName: 'BitstreamVeraSans' pointSize: 15 emphasis: 0);
  set: #standardFlapFont to: (TTCFont familyName: 'BitstreamVeraSans' pointSize: 15 emphasis: TextEmphasis bold emphasisCode);
 
  set: #eToysButtonFont to: (TTCFont familyName: 'BitstreamVeraSans' pointSize: 15 emphasis: 0);
  set: #eToysFont to: (TTCFont familyName: 'BitstreamVeraSans' pointSize: 15 emphasis: TextEmphasis bold emphasisCode);
  set: #eToysCodeFont to: (TTCFont familyName: 'BitstreamVeraSans' pointSize: 15 emphasis: 0);
  set: #eToysTitleFont to: (TTCFont familyName: 'BitstreamVeraSans' pointSize: 32 emphasis: 0);
  set: #paintBoxButtonFont to: (TTCFont familyName: 'BitstreamVeraSans' pointSize: 12 emphasis: 0);
  set: #standardMenuFont to: (TTCFont familyName: 'BitstreamVeraSans' pointSize: 15 emphasis: 0);
  set: #standardButtonFont to: (TTCFont familyName: 'BitstreamVeraSans' pointSize: 15 emphasis: 0);
+ set: #windowTitleFont to: (TTCFont familyName: 'BitstreamVeraSans' pointSize: 15 emphasis: TextEmphasis bold emphasisCode);
- set: #windowTitleFont to: (TTCFont familyName: 'BitstreamVeraSans' pointSize: 15 emphasis: 0);
  set: #balloonHelpFont to: (TTCFont familyName: 'BitstreamVeraSans' pointSize: 15 emphasis: 0);
  set: #connectorsLabelFont to: (TTCFont familyName: 'BitstreamVeraSans' pointSize: 15 emphasis: 0);
  set: #standardCodeFont to: (TTCFont familyName: 'BitstreamVeraSans' pointSize: 15 emphasis: 0);
  set: #standardDefaultTextFont to: (TTCFont familyName: 'BitstreamVeraSans' pointSize: 15 emphasis: 0);
  set: #standardSystemFont to: (TTCFont familyName: 'BitstreamVeraSans' pointSize: 15 emphasis: 0).
  theme]!

Item was added:
+ ----- Method: ReleaseBuilderSqueakland class>>setEtoysMode (in category 'scripts') -----
+ setEtoysMode
+ "Use this script to transform a regular Squeak image into an Etoys environment. Keep it programmer-friendly."
+
+ (UserInterfaceTheme current name beginsWith: 'Etoys')
+ ifTrue: [^ self inform: 'This environment is already\prepared for Etoys.' translated withCRs].
+
+ (Project uiManager
+ confirm: 'This step will change several preferences. The current\UI theme will be copied and Etoys fonts be installed.\\Are you sure?' translated withCRs
+ title: 'Prepare Etoys Environment' translated)
+ ifFalse: [^ self].
+
+ self intermediatePrepareForUsers.  
+
+ Preferences
+ disable: #noviceMode;  
+ enable: #generalizedYellowButtonMenu;  
+ enable: #showAdvancedNavigatorButtons;  
+ disable: #eToyFriendly.  
+
+ TheWorldMainDockingBar showWorldMainDockingBar: true.!

Item was changed:
  ----- Method: ReleaseBuilderSqueakland class>>setPreferences (in category 'scripts') -----
  setPreferences
 
  super setPreferences.
 
  [ "Reset all preferences to their default value but ensure that all control and alt keys stay duplicated."
  Preferences cambridge.
  Preferences allPreferences do: [:each |
  each defaultValue: each preferenceValue].
  Preferences
  enable: #duplicateAllControlAndAltKeys.
  ] valueSupplyingAnswer: true.
 
  Preferences
  disable: #alternativeWindowBoxesLook;
  enable: #magicHalos;
  enable: #mouseOverHalos;
  enable: #showAdvancedNavigatorButtons;
  disable: #honorDesktopCmdKeys;
  enable: #unlimitedPaintArea;
  enable: #fastDragWindowForMorphic;
  enable: #noviceMode;
  disable: #generalizedYellowButtonMenu;
  disable: #signProjectFiles;
+ enable: #alwaysHideHScrollBar;
+ enable: #alwaysShowVScrollBar. "For the menu button."
+ ScrollBar scrollBarsWithoutMenuButton: false.
+ ScrollBar scrollBarsWithoutArrowButtons: false.
- enable: #alwaysShowHScrollBar;
- enable: #alwaysShowVScrollBar.
 
  "Rounded corners."
  Morph preferredCornerRadius: 8.
  PluggableButtonMorph roundedButtonCorners: true.
  DialogWindow roundedDialogCorners: true.
  SystemWindow roundedWindowCorners: true.
  ScrollBar roundedScrollBarLook: true.
 
  Cursor useBiggerCursors: true.
  TrashCanMorph
  slideDismissalsToTrash: true;
  preserveTrash: true.
  SugarNavigatorBar
  showHideButton: false;
  showSugarNavigator: true.
  Preferences disable: #showAdvancedNavigatorButtons.
  TileMorph usePopUpArrows: true.
+ Morph indicateKeyboardFocus: false.
 
  "Ignore warnings."
  Deprecation showDeprecationWarnings: false.
  Preferences
  disable: #warnIfChangesFileReadOnly;
  disable: #warnIfNoChangesFile;
  disable: #warnIfNoSourcesFile.
  !

Item was changed:
  ----- Method: StandardScriptingSystem>>baseColor (in category '*Etoys-Squeakland-tile colors') -----
  baseColor
+ ^  (Color r: 0.674 g: 0.91 b: 0.47)!
- ^  (UserInterfaceTheme current get: #titleColor for: #MenuMorph) ifNil: [ Color transparent]!

Item was changed:
  ----- Method: StandardScriptingSystem>>openInfoFlapWithLabel:helpContents:edge: (in category '*Etoys-Squeakland-help in a flap') -----
  openInfoFlapWithLabel: aTitle helpContents: aString edge: anEdge
  "Open an info flap with the given label, contents, and edge"
 
  | aPlug outer leftStrip rightStrip titleRow aDismissButton aFlapTab |
 
  Preferences enable: #scrollBarsOnRight.
  Preferences enable: #inboardScrollbars.
 
  aFlapTab := FlapTab new.
  aFlapTab assureExtension visible: false.
  aFlapTab referentMargin: (0 @ ActiveWorld sugarAllowance).
 
  outer := HelpFlap newRow.
  outer assureExtension visible: false.
  outer clipSubmorphs: true.
  outer beTransparent.
  outer vResizing: #spaceFill; hResizing: #spaceFill.
  outer layoutInset: 0; cellInset: 0; borderWidth: 0.
  outer setProperty: #morphicLayerNumber toValue: 26.
 
  leftStrip := Morph new beTransparent.
  leftStrip layoutInset: 0; cellInset: 0; borderWidth: 0.
  leftStrip width:  20.
  leftStrip hResizing: #rigid; vResizing: #spaceFill.
  outer addMorphBack: leftStrip.
 
  rightStrip := AlignmentMorph newColumn.
  rightStrip beTransparent.
  rightStrip layoutInset: 0; cellInset: 0; borderWidth: 0.
  outer addMorphBack: rightStrip.
  outer clipSubmorphs: true.
 
  titleRow := AlignmentMorph newRow.
  titleRow borderColor: Color veryVeryLightGray; borderWidth: 1.
  titleRow hResizing: #spaceFill; vResizing: #shrinkWrap.
  titleRow beTransparent.
  aDismissButton := aFlapTab tanOButton.
  aDismissButton actionSelector: #dismissViaHalo.
  titleRow addMorphFront: aDismissButton.
  titleRow addTransparentSpacerOfSize: 8 @ 0.
  titleRow
  addMorphBack: (StringMorph contents: aTitle font:  Preferences standardEToysTitleFont).
  rightStrip addMorph: titleRow.
 
  aPlug := PluggableTextMorph new.
  aPlug width: 540.
  aPlug setText: aString.
  aPlug textMorph beAllFont: Preferences standardEToysFont.
  aPlug retractable: false; scrollBarOnLeft: false.
+ aPlug hScrollBarPolicy: #never.
- aPlug hideHScrollBarIndefinitely: true.
  aPlug borderColor: ScriptingSystem borderColor.
  aPlug setNameTo: aTitle.
  aPlug hResizing: #spaceFill.
  aPlug vResizing: #spaceFill.
  rightStrip addMorphBack: aPlug.
  aFlapTab referent ifNotNil: [aFlapTab referent delete].
  aFlapTab referent: outer.
  aFlapTab setName: aTitle edge: anEdge color: (Color r: 0.677 g: 0.935 b: 0.484).
  aFlapTab submorphs first beAllFont: Preferences standardEToysFont.
  ActiveWorld addMorphFront: aFlapTab.
  aFlapTab adaptToWorld: ActiveWorld.
  aFlapTab computeEdgeFraction.
 
  anEdge == #left ifTrue:
  [aFlapTab position: (outer left @ outer top).
  outer extent: (540 @ ActiveWorld height)].
  anEdge == #right ifTrue:
  [aFlapTab position: ((ActiveWorld right - aFlapTab width) @ ActiveWorld top).
  outer extent: (540 @ ActiveWorld height)].
 
  outer beFlap: true.
  outer color: Color green veryMuchLighter.
 
  aPlug textMorph lock.
  aFlapTab referent hide.
  aFlapTab openFully.
 
  outer beSticky.
  leftStrip beSticky.
  rightStrip beSticky.
 
  ActiveWorld doOneCycle.
  aPlug width: 540.
  aPlug setText: aString. "hmm, again"
 
  aPlug color: outer color.
 
  aPlug borderWidth: 0.
 
  aPlug textMorph contents: aString wrappedTo: 520.
  aFlapTab applyThickness: 560.
  aFlapTab fitOnScreen.
  aFlapTab referent show.
  ^ aFlapTab!

Item was changed:
  ----- Method: StandardScriptingSystem>>putUpInfoPanelFor:title:extent: (in category '*Etoys-Squeakland-utilities') -----
  putUpInfoPanelFor: aString title: aTitle extent: anExtent
  "Put up a dismissable help panel showing the given string, with the given extent; the panel will have a slim title bar at top, by which it can be dragged, as well as dismissed."
 
+ | aPlug outer |
- | aPlug outer wasOnRight wasInboard |
 
- wasOnRight := Preferences scrollBarsOnRight.
- wasInboard := Preferences inboardScrollbars.
- Preferences enable: #scrollBarsOnRight.
- Preferences enable: #inboardScrollbars.
  aPlug := PluggableTextMorph new.
  aPlug extent: anExtent.
  aPlug color: Color white.
  aPlug setText: aString.
+ aPlug hScrollBarPolicy: #never.
+ aPlug vScrollBarPolicy: #whenNeeded.
+ aPlug wrapFlag: true.
- aPlug textMorph beAllFont: Preferences standardEToysFont.
- aPlug retractable: false; scrollBarOnLeft: false.
- aPlug hideHScrollBarIndefinitely: true.
  aPlug borderWidth: 0.
  aPlug borderColor: ScriptingSystem borderColor.
  aPlug setNameTo: aTitle.
 
  outer := self buildPanelTitled: aTitle.
  outer addMorphBack: aPlug.
  aPlug textMorph lock.
 
  outer openInWorld.
- outer center: ActiveWorld center.
- outer top: (ActiveWorld top + 10).
 
- wasOnRight ifFalse: [Preferences disable: #scrollBarsOnRight].
- wasInboard ifFalse: [Preferences disable: #inboardScrollbars].
-
- "The two lines below are force the scroll bar to recompute..."
- ActiveWorld doOneCycle.
- aPlug setText: aString
-
  "
  ScriptingSystem putUpInfoPanelFor: AllScriptsTool new helpString title: 'Testing One Two Three' extent: 800@600.
  "!

Item was changed:
  ----- Method: SugarRoundedField>>resizeLabel (in category 'as yet unclassified') -----
  resizeLabel
 
  | small |
+ (label notNil and: [label hasFocus not]) ifTrue: [
- label ifNotNil: [
  label width: self width - 10.
  small :=self height < 45.
  label label: ActiveWorld project name font: (StrikeFont familyName: 'BitstreamVeraSans' size: (small ifTrue: [15] ifFalse: [24])).
  label center: self center.
  label left: self left + 10.
  self addMorph: label.
  ].
  !