The Inbox: Morphic-dtl.1360.mcz

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

The Inbox: Morphic-dtl.1360.mcz

commits-2
David T. Lewis uploaded a new version of Morphic to project The Inbox:
http://source.squeak.org/inbox/Morphic-dtl.1360.mcz

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

Name: Morphic-dtl.1360
Author: dtl
Time: 11 November 2017, 4:04:34.153784 pm
UUID: 0e1f3870-5f57-4dc6-a1e7-5d8ce68b71b5
Ancestors: Morphic-dtl.1359

World global elimination. Once the current project has been entered, Project current world == World. Begin eliminating references to the global variable World in cases where it is not required.

=============== Diff against Morphic-dtl.1359 ===============

Item was changed:
  ----- Method: ComplexProgressIndicator>>backgroundWorldDisplay (in category 'as yet unclassified') -----
  backgroundWorldDisplay
 
  self flag: #bob. "really need a better way to do this"
 
  "World displayWorldSafely."
 
  "ugliness to try to track down a possible error"
 
 
+ [Project current world displayWorld] ifError: [ :a :b |
- [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 changed:
  ----- Method: Debugger class>>morphicOpenInterrupt:onProcess: (in category '*Morphic-opening') -----
  morphicOpenInterrupt: aString onProcess: interruptedProcess
  "Open a notifier in response to an interrupt. An interrupt occurs when the user types the interrupt key (cmd-. on Macs, ctrl-c or alt-. on other systems) or when the low-space watcher detects that memory is low."
  | debugger |
  <primitive: 19> "Simulation guard"
  debugger := self new.
  debugger
  process: interruptedProcess
  controller: nil
  context: interruptedProcess suspendedContext.
  debugger externalInterrupt: true.
 
  Preferences logDebuggerStackToFile ifTrue:
  [(aString includesSubstring: 'Space') & (aString includesSubstring: 'low')
  ifTrue: [Smalltalk logError: aString inContext: debugger interruptedContext to: 'LowSpaceDebug.log']
  "logging disabled for 4.3 release, see
  http://lists.squeak.org/pipermail/squeak-dev/2011-December/162503.html"
  "ifFalse: [Smalltalk logSqueakError: aString inContext: debugger interruptedContext]"].
 
+ Preferences eToyFriendly ifTrue: [Project current world stopRunningAll].
- Preferences eToyFriendly ifTrue: [World stopRunningAll].
  ^debugger
  openNotifierContents: nil label: aString;
  yourself
  !

Item was changed:
  ----- 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 := Project current world drawingClass withForm: f].
- newMorph := World drawingClass withForm: f].
  newMorph setProperty: #resourceFilePath toValue: pathName.
  self owner replaceSubmorph: self by: newMorph!

Item was changed:
  ----- Method: MorphHierarchyListMorph>>createContainer (in category 'private') -----
  createContainer
  "Private - Create a container"
  | container |
  container := BorderedMorph new.
+ container extent: (Project current world extent * (1 / 4 @ (2 / 3))) rounded.
- container extent: (World extent * (1 / 4 @ (2 / 3))) rounded.
  container layoutPolicy: TableLayout new.
  container hResizing: #rigid.
  container vResizing: #rigid.
  container
  setColor: (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 changed:
  ----- 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. ***"
 
  | is sizeHint |
+ (Project current world == world) ifTrue: [^ false].
- (World == 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.
  World 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 changed:
  ----- 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 |
+ (Project current world == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'."
- (World == 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"
  World flapTabs do: [:ft | ft referent adaptToWorld: World].
  "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.
  World 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 changed:
  ----- 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]]]!
- [[Sensor peekPosition y > 0] whileTrue: [World doOneCycle]]]!

Item was changed:
  ----- 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]]]!
- [[Sensor peekPosition y > 0] whileTrue: [World doOneCycle]]]!


Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Morphic-dtl.1360.mcz

David T. Lewis
I think that it should be possible to eliminate World as a global without
hurting performance. The code gets more verbose, but it reduces opportunities
for hidden bugs, so I think it is worth the tradeoff.

I have to admit that the subject of "World global elimination" sounds a bit
ominous, so I decided to put Morphic-dtl.1360 and MorphicExtras-dtl.214 in
the inbox first ;-)

Are there any objections to proceding in this direction? If not I will move
the changes to trunk in day or two.

Dave



On Sat, Nov 11, 2017 at 09:04:49PM +0000, [hidden email] wrote:

> David T. Lewis uploaded a new version of Morphic to project The Inbox:
> http://source.squeak.org/inbox/Morphic-dtl.1360.mcz
>
> ==================== Summary ====================
>
> Name: Morphic-dtl.1360
> Author: dtl
> Time: 11 November 2017, 4:04:34.153784 pm
> UUID: 0e1f3870-5f57-4dc6-a1e7-5d8ce68b71b5
> Ancestors: Morphic-dtl.1359
>
> World global elimination. Once the current project has been entered, Project current world == World. Begin eliminating references to the global variable World in cases where it is not required.
>
> =============== Diff against Morphic-dtl.1359 ===============
>
> Item was changed:
>   ----- Method: ComplexProgressIndicator>>backgroundWorldDisplay (in category 'as yet unclassified') -----
>   backgroundWorldDisplay
>  
>   self flag: #bob. "really need a better way to do this"
>  
>   "World displayWorldSafely."
>  
>   "ugliness to try to track down a possible error"
>  
>  
> + [Project current world displayWorld] ifError: [ :a :b |
> - [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 changed:
>   ----- Method: Debugger class>>morphicOpenInterrupt:onProcess: (in category '*Morphic-opening') -----
>   morphicOpenInterrupt: aString onProcess: interruptedProcess
>   "Open a notifier in response to an interrupt. An interrupt occurs when the user types the interrupt key (cmd-. on Macs, ctrl-c or alt-. on other systems) or when the low-space watcher detects that memory is low."
>   | debugger |
>   <primitive: 19> "Simulation guard"
>   debugger := self new.
>   debugger
>   process: interruptedProcess
>   controller: nil
>   context: interruptedProcess suspendedContext.
>   debugger externalInterrupt: true.
>  
>   Preferences logDebuggerStackToFile ifTrue:
>   [(aString includesSubstring: 'Space') & (aString includesSubstring: 'low')
>   ifTrue: [Smalltalk logError: aString inContext: debugger interruptedContext to: 'LowSpaceDebug.log']
>   "logging disabled for 4.3 release, see
>   http://lists.squeak.org/pipermail/squeak-dev/2011-December/162503.html"
>   "ifFalse: [Smalltalk logSqueakError: aString inContext: debugger interruptedContext]"].
>  
> + Preferences eToyFriendly ifTrue: [Project current world stopRunningAll].
> - Preferences eToyFriendly ifTrue: [World stopRunningAll].
>   ^debugger
>   openNotifierContents: nil label: aString;
>   yourself
>   !
>
> Item was changed:
>   ----- 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 := Project current world drawingClass withForm: f].
> - newMorph := World drawingClass withForm: f].
>   newMorph setProperty: #resourceFilePath toValue: pathName.
>   self owner replaceSubmorph: self by: newMorph!
>
> Item was changed:
>   ----- Method: MorphHierarchyListMorph>>createContainer (in category 'private') -----
>   createContainer
>   "Private - Create a container"
>   | container |
>   container := BorderedMorph new.
> + container extent: (Project current world extent * (1 / 4 @ (2 / 3))) rounded.
> - container extent: (World extent * (1 / 4 @ (2 / 3))) rounded.
>   container layoutPolicy: TableLayout new.
>   container hResizing: #rigid.
>   container vResizing: #rigid.
>   container
>   setColor: (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 changed:
>   ----- 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. ***"
>  
>   | is sizeHint |
> + (Project current world == world) ifTrue: [^ false].
> - (World == 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.
>   World 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 changed:
>   ----- 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 |
> + (Project current world == world) ifTrue: [^ self]. " inform: 'Can''t send the current world out'."
> - (World == 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"
>   World flapTabs do: [:ft | ft referent adaptToWorld: World].
>   "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.
>   World 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 changed:
>   ----- 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]]]!
> - [[Sensor peekPosition y > 0] whileTrue: [World doOneCycle]]]!
>
> Item was changed:
>   ----- 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]]]!
> - [[Sensor peekPosition y > 0] whileTrue: [World doOneCycle]]]!
>
>

Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Morphic-dtl.1360.mcz

Hannes Hirzel
Eliminsating the access to the global 'World' is fine.

But what about

    self world

instead of

     Project current world

Or is it an issue of speed?

--Hannes

On 11/11/17, David T. Lewis <[hidden email]> wrote:

> I think that it should be possible to eliminate World as a global without
> hurting performance. The code gets more verbose, but it reduces
> opportunities
> for hidden bugs, so I think it is worth the tradeoff.
>
> I have to admit that the subject of "World global elimination" sounds a bit
> ominous, so I decided to put Morphic-dtl.1360 and MorphicExtras-dtl.214 in
> the inbox first ;-)
>
> Are there any objections to proceding in this direction? If not I will move
> the changes to trunk in day or two.
>
> Dave
>
>
>
> On Sat, Nov 11, 2017 at 09:04:49PM +0000, [hidden email] wrote:
>> David T. Lewis uploaded a new version of Morphic to project The Inbox:
>> http://source.squeak.org/inbox/Morphic-dtl.1360.mcz
>>
>> ==================== Summary ====================
>>
>> Name: Morphic-dtl.1360
>> Author: dtl
>> Time: 11 November 2017, 4:04:34.153784 pm
>> UUID: 0e1f3870-5f57-4dc6-a1e7-5d8ce68b71b5
>> Ancestors: Morphic-dtl.1359
>>
>> World global elimination. Once the current project has been entered,
>> Project current world == World. Begin eliminating references to the global
>> variable World in cases where it is not required.
>>
>> =============== Diff against Morphic-dtl.1359 ===============
>>
>> Item was changed:
>>   ----- Method: ComplexProgressIndicator>>backgroundWorldDisplay (in
>> category 'as yet unclassified') -----
>>   backgroundWorldDisplay
>>
>>   self flag: #bob. "really need a better way to do this"
>>
>>   "World displayWorldSafely."
>>
>>   "ugliness to try to track down a possible error"
>>
>>
>> + [Project current world displayWorld] ifError: [ :a :b |
>> - [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 changed:
>>   ----- Method: Debugger class>>morphicOpenInterrupt:onProcess: (in
>> category '*Morphic-opening') -----
>>   morphicOpenInterrupt: aString onProcess: interruptedProcess
>>   "Open a notifier in response to an interrupt. An interrupt occurs when
>> the user types the interrupt key (cmd-. on Macs, ctrl-c or alt-. on other
>> systems) or when the low-space watcher detects that memory is low."
>>   | debugger |
>>   <primitive: 19> "Simulation guard"
>>   debugger := self new.
>>   debugger
>>   process: interruptedProcess
>>   controller: nil
>>   context: interruptedProcess suspendedContext.
>>   debugger externalInterrupt: true.
>>
>>   Preferences logDebuggerStackToFile ifTrue:
>>   [(aString includesSubstring: 'Space') & (aString includesSubstring:
>> 'low')
>>   ifTrue: [Smalltalk logError: aString inContext: debugger
>> interruptedContext to: 'LowSpaceDebug.log']
>>   "logging disabled for 4.3 release, see
>>
>> http://lists.squeak.org/pipermail/squeak-dev/2011-December/162503.html"
>>   "ifFalse: [Smalltalk logSqueakError: aString inContext: debugger
>> interruptedContext]"].
>>
>> + Preferences eToyFriendly ifTrue: [Project current world
>> stopRunningAll].
>> - Preferences eToyFriendly ifTrue: [World stopRunningAll].
>>   ^debugger
>>   openNotifierContents: nil label: aString;
>>   yourself
>>   !
>>
>> Item was changed:
>>   ----- 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 := Project current world drawingClass withForm: f].
>> - newMorph := World drawingClass withForm: f].
>>   newMorph setProperty: #resourceFilePath toValue: pathName.
>>   self owner replaceSubmorph: self by: newMorph!
>>
>> Item was changed:
>>   ----- Method: MorphHierarchyListMorph>>createContainer (in category
>> 'private') -----
>>   createContainer
>>   "Private - Create a container"
>>   | container |
>>   container := BorderedMorph new.
>> + container extent: (Project current world extent * (1 / 4 @ (2 / 3)))
>> rounded.
>> - container extent: (World extent * (1 / 4 @ (2 / 3))) rounded.
>>   container layoutPolicy: TableLayout new.
>>   container hResizing: #rigid.
>>   container vResizing: #rigid.
>>   container
>>   setColor: (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 changed:
>>   ----- 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. ***"
>>
>>   | is sizeHint |
>> + (Project current world == world) ifTrue: [^ false].
>> - (World == 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.
>>   World 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 changed:
>>   ----- 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 |
>> + (Project current world == world) ifTrue: [^ self]. " inform: 'Can''t
>> send the current world out'."
>> - (World == 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"
>>   World flapTabs do: [:ft | ft referent adaptToWorld: World].
>>   "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.
>>   World 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 changed:
>>   ----- 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]]]!
>> - [[Sensor peekPosition y > 0] whileTrue: [World doOneCycle]]]!
>>
>> Item was changed:
>>   ----- 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]]]!
>> - [[Sensor peekPosition y > 0] whileTrue: [World doOneCycle]]]!
>>
>>
>
>

Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Morphic-dtl.1360.mcz

David T. Lewis
Hi Hannes,

The "self world" expression works for morphs, and certainly it is easier to read.
It may be somewhat slower, although that would not be a concern in most usages.

My main concern is correctness, because failures in this area can hang up the
UI entirely, and errors are difficult to debug.

When transitioning from one project to another the World variable is set to
the new project's world in #finalEnterActions:.  Thus the World global is a
shortcut reference to the world of the current project, and that is what leads
me to suggest the expression "Project current world".

Dave


On Sun, Nov 12, 2017 at 04:48:55AM +0100, H. Hirzel wrote:

> Eliminsating the access to the global 'World' is fine.
>
> But what about
>
>     self world
>
> instead of
>
>      Project current world
>
> Or is it an issue of speed?
>
> --Hannes
>
> On 11/11/17, David T. Lewis <[hidden email]> wrote:
> > I think that it should be possible to eliminate World as a global without
> > hurting performance. The code gets more verbose, but it reduces
> > opportunities
> > for hidden bugs, so I think it is worth the tradeoff.
> >
> > I have to admit that the subject of "World global elimination" sounds a bit
> > ominous, so I decided to put Morphic-dtl.1360 and MorphicExtras-dtl.214 in
> > the inbox first ;-)
> >
> > Are there any objections to proceding in this direction? If not I will move
> > the changes to trunk in day or two.
> >
> > Dave
> >
> >
> >
> > On Sat, Nov 11, 2017 at 09:04:49PM +0000, [hidden email] wrote:
> >> David T. Lewis uploaded a new version of Morphic to project The Inbox:
> >> http://source.squeak.org/inbox/Morphic-dtl.1360.mcz
> >>
> >> ==================== Summary ====================
> >>
> >> Name: Morphic-dtl.1360
> >> Author: dtl
> >> Time: 11 November 2017, 4:04:34.153784 pm
> >> UUID: 0e1f3870-5f57-4dc6-a1e7-5d8ce68b71b5
> >> Ancestors: Morphic-dtl.1359
> >>
> >> World global elimination. Once the current project has been entered,
> >> Project current world == World. Begin eliminating references to the global
> >> variable World in cases where it is not required.
> >>
> >> =============== Diff against Morphic-dtl.1359 ===============
> >>
> >> Item was changed:
> >>   ----- Method: ComplexProgressIndicator>>backgroundWorldDisplay (in
> >> category 'as yet unclassified') -----
> >>   backgroundWorldDisplay
> >>
> >>   self flag: #bob. "really need a better way to do this"
> >>
> >>   "World displayWorldSafely."
> >>
> >>   "ugliness to try to track down a possible error"
> >>
> >>
> >> + [Project current world displayWorld] ifError: [ :a :b |
> >> - [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 changed:
> >>   ----- Method: Debugger class>>morphicOpenInterrupt:onProcess: (in
> >> category '*Morphic-opening') -----
> >>   morphicOpenInterrupt: aString onProcess: interruptedProcess
> >>   "Open a notifier in response to an interrupt. An interrupt occurs when
> >> the user types the interrupt key (cmd-. on Macs, ctrl-c or alt-. on other
> >> systems) or when the low-space watcher detects that memory is low."
> >>   | debugger |
> >>   <primitive: 19> "Simulation guard"
> >>   debugger := self new.
> >>   debugger
> >>   process: interruptedProcess
> >>   controller: nil
> >>   context: interruptedProcess suspendedContext.
> >>   debugger externalInterrupt: true.
> >>
> >>   Preferences logDebuggerStackToFile ifTrue:
> >>   [(aString includesSubstring: 'Space') & (aString includesSubstring:
> >> 'low')
> >>   ifTrue: [Smalltalk logError: aString inContext: debugger
> >> interruptedContext to: 'LowSpaceDebug.log']
> >>   "logging disabled for 4.3 release, see
> >>
> >> http://lists.squeak.org/pipermail/squeak-dev/2011-December/162503.html"
> >>   "ifFalse: [Smalltalk logSqueakError: aString inContext: debugger
> >> interruptedContext]"].
> >>
> >> + Preferences eToyFriendly ifTrue: [Project current world
> >> stopRunningAll].
> >> - Preferences eToyFriendly ifTrue: [World stopRunningAll].
> >>   ^debugger
> >>   openNotifierContents: nil label: aString;
> >>   yourself
> >>   !
> >>
> >> Item was changed:
> >>   ----- 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 := Project current world drawingClass withForm: f].
> >> - newMorph := World drawingClass withForm: f].
> >>   newMorph setProperty: #resourceFilePath toValue: pathName.
> >>   self owner replaceSubmorph: self by: newMorph!
> >>
> >> Item was changed:
> >>   ----- Method: MorphHierarchyListMorph>>createContainer (in category
> >> 'private') -----
> >>   createContainer
> >>   "Private - Create a container"
> >>   | container |
> >>   container := BorderedMorph new.
> >> + container extent: (Project current world extent * (1 / 4 @ (2 / 3)))
> >> rounded.
> >> - container extent: (World extent * (1 / 4 @ (2 / 3))) rounded.
> >>   container layoutPolicy: TableLayout new.
> >>   container hResizing: #rigid.
> >>   container vResizing: #rigid.
> >>   container
> >>   setColor: (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 changed:
> >>   ----- 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. ***"
> >>
> >>   | is sizeHint |
> >> + (Project current world == world) ifTrue: [^ false].
> >> - (World == 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.
> >>   World 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 changed:
> >>   ----- 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 |
> >> + (Project current world == world) ifTrue: [^ self]. " inform: 'Can''t
> >> send the current world out'."
> >> - (World == 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"
> >>   World flapTabs do: [:ft | ft referent adaptToWorld: World].
> >>   "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.
> >>   World 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 changed:
> >>   ----- 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]]]!
> >> - [[Sensor peekPosition y > 0] whileTrue: [World doOneCycle]]]!
> >>
> >> Item was changed:
> >>   ----- 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]]]!
> >> - [[Sensor peekPosition y > 0] whileTrue: [World doOneCycle]]]!
> >>
> >>
> >
> >
>

Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Morphic-dtl.1360.mcz

marcel.taeumel
Hi, there.

All "global" or "class-side" or "non-morphic" methods should use "Project current world" if required. Else, use "self world". For example "MorphHierarchyListMorph>>createContainer" should really use "self world".

Best,
Marcel

Am 12.11.2017 16:11:16 schrieb David T. Lewis <[hidden email]>:

Hi Hannes,

The "self world" expression works for morphs, and certainly it is easier to read.
It may be somewhat slower, although that would not be a concern in most usages.

My main concern is correctness, because failures in this area can hang up the
UI entirely, and errors are difficult to debug.

When transitioning from one project to another the World variable is set to
the new project's world in #finalEnterActions:. Thus the World global is a
shortcut reference to the world of the current project, and that is what leads
me to suggest the expression "Project current world".

Dave


On Sun, Nov 12, 2017 at 04:48:55AM +0100, H. Hirzel wrote:
> Eliminsating the access to the global 'World' is fine.
>
> But what about
>
> self world
>
> instead of
>
> Project current world
>
> Or is it an issue of speed?
>
> --Hannes
>
> On 11/11/17, David T. Lewis wrote:
> > I think that it should be possible to eliminate World as a global without
> > hurting performance. The code gets more verbose, but it reduces
> > opportunities
> > for hidden bugs, so I think it is worth the tradeoff.
> >
> > I have to admit that the subject of "World global elimination" sounds a bit
> > ominous, so I decided to put Morphic-dtl.1360 and MorphicExtras-dtl.214 in
> > the inbox first ;-)
> >
> > Are there any objections to proceding in this direction? If not I will move
> > the changes to trunk in day or two.
> >
> > Dave
> >
> >
> >
> > On Sat, Nov 11, 2017 at 09:04:49PM +0000, [hidden email] wrote:
> >> David T. Lewis uploaded a new version of Morphic to project The Inbox:
> >> http://source.squeak.org/inbox/Morphic-dtl.1360.mcz
> >>
> >> ==================== Summary ====================
> >>
> >> Name: Morphic-dtl.1360
> >> Author: dtl
> >> Time: 11 November 2017, 4:04:34.153784 pm
> >> UUID: 0e1f3870-5f57-4dc6-a1e7-5d8ce68b71b5
> >> Ancestors: Morphic-dtl.1359
> >>
> >> World global elimination. Once the current project has been entered,
> >> Project current world == World. Begin eliminating references to the global
> >> variable World in cases where it is not required.
> >>
> >> =============== Diff against Morphic-dtl.1359 ===============
> >>
> >> Item was changed:
> >> ----- Method: ComplexProgressIndicator>>backgroundWorldDisplay (in
> >> category 'as yet unclassified') -----
> >> backgroundWorldDisplay
> >>
> >> self flag: #bob. "really need a better way to do this"
> >>
> >> "World displayWorldSafely."
> >>
> >> "ugliness to try to track down a possible error"
> >>
> >>
> >> + [Project current world displayWorld] ifError: [ :a :b |
> >> - [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 changed:
> >> ----- Method: Debugger class>>morphicOpenInterrupt:onProcess: (in
> >> category '*Morphic-opening') -----
> >> morphicOpenInterrupt: aString onProcess: interruptedProcess
> >> "Open a notifier in response to an interrupt. An interrupt occurs when
> >> the user types the interrupt key (cmd-. on Macs, ctrl-c or alt-. on other
> >> systems) or when the low-space watcher detects that memory is low."
> >> | debugger |
> >> "Simulation guard"
> >> debugger := self new.
> >> debugger
> >> process: interruptedProcess
> >> controller: nil
> >> context: interruptedProcess suspendedContext.
> >> debugger externalInterrupt: true.
> >>
> >> Preferences logDebuggerStackToFile ifTrue:
> >> [(aString includesSubstring: 'Space') & (aString includesSubstring:
> >> 'low')
> >> ifTrue: [Smalltalk logError: aString inContext: debugger
> >> interruptedContext to: 'LowSpaceDebug.log']
> >> "logging disabled for 4.3 release, see
> >>
> >> http://lists.squeak.org/pipermail/squeak-dev/2011-December/162503.html"
> >> "ifFalse: [Smalltalk logSqueakError: aString inContext: debugger
> >> interruptedContext]"].
> >>
> >> + Preferences eToyFriendly ifTrue: [Project current world
> >> stopRunningAll].
> >> - Preferences eToyFriendly ifTrue: [World stopRunningAll].
> >> ^debugger
> >> openNotifierContents: nil label: aString;
> >> yourself
> >> !
> >>
> >> Item was changed:
> >> ----- 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 := Project current world drawingClass withForm: f].
> >> - newMorph := World drawingClass withForm: f].
> >> newMorph setProperty: #resourceFilePath toValue: pathName.
> >> self owner replaceSubmorph: self by: newMorph!
> >>
> >> Item was changed:
> >> ----- Method: MorphHierarchyListMorph>>createContainer (in category
> >> 'private') -----
> >> createContainer
> >> "Private - Create a container"
> >> | container |
> >> container := BorderedMorph new.
> >> + container extent: (Project current world extent * (1 / 4 @ (2 / 3)))
> >> rounded.
> >> - container extent: (World extent * (1 / 4 @ (2 / 3))) rounded.
> >> container layoutPolicy: TableLayout new.
> >> container hResizing: #rigid.
> >> container vResizing: #rigid.
> >> container
> >> setColor: (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 changed:
> >> ----- 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 .seg. *** Caller must be
> >> holding (Project alInstances) to keep subprojects from going out. ***"
> >>
> >> | is sizeHint |
> >> + (Project current world == world) ifTrue: [^ false].
> >> - (World == 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.
> >> World 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:="">
> >> 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 changed:
> >> ----- 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 |
> >> + (Project current world == world) ifTrue: [^ self]. " inform: 'Can''t
> >> send the current world out'."
> >> - (World == 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"
> >> World flapTabs do: [:ft | ft referent adaptToWorld: World].
> >> "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.
> >> World checkCurrentHandForObjectToPaste2.
> >>
> >> is := ImageSegment
> >> copyFromRootsLocalFileFor: {world presenter. world} "world, and all
> >> Players"
> >> sizeHint: 0.
> >>
> >> is segment size < 800="" iftrue:="">
> >> 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 changed:
> >> ----- 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]]]!
> >> - [[Sensor peekPosition y > 0] whileTrue: [World doOneCycle]]]!
> >>
> >> Item was changed:
> >> ----- 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]]]!
> >> - [[Sensor peekPosition y > 0] whileTrue: [World doOneCycle]]]!
> >>
> >>
> >
> >
>



Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Morphic-dtl.1360.mcz

Bob Arning-2
In reply to this post by David T. Lewis

One caveat is that "self world" for a Morph will answer nil if the morph is not currently *in* a world.


On 11/12/17 10:11 AM, David T. Lewis wrote:
The "self world" expression works for morphs, and certainly it is easier to read.
It may be somewhat slower, although that would not be a concern in most usages.

My main concern is correctness, because failures in this area can hang up the
UI entirely, and errors are difficult to debug.

When transitioning from one project to another the World variable is set to
the new project's world in #finalEnterActions:.  Thus the World global is a
shortcut reference to the world of the current project, and that is what leads
me to suggest the expression "Project current world".



Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Morphic-dtl.1360.mcz

marcel.taeumel
If a morph needs a world from somehwere without being in a world, then something is fishy. :) Usually, a caller will provide a world for that morph such as in #openInWorld: or #intoWorld:. After that, "self world" will not be "nil" anymore.

Best,
Marcel

Am 12.11.2017 16:54:30 schrieb Bob Arning <[hidden email]>:

One caveat is that "self world" for a Morph will answer nil if the morph is not currently *in* a world.


On 11/12/17 10:11 AM, David T. Lewis wrote:
The "self world" expression works for morphs, and certainly it is easier to read.
It may be somewhat slower, although that would not be a concern in most usages.

My main concern is correctness, because failures in this area can hang up the
UI entirely, and errors are difficult to debug.

When transitioning from one project to another the World variable is set to
the new project's world in #finalEnterActions:.  Thus the World global is a
shortcut reference to the world of the current project, and that is what leads
me to suggest the expression "Project current world".



Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Morphic-dtl.1360.mcz

David T. Lewis
In reply to this post by Bob Arning-2
Indeed, that was my concern with respect to correctness.

  Morph>>world
      ^owner isNil ifTrue: [nil] ifFalse: [owner world]


Nevertheless, I have updated the two inbox packages to use "self world" in
morph methods instead of "Project current world". We can easily switch it
back if it seems dangerous.

Dave

On Sun, Nov 12, 2017 at 10:54:19AM -0500, Bob Arning wrote:

> One caveat is that "self world" for a Morph will answer nil if the morph
> is not currently *in* a world.
>
>
> On 11/12/17 10:11 AM, David T. Lewis wrote:
> >The "self world" expression works for morphs, and certainly it is easier to read.
> >It may be somewhat slower, although that would not be a concern in most
> >usages.
> >
> >My main concern is correctness, because failures in this area can hang up the
> >UI entirely, and errors are difficult to debug.
> >
> >When transitioning from one project to another the World variable is set to
> >the new project's world in #finalEnterActions:.  Thus the World global is a
> >shortcut reference to the world of the current project, and that is what
> >leads me to suggest the expression "Project current world".
>



Reply | Threaded
Open this post in threaded view
|

Re: The Inbox: Morphic-dtl.1360.mcz

marcel.taeumel
Yay! :-) +1

If we keep on working to reduce the use of globals, we will be having more fun in the future with extensibility and reuse. :-)

If one gets a debugger with "nil" after "self world", one should take a deep breath and figure out why that morph a) needs a world or b) doesn't yet have one. Access to globals should only be the last resort then. Like with other dubious "ifNil"-checks: figure out the circumstances, and try to understand the domain better, and keep the code readable.  

Best,
Marcel

Am 12.11.2017 17:05:35 schrieb David T. Lewis <[hidden email]>:

Indeed, that was my concern with respect to correctness.

Morph>>world
^owner isNil ifTrue: [nil] ifFalse: [owner world]


Nevertheless, I have updated the two inbox packages to use "self world" in
morph methods instead of "Project current world". We can easily switch it
back if it seems dangerous.

Dave

On Sun, Nov 12, 2017 at 10:54:19AM -0500, Bob Arning wrote:
> One caveat is that "self world" for a Morph will answer nil if the morph
> is not currently *in* a world.
>
>
> On 11/12/17 10:11 AM, David T. Lewis wrote:
> >The "self world" expression works for morphs, and certainly it is easier to read.
> >It may be somewhat slower, although that would not be a concern in most
> >usages.
> >
> >My main concern is correctness, because failures in this area can hang up the
> >UI entirely, and errors are difficult to debug.
> >
> >When transitioning from one project to another the World variable is set to
> >the new project's world in #finalEnterActions:. Thus the World global is a
> >shortcut reference to the world of the current project, and that is what
> >leads me to suggest the expression "Project current world".
>





Reply | Threaded
Open this post in threaded view
|

ActiveWorld and World globals (was: The Inbox: Morphic-dtl.1360.mcz)

David T. Lewis
I want to pause before proceeding too far with removing references to
global World, and note this:

We currently have the globals World and ActiveWorld, as well as the following method:

Object>>currentWorld
        "Answer a morphic world that is the current UI focus."
        ^ActiveWorld ifNil:[World]

The comment for #currentWorld describes what I believe to be the functional
definition of "World" as currently implemented in Squeak projects.

It that is the case, then #currentWorld could be implemented as

Object>>currentWorld
        "Answer a morphic world that is the current UI focus."
        ^Project current world

My assumption is that World and CurrentWorld refer to essentially
the same thing, except when transitioning from one active Project
to another, or when implementing WorldInWorlds (see Etoys) or when
experimenting with running a Project in the background (various old
experiments circa 2000 or so).

Does that sound right?

Dave


On Sun, Nov 12, 2017 at 05:12:13PM +0100, Marcel Taeumel wrote:

> Yay! :-) +1
>
> If we keep on working to reduce the use of globals, we will be having more fun in the future with extensibility and reuse. :-)
>
> If one gets a debugger with "nil" after "self world", one should take a deep breath and figure out why that morph a) needs a world or b) doesn't yet have one. Access to globals should only be the last resort then. Like with other dubious "ifNil"-checks: figure out the circumstances, and try to understand the domain better, and keep the code readable. ??
>
> Best,
> Marcel
> Am 12.11.2017 17:05:35 schrieb David T. Lewis <[hidden email]>:
> Indeed, that was my concern with respect to correctness.
>
> Morph>>world
> ^owner isNil ifTrue: [nil] ifFalse: [owner world]
>
>
> Nevertheless, I have updated the two inbox packages to use "self world" in
> morph methods instead of "Project current world". We can easily switch it
> back if it seems dangerous.
>
> Dave
>
> On Sun, Nov 12, 2017 at 10:54:19AM -0500, Bob Arning wrote:
> > One caveat is that "self world" for a Morph will answer nil if the morph
> > is not currently *in* a world.
> >
> >
> > On 11/12/17 10:11 AM, David T. Lewis wrote:
> > >The "self world" expression works for morphs, and certainly it is easier to read.
> > >It may be somewhat slower, although that would not be a concern in most
> > >usages.
> > >
> > >My main concern is correctness, because failures in this area can hang up the
> > >UI entirely, and errors are difficult to debug.
> > >
> > >When transitioning from one project to another the World variable is set to
> > >the new project's world in #finalEnterActions:. Thus the World global is a
> > >shortcut reference to the world of the current project, and that is what
> > >leads me to suggest the expression "Project current world".
> >
>
>
>

>


Reply | Threaded
Open this post in threaded view
|

Re: ActiveWorld and World globals (was: The Inbox: Morphic-dtl.1360.mcz)

Hannes Hirzel
On 11/14/17, David T. Lewis <[hidden email]> wrote:

> I want to pause before proceeding too far with removing references to
> global World, and note this:
>
> We currently have the globals World and ActiveWorld, as well as the
> following method:
>
> Object>>currentWorld
> "Answer a morphic world that is the current UI focus."
> ^ActiveWorld ifNil:[World]
>
> The comment for #currentWorld describes what I believe to be the functional
> definition of "World" as currently implemented in Squeak projects.
>
> It that is the case, then #currentWorld could be implemented as
>
> Object>>currentWorld
>         "Answer a morphic world that is the current UI focus."
>         ^Project current world
>
> My assumption is that World and CurrentWorld refer to essentially
> the same thing, except when transitioning from one active Project
> to another, or when implementing WorldInWorlds (see Etoys) or when
> experimenting with running a Project in the background (various old
> experiments circa 2000 or so).
>
> Does that sound right?
>
> Dave

I was wondering as well are there cases where

     ActiveWorld == World

does not hold. We need to find out in the archives, I am sure this has
been discussed before.

--Hannes


>
> On Sun, Nov 12, 2017 at 05:12:13PM +0100, Marcel Taeumel wrote:
>> Yay! :-) +1
>>
>> If we keep on working to reduce the use of globals, we will be having more
>> fun in the future with extensibility and reuse. :-)
>>
>> If one gets a debugger with "nil" after "self world", one should take a
>> deep breath and figure out why that morph a) needs a world or b) doesn't
>> yet have one. Access to globals should only be the last resort then. Like
>> with other dubious "ifNil"-checks: figure out the circumstances, and try
>> to understand the domain better, and keep the code readable. ??
>>
>> Best,
>> Marcel
>> Am 12.11.2017 17:05:35 schrieb David T. Lewis <[hidden email]>:
>> Indeed, that was my concern with respect to correctness.
>>
>> Morph>>world
>> ^owner isNil ifTrue: [nil] ifFalse: [owner world]
>>
>>
>> Nevertheless, I have updated the two inbox packages to use "self world" in
>> morph methods instead of "Project current world". We can easily switch it
>> back if it seems dangerous.
>>
>> Dave
>>
>> On Sun, Nov 12, 2017 at 10:54:19AM -0500, Bob Arning wrote:
>> > One caveat is that "self world" for a Morph will answer nil if the morph
>> > is not currently *in* a world.
>> >
>> >
>> > On 11/12/17 10:11 AM, David T. Lewis wrote:
>> > >The "self world" expression works for morphs, and certainly it is
>> > > easier to read.
>> > >It may be somewhat slower, although that would not be a concern in most
>> > >usages.
>> > >
>> > >My main concern is correctness, because failures in this area can hang
>> > > up the
>> > >UI entirely, and errors are difficult to debug.
>> > >
>> > >When transitioning from one project to another the World variable is
>> > > set to
>> > >the new project's world in #finalEnterActions:. Thus the World global
>> > > is a
>> > >shortcut reference to the world of the current project, and that is
>> > > what
>> > >leads me to suggest the expression "Project current world".
>> >
>>
>>
>>
>
>>
>
>
>

Reply | Threaded
Open this post in threaded view
|

Re: ActiveWorld and World globals (was: The Inbox: Morphic-dtl.1360.mcz)

marcel.taeumel
In reply to this post by David T. Lewis
Nope. We have to try "ActiveWorld" first. Then fall back to "Project current world". It is important for event handling code.

Best,
Marcel

Am 14.11.2017 04:57:02 schrieb David T. Lewis <[hidden email]>:

I want to pause before proceeding too far with removing references to
global World, and note this:

We currently have the globals World and ActiveWorld, as well as the following method:

Object>>currentWorld
"Answer a morphic world that is the current UI focus."
^ActiveWorld ifNil:[World]

The comment for #currentWorld describes what I believe to be the functional
definition of "World" as currently implemented in Squeak projects.

It that is the case, then #currentWorld could be implemented as

Object>>currentWorld
"Answer a morphic world that is the current UI focus."
^Project current world

My assumption is that World and CurrentWorld refer to essentially
the same thing, except when transitioning from one active Project
to another, or when implementing WorldInWorlds (see Etoys) or when
experimenting with running a Project in the background (various old
experiments circa 2000 or so).

Does that sound right?

Dave


On Sun, Nov 12, 2017 at 05:12:13PM +0100, Marcel Taeumel wrote:
> Yay! :-) +1
>
> If we keep on working to reduce the use of globals, we will be having more fun in the future with extensibility and reuse. :-)
>
> If one gets a debugger with "nil" after "self world", one should take a deep breath and figure out why that morph a) needs a world or b) doesn't yet have one. Access to globals should only be the last resort then. Like with other dubious "ifNil"-checks: figure out the circumstances, and try to understand the domain better, and keep the code readable. ??
>
> Best,
> Marcel
> Am 12.11.2017 17:05:35 schrieb David T. Lewis :
> Indeed, that was my concern with respect to correctness.
>
> Morph>>world
> ^owner isNil ifTrue: [nil] ifFalse: [owner world]
>
>
> Nevertheless, I have updated the two inbox packages to use "self world" in
> morph methods instead of "Project current world". We can easily switch it
> back if it seems dangerous.
>
> Dave
>
> On Sun, Nov 12, 2017 at 10:54:19AM -0500, Bob Arning wrote:
> > One caveat is that "self world" for a Morph will answer nil if the morph
> > is not currently *in* a world.
> >
> >
> > On 11/12/17 10:11 AM, David T. Lewis wrote:
> > >The "self world" expression works for morphs, and certainly it is easier to read.
> > >It may be somewhat slower, although that would not be a concern in most
> > >usages.
> > >
> > >My main concern is correctness, because failures in this area can hang up the
> > >UI entirely, and errors are difficult to debug.
> > >
> > >When transitioning from one project to another the World variable is set to
> > >the new project's world in #finalEnterActions:. Thus the World global is a
> > >shortcut reference to the world of the current project, and that is what
> > >leads me to suggest the expression "Project current world".
> >
>
>
>

>




Reply | Threaded
Open this post in threaded view
|

Re: ActiveWorld and World globals (was: The Inbox: Morphic-dtl.1360.mcz)

Hannes Hirzel
Marcel

you mean that


    Object>>currentWorld
            "Answer a morphic world that is the current UI focus."
            ^ActiveWorld ifNil:[World]

should be maintained? First checking is there is an object
(aPasteUpMorph) pointed to by ActiveWorld and if not set then give
back the object pointed to by World.


Could you please elaborate on this?


--Hannes


On 11/14/17, Marcel Taeumel <[hidden email]> wrote:

> Nope. We have to try "ActiveWorld" first. Then fall back to "Project current
> world". It is important for event handling code.
>
> Best,
> Marcel
> Am 14.11.2017 04:57:02 schrieb David T. Lewis <[hidden email]>:
> I want to pause before proceeding too far with removing references to
> global World, and note this:
>
> We currently have the globals World and ActiveWorld, as well as the
> following method:
>
> Object>>currentWorld
> "Answer a morphic world that is the current UI focus."
> ^ActiveWorld ifNil:[World]
>
> The comment for #currentWorld describes what I believe to be the functional
> definition of "World" as currently implemented in Squeak projects.
>
> It that is the case, then #currentWorld could be implemented as
>
> Object>>currentWorld
> "Answer a morphic world that is the current UI focus."
> ^Project current world
>
> My assumption is that World and CurrentWorld refer to essentially
> the same thing, except when transitioning from one active Project
> to another, or when implementing WorldInWorlds (see Etoys) or when
> experimenting with running a Project in the background (various old
> experiments circa 2000 or so).
>
> Does that sound right?
>
> Dave
>
>
> On Sun, Nov 12, 2017 at 05:12:13PM +0100, Marcel Taeumel wrote:
>> Yay! :-) +1
>>
>> If we keep on working to reduce the use of globals, we will be having more
>> fun in the future with extensibility and reuse. :-)
>>
>> If one gets a debugger with "nil" after "self world", one should take a
>> deep breath and figure out why that morph a) needs a world or b) doesn't
>> yet have one. Access to globals should only be the last resort then. Like
>> with other dubious "ifNil"-checks: figure out the circumstances, and try
>> to understand the domain better, and keep the code readable. ??
>>
>> Best,
>> Marcel
>> Am 12.11.2017 17:05:35 schrieb David T. Lewis :
>> Indeed, that was my concern with respect to correctness.
>>
>> Morph>>world
>> ^owner isNil ifTrue: [nil] ifFalse: [owner world]
>>
>>
>> Nevertheless, I have updated the two inbox packages to use "self world"
>> in
>> morph methods instead of "Project current world". We can easily switch it
>> back if it seems dangerous.
>>
>> Dave
>>
>> On Sun, Nov 12, 2017 at 10:54:19AM -0500, Bob Arning wrote:
>> > One caveat is that "self world" for a Morph will answer nil if the
>> > morph
>> > is not currently *in* a world.
>> >
>> >
>> > On 11/12/17 10:11 AM, David T. Lewis wrote:
>> > >The "self world" expression works for morphs, and certainly it is
>> > > easier to read.
>> > >It may be somewhat slower, although that would not be a concern in
>> > > most
>> > >usages.
>> > >
>> > >My main concern is correctness, because failures in this area can hang
>> > > up the
>> > >UI entirely, and errors are difficult to debug.
>> > >
>> > >When transitioning from one project to another the World variable is
>> > > set to
>> > >the new project's world in #finalEnterActions:. Thus the World global
>> > > is a
>> > >shortcut reference to the world of the current project, and that is
>> > > what
>> > >leads me to suggest the expression "Project current world".
>> >
>>
>>
>>
>
>>
>
>
>

Reply | Threaded
Open this post in threaded view
|

Re: ActiveWorld and World globals (was: The Inbox: Morphic-dtl.1360.mcz)

marcel.taeumel
Hi, Hannes.

In the long term, I would want to get rid of Object >> #currentWorld. For now, we could optimize to:

Object >> currentWorld
   ^ ActiveWorld ifNil: [Project current world]

I would move it from the category "macpal" to "*Morphic-Kernel".

Baby steps. :-)

Best,
Marcel

Am 14.11.2017 10:55:43 schrieb H. Hirzel <[hidden email]>:

Marcel

you mean that


Object>>currentWorld
"Answer a morphic world that is the current UI focus."
^ActiveWorld ifNil:[World]

should be maintained? First checking is there is an object
(aPasteUpMorph) pointed to by ActiveWorld and if not set then give
back the object pointed to by World.


Could you please elaborate on this?


--Hannes


On 11/14/17, Marcel Taeumel wrote:

> Nope. We have to try "ActiveWorld" first. Then fall back to "Project current
> world". It is important for event handling code.
>
> Best,
> Marcel
> Am 14.11.2017 04:57:02 schrieb David T. Lewis :
> I want to pause before proceeding too far with removing references to
> global World, and note this:
>
> We currently have the globals World and ActiveWorld, as well as the
> following method:
>
> Object>>currentWorld
> "Answer a morphic world that is the current UI focus."
> ^ActiveWorld ifNil:[World]
>
> The comment for #currentWorld describes what I believe to be the functional
> definition of "World" as currently implemented in Squeak projects.
>
> It that is the case, then #currentWorld could be implemented as
>
> Object>>currentWorld
> "Answer a morphic world that is the current UI focus."
> ^Project current world
>
> My assumption is that World and CurrentWorld refer to essentially
> the same thing, except when transitioning from one active Project
> to another, or when implementing WorldInWorlds (see Etoys) or when
> experimenting with running a Project in the background (various old
> experiments circa 2000 or so).
>
> Does that sound right?
>
> Dave
>
>
> On Sun, Nov 12, 2017 at 05:12:13PM +0100, Marcel Taeumel wrote:
>> Yay! :-) +1
>>
>> If we keep on working to reduce the use of globals, we will be having more
>> fun in the future with extensibility and reuse. :-)
>>
>> If one gets a debugger with "nil" after "self world", one should take a
>> deep breath and figure out why that morph a) needs a world or b) doesn't
>> yet have one. Access to globals should only be the last resort then. Like
>> with other dubious "ifNil"-checks: figure out the circumstances, and try
>> to understand the domain better, and keep the code readable. ??
>>
>> Best,
>> Marcel
>> Am 12.11.2017 17:05:35 schrieb David T. Lewis :
>> Indeed, that was my concern with respect to correctness.
>>
>> Morph>>world
>> ^owner isNil ifTrue: [nil] ifFalse: [owner world]
>>
>>
>> Nevertheless, I have updated the two inbox packages to use "self world"
>> in
>> morph methods instead of "Project current world". We can easily switch it
>> back if it seems dangerous.
>>
>> Dave
>>
>> On Sun, Nov 12, 2017 at 10:54:19AM -0500, Bob Arning wrote:
>> > One caveat is that "self world" for a Morph will answer nil if the
>> > morph
>> > is not currently *in* a world.
>> >
>> >
>> > On 11/12/17 10:11 AM, David T. Lewis wrote:
>> > >The "self world" expression works for morphs, and certainly it is
>> > > easier to read.
>> > >It may be somewhat slower, although that would not be a concern in
>> > > most
>> > >usages.
>> > >
>> > >My main concern is correctness, because failures in this area can hang
>> > > up the
>> > >UI entirely, and errors are difficult to debug.
>> > >
>> > >When transitioning from one project to another the World variable is
>> > > set to
>> > >the new project's world in #finalEnterActions:. Thus the World global
>> > > is a
>> > >shortcut reference to the world of the current project, and that is
>> > > what
>> > >leads me to suggest the expression "Project current world".
>> >
>>
>>
>>
>
>>
>
>
>



Reply | Threaded
Open this post in threaded view
|

Re: ActiveWorld and World globals (was: The Inbox: Morphic-dtl.1360.mcz)

Hannes Hirzel
In reply to this post by Hannes Hirzel
I now understand that

In our current use of Morphic (14th Nov 2017), there is no difference
between"World" and "ActiveWorld".

In the Squeak 2.0 release (and maybe later?), "World" was the
outermost world and "ActiveWorld" was the world that is involved in
the particular event dispatch (see ActiveEvent, too), which could be
in a window, for example.


This means that everyday debugging, one should use "ActiveWorld"
instead of "World".

And it would be good to get "worlds in worlds" working again.


This means that there is or was some code somewhere like


    theCurrentOutmostPasteUpMorphAndContainedPasteUpMorphs  do:
           [: pmorph |

                 ActiveWorld:= pmorph.

                "process events for ActiveWorld"
         ]

--Hannes

On 11/14/17, H. Hirzel <[hidden email]> wrote:

> Marcel
>
> you mean that
>
>
>     Object>>currentWorld
>             "Answer a morphic world that is the current UI focus."
>             ^ActiveWorld ifNil:[World]
>
> should be maintained? First checking is there is an object
> (aPasteUpMorph) pointed to by ActiveWorld and if not set then give
> back the object pointed to by World.
>
>
> Could you please elaborate on this?
>
>
> --Hannes
>
>
> On 11/14/17, Marcel Taeumel <[hidden email]> wrote:
>> Nope. We have to try "ActiveWorld" first. Then fall back to "Project
>> current
>> world". It is important for event handling code.
>>
>> Best,
>> Marcel
>> Am 14.11.2017 04:57:02 schrieb David T. Lewis <[hidden email]>:
>> I want to pause before proceeding too far with removing references to
>> global World, and note this:
>>
>> We currently have the globals World and ActiveWorld, as well as the
>> following method:
>>
>> Object>>currentWorld
>> "Answer a morphic world that is the current UI focus."
>> ^ActiveWorld ifNil:[World]
>>
>> The comment for #currentWorld describes what I believe to be the
>> functional
>> definition of "World" as currently implemented in Squeak projects.
>>
>> It that is the case, then #currentWorld could be implemented as
>>
>> Object>>currentWorld
>> "Answer a morphic world that is the current UI focus."
>> ^Project current world
>>
>> My assumption is that World and CurrentWorld refer to essentially
>> the same thing, except when transitioning from one active Project
>> to another, or when implementing WorldInWorlds (see Etoys) or when
>> experimenting with running a Project in the background (various old
>> experiments circa 2000 or so).
>>
>> Does that sound right?
>>
>> Dave
>>
>>
>> On Sun, Nov 12, 2017 at 05:12:13PM +0100, Marcel Taeumel wrote:
>>> Yay! :-) +1
>>>
>>> If we keep on working to reduce the use of globals, we will be having
>>> more
>>> fun in the future with extensibility and reuse. :-)
>>>
>>> If one gets a debugger with "nil" after "self world", one should take a
>>> deep breath and figure out why that morph a) needs a world or b) doesn't
>>> yet have one. Access to globals should only be the last resort then.
>>> Like
>>> with other dubious "ifNil"-checks: figure out the circumstances, and try
>>> to understand the domain better, and keep the code readable. ??
>>>
>>> Best,
>>> Marcel
>>> Am 12.11.2017 17:05:35 schrieb David T. Lewis :
>>> Indeed, that was my concern with respect to correctness.
>>>
>>> Morph>>world
>>> ^owner isNil ifTrue: [nil] ifFalse: [owner world]
>>>
>>>
>>> Nevertheless, I have updated the two inbox packages to use "self world"
>>> in
>>> morph methods instead of "Project current world". We can easily switch
>>> it
>>> back if it seems dangerous.
>>>
>>> Dave
>>>
>>> On Sun, Nov 12, 2017 at 10:54:19AM -0500, Bob Arning wrote:
>>> > One caveat is that "self world" for a Morph will answer nil if the
>>> > morph
>>> > is not currently *in* a world.
>>> >
>>> >
>>> > On 11/12/17 10:11 AM, David T. Lewis wrote:
>>> > >The "self world" expression works for morphs, and certainly it is
>>> > > easier to read.
>>> > >It may be somewhat slower, although that would not be a concern in
>>> > > most
>>> > >usages.
>>> > >
>>> > >My main concern is correctness, because failures in this area can
>>> > > hang
>>> > > up the
>>> > >UI entirely, and errors are difficult to debug.
>>> > >
>>> > >When transitioning from one project to another the World variable is
>>> > > set to
>>> > >the new project's world in #finalEnterActions:. Thus the World global
>>> > > is a
>>> > >shortcut reference to the world of the current project, and that is
>>> > > what
>>> > >leads me to suggest the expression "Project current world".
>>> >
>>>
>>>
>>>
>>
>>>
>>
>>
>>
>

Reply | Threaded
Open this post in threaded view
|

Re: ActiveWorld and World globals (was: The Inbox: Morphic-dtl.1360.mcz)

marcel.taeumel
To better understand the dynamically-scoped ActiveWorld global, see:

HandMorph >> #sendEvent:focus:clear:
Morph >> #processEvent:
PasteUpMorph >> #processEvent:using:

...and I just found a bug in Morph >> #processFocusEvent:using: ... :-D It omits to set the proper (inner) ActiveWorld. Uhhh... have to think about that in the context of event bubbling... *hmpf*

Best,
Marcel

Am 14.11.2017 11:13:23 schrieb H. Hirzel <[hidden email]>:

I now understand that

In our current use of Morphic (14th Nov 2017), there is no difference
between"World" and "ActiveWorld".

In the Squeak 2.0 release (and maybe later?), "World" was the
outermost world and "ActiveWorld" was the world that is involved in
the particular event dispatch (see ActiveEvent, too), which could be
in a window, for example.


This means that everyday debugging, one should use "ActiveWorld"
instead of "World".

And it would be good to get "worlds in worlds" working again.


This means that there is or was some code somewhere like


theCurrentOutmostPasteUpMorphAndContainedPasteUpMorphs do:
[: pmorph |

ActiveWorld:= pmorph.

"process events for ActiveWorld"
]

--Hannes

On 11/14/17, H. Hirzel wrote:
> Marcel
>
> you mean that
>
>
> Object>>currentWorld
> "Answer a morphic world that is the current UI focus."
> ^ActiveWorld ifNil:[World]
>
> should be maintained? First checking is there is an object
> (aPasteUpMorph) pointed to by ActiveWorld and if not set then give
> back the object pointed to by World.
>
>
> Could you please elaborate on this?
>
>
> --Hannes
>
>
> On 11/14/17, Marcel Taeumel wrote:
>> Nope. We have to try "ActiveWorld" first. Then fall back to "Project
>> current
>> world". It is important for event handling code.
>>
>> Best,
>> Marcel
>> Am 14.11.2017 04:57:02 schrieb David T. Lewis :
>> I want to pause before proceeding too far with removing references to
>> global World, and note this:
>>
>> We currently have the globals World and ActiveWorld, as well as the
>> following method:
>>
>> Object>>currentWorld
>> "Answer a morphic world that is the current UI focus."
>> ^ActiveWorld ifNil:[World]
>>
>> The comment for #currentWorld describes what I believe to be the
>> functional
>> definition of "World" as currently implemented in Squeak projects.
>>
>> It that is the case, then #currentWorld could be implemented as
>>
>> Object>>currentWorld
>> "Answer a morphic world that is the current UI focus."
>> ^Project current world
>>
>> My assumption is that World and CurrentWorld refer to essentially
>> the same thing, except when transitioning from one active Project
>> to another, or when implementing WorldInWorlds (see Etoys) or when
>> experimenting with running a Project in the background (various old
>> experiments circa 2000 or so).
>>
>> Does that sound right?
>>
>> Dave
>>
>>
>> On Sun, Nov 12, 2017 at 05:12:13PM +0100, Marcel Taeumel wrote:
>>> Yay! :-) +1
>>>
>>> If we keep on working to reduce the use of globals, we will be having
>>> more
>>> fun in the future with extensibility and reuse. :-)
>>>
>>> If one gets a debugger with "nil" after "self world", one should take a
>>> deep breath and figure out why that morph a) needs a world or b) doesn't
>>> yet have one. Access to globals should only be the last resort then.
>>> Like
>>> with other dubious "ifNil"-checks: figure out the circumstances, and try
>>> to understand the domain better, and keep the code readable. ??
>>>
>>> Best,
>>> Marcel
>>> Am 12.11.2017 17:05:35 schrieb David T. Lewis :
>>> Indeed, that was my concern with respect to correctness.
>>>
>>> Morph>>world
>>> ^owner isNil ifTrue: [nil] ifFalse: [owner world]
>>>
>>>
>>> Nevertheless, I have updated the two inbox packages to use "self world"
>>> in
>>> morph methods instead of "Project current world". We can easily switch
>>> it
>>> back if it seems dangerous.
>>>
>>> Dave
>>>
>>> On Sun, Nov 12, 2017 at 10:54:19AM -0500, Bob Arning wrote:
>>> > One caveat is that "self world" for a Morph will answer nil if the
>>> > morph
>>> > is not currently *in* a world.
>>> >
>>> >
>>> > On 11/12/17 10:11 AM, David T. Lewis wrote:
>>> > >The "self world" expression works for morphs, and certainly it is
>>> > > easier to read.
>>> > >It may be somewhat slower, although that would not be a concern in
>>> > > most
>>> > >usages.
>>> > >
>>> > >My main concern is correctness, because failures in this area can
>>> > > hang
>>> > > up the
>>> > >UI entirely, and errors are difficult to debug.
>>> > >
>>> > >When transitioning from one project to another the World variable is
>>> > > set to
>>> > >the new project's world in #finalEnterActions:. Thus the World global
>>> > > is a
>>> > >shortcut reference to the world of the current project, and that is
>>> > > what
>>> > >leads me to suggest the expression "Project current world".
>>> >
>>>
>>>
>>>
>>
>>>
>>
>>
>>
>



Reply | Threaded
Open this post in threaded view
|

Re: ActiveWorld and World globals

Bob Arning-2
In reply to this post by Hannes Hirzel

Here is a start (squeak 5.1). Not extensively tested, but a FileList in a world in the World was operational.


On 11/14/17 5:13 AM, H. Hirzel wrote:
And it would be good to get "worlds in worlds" working again.




fixProjectView.14Nov0811.cs.gz (3K) Download Attachment
Reply | Threaded
Open this post in threaded view
|

Re: ActiveWorld and World globals (was: The Inbox: Morphic-dtl.1360.mcz)

David T. Lewis
In reply to this post by marcel.taeumel
On Tue, Nov 14, 2017 at 11:08:08AM +0100, Marcel Taeumel wrote:
> Hi, Hannes.
>
> In the long term, I would want to get rid of Object >> #currentWorld. For now, we could optimize to:
>
> Object >> currentWorld
> ?? ??^ ActiveWorld ifNil: [Project current world]
>
> I would move it from the category "macpal" to "*Morphic-Kernel".
>

Thanks, I made the change to Object>>currentWorld and moved it (and two similar
methods) to *Morphic-Kernel.

Dave


Reply | Threaded
Open this post in threaded view
|

Re: ActiveWorld and World globals

David T. Lewis
In reply to this post by Bob Arning-2
I hope someone can take a look at Bob's change set. I'm going to be away for
a day or two and I'm out of time for playing with Squeak, but this is certainly
on my personal to-do list when I get back :-)

Dave


On Tue, Nov 14, 2017 at 08:14:07AM -0500, Bob Arning wrote:
> Here is a start (squeak 5.1). Not extensively tested, but a FileList in
> a world in the World was operational.
>
>
> On 11/14/17 5:13 AM, H. Hirzel wrote:
> >And it would be good to get "worlds in worlds" working again.



Reply | Threaded
Open this post in threaded view
|

Re: ActiveWorld and World globals

Hannes Hirzel
Bob's changes involve 4 methods

PasteUpMorph>>installAsActiveSubprojectIn: enclosingWorld at:
newBounds titled: aString
PasteUpMorph>>installAsActiveSubprojectIn: enclosingWorld titled: aString
Project>>enterAsActiveSubprojectWithin: enclosingWorld
ProjectViewMorph>>enterAsActiveSubproject


BTW this involves the mysterious 'AlignmentMorphBob1'.....

Hannes



Here is the code (unpacked fixProjectView.14Nov0811.cs.gz) to make it
easier for people to have a look at it.



'From Squeak5.1 of 23 August 2016 [latest update: #16548] on 14
November 2017 at 8:11:28 am'!
"Change Set: fixProjectView
Date: 14 November 2017
Author: Bob Arning

squeak 5.1...

reinstate 'ENTER ACTIVE' option in menu for ProjectViewMorph "!


!PasteUpMorph methodsFor: 'WiW support' stamp: 'raa 11/14/2017 07:47'!
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."]! !

!PasteUpMorph methodsFor: 'WiW support' stamp: 'raa 11/14/2017 07:47'!
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! !


!Project methodsFor: 'enter' stamp: 'raa 11/14/2017 06:45'!
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"! !


!ProjectViewMorph methodsFor: 'events' stamp: 'raa 11/14/2017 06:46'!
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 setViewSize: self extent].
    self showMouseState: 3.
    project enterAsActiveSubprojectWithin: self world! !

!ProjectViewMorph methodsFor: 'events' stamp: 'raa 11/14/2017 06:43'!
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.! !

Project removeSelector: #installAsActiveSubprojectIn:titled:!

On 11/15/17, David T. Lewis <[hidden email]> wrote:

> I hope someone can take a look at Bob's change set. I'm going to be away for
> a day or two and I'm out of time for playing with Squeak, but this is
> certainly
> on my personal to-do list when I get back :-)
>
> Dave
>
>
> On Tue, Nov 14, 2017 at 08:14:07AM -0500, Bob Arning wrote:
>> Here is a start (squeak 5.1). Not extensively tested, but a FileList in
>> a world in the World was operational.
>>
>>
>> On 11/14/17 5:13 AM, H. Hirzel wrote:
>> >And it would be good to get "worlds in worlds" working again.
>
>
>
>

12