The Trunk: Morphic-laza.380.mcz

Alexander Lazarević uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-laza.380.mcz

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

Name: Morphic-laza.380
Author: laza
Time: 11 March 2010, 9:35:19.172 am
UUID: 0f54e2e9-4255-49a8-be3c-7b8e7eb0bac9
Ancestors: Morphic-cmm.378

Adds Host WindowEvent handling

=============== Diff against Morphic-cmm.378 ===============

Item was added:
+ ----- Method: WindowEvent>>type (in category 'accessing') -----
+ type
+ "This should match the definitions in sq.h"
+ ^#(
+ windowMetricChange
+ windowClose
+ windowIconise
+ windowActivated
+ windowPaint
+ ) at: action ifAbsent: [#windowEventUnknown]!

Item was added:
+ ----- Method: HandMorph>>generateWindowEvent: (in category 'private events') -----
+ generateWindowEvent: evtBuf
+ "Generate the appropriate window event for the given raw event buffer"
+
+ | evt |
+ evt := WindowEvent new.
+ evt setTimeStamp: evtBuf second.
+ evt timeStamp = 0 ifTrue: [evt setTimeStamp: Time millisecondClockValue].
+ evt action: evtBuf third.
+ evt rectangle: (Rectangle origin: evtBuf fourth @ evtBuf fifth corner: evtBuf sixth @ evtBuf seventh ).
+
+ ^evt!

Item was changed:
  ----- Method: MorphicEventDispatcher>>dispatchEvent:with: (in category 'dispatching') -----
  dispatchEvent: anEvent with: aMorph
  "Dispatch the given event for a morph that has chosen the receiver to dispatch its events. The method implements a shortcut for repeated dispatches of events using the same dispatcher."
  anEvent type == lastType ifTrue:[^self perform: lastDispatch with: anEvent with: aMorph].
  "Otherwise classify"
  lastType := anEvent type.
  anEvent isMouse ifTrue:[
  anEvent isMouseDown ifTrue:[
  lastDispatch := #dispatchMouseDown:with:.
  ^self dispatchMouseDown: anEvent with: aMorph]].
  anEvent type == #dropEvent ifTrue:[
  lastDispatch := #dispatchDropEvent:with:.
  ^self dispatchDropEvent: anEvent with: aMorph].
+ anEvent isWindowEvent ifTrue:[
+ lastDispatch := #dispatchWindowEvent:with:.
+ ^self dispatchWindowEvent: anEvent with: aMorph].
  lastDispatch := #dispatchDefault:with:.
  ^self dispatchDefault: anEvent with: aMorph!

Item was changed:
  ----- Method: HandMorph>>handleEvent: (in category 'events-processing') -----
  handleEvent: anEvent
  | evt ofs |
  owner ifNil:[^self].
  evt := anEvent.
 
  EventStats ifNil:[EventStats := IdentityDictionary new].
  EventStats at: #count put: (EventStats at: #count ifAbsent:[0]) + 1.
  EventStats at: evt type put: (EventStats at: evt type ifAbsent:[0]) + 1.
 
  evt isMouseOver ifTrue:[^self sendMouseEvent: evt].
 
  ShowEvents == true ifTrue:[
  Display fill: (0@0 extent: 250@120) rule: Form over fillColor: Color white.
  ofs := (owner hands indexOf: self) - 1 * 60.
  evt printString displayAt: (0@ofs) + (evt isKeyboard ifTrue:[0@30] ifFalse:[0@0]).
  self keyboardFocus printString displayAt: (0@ofs)+(0@45).
  ].
  "Notify listeners"
  self sendListenEvent: evt to: self eventListeners.
 
+ evt isWindowEvent ifTrue: [
+ self sendEvent: evt focus: nil.
+ ^self mouseOverHandler processMouseOver: lastMouseEvent].
+
  evt isKeyboard ifTrue:[
  self sendListenEvent: evt to: self keyboardListeners.
  self sendKeyboardEvent: evt.
  ^self mouseOverHandler processMouseOver: lastMouseEvent].
 
  evt isDropEvent ifTrue:[
  self sendEvent: evt focus: nil.
  ^self mouseOverHandler processMouseOver: lastMouseEvent].
 
  evt isMouse ifTrue:[
  self sendListenEvent: evt to: self mouseListeners.
  lastMouseEvent := evt].
 
  "Check for pending drag or double click operations."
  mouseClickState ifNotNil:[
  (mouseClickState handleEvent: evt from: self) ifFalse:[
  "Possibly dispatched #click: or something and will not re-establish otherwise"
  ^self mouseOverHandler processMouseOver: lastMouseEvent]].
 
  evt isMove ifTrue:[
  self position: evt position.
  self sendMouseEvent: evt.
  ] ifFalse:[
  "Issue a synthetic move event if we're not at the position of the event"
  (evt position = self position) ifFalse:[self moveToEvent: evt].
  "Drop submorphs on button events"
  (self hasSubmorphs)
  ifTrue:[self dropMorphs: evt]
  ifFalse:[self sendMouseEvent: evt].
  ].
  ShowEvents == true ifTrue:[self mouseFocus printString displayAt: (0@ofs) + (0@15)].
  self mouseOverHandler processMouseOver: lastMouseEvent.
+ "self handleDragOutside: anEvent."
  !

Item was added:
+ ----- Method: MorphicEventDispatcher>>dispatchWindowEvent:with: (in category 'dispatching') -----
+ dispatchWindowEvent: anEvent with: aMorph
+ "Host window events do not have a position and are only dispatched to the World"
+ aMorph isWorldMorph ifFalse: [^#rejected].
+ anEvent wasHandled ifTrue:[^self].
+ ^aMorph handleEvent: anEvent!

Item was added:
+ ----- Method: PasteUpMorph>>windowEvent: (in category 'event handling') -----
+ windowEvent: anEvent
+ self windowEventHandler
+ ifNotNil: [^self windowEventHandler windowEvent: anEvent].
+
+ anEvent type == #windowClose
+ ifTrue: [
+ ^Preferences eToyFriendly
+ ifTrue: [ProjectNavigationMorph basicNew quitSqueak]
+ ifFalse: [TheWorldMenu basicNew quitSession]].
+ !

Item was added:
+ ----- Method: WindowEvent>>printOn: (in category 'printing') -----
+ printOn: aStream
+
+ aStream nextPut: $[.
+ aStream nextPutAll: self type; space.
+ aStream nextPut: $(; print: self rectangle; nextPut: $).
+ aStream nextPut: $].!

Item was added:
+ ----- Method: Morph>>wantsWindowEvents: (in category 'event handling') -----
+ wantsWindowEvents: anEvent
+ "Return true if the receiver wants to process host window events. These are only dispatched to the World anyway, but one could have an eventListener in the Hand or a windowEventHandler in the World"
+ ^false!

Item was added:
+ MorphicEvent subclass: #WindowEvent
+ instanceVariableNames: 'action rectangle'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Morphic-Events'!
+
+ !WindowEvent commentStamp: '<historical>' prior: 0!
+ I'm an event related to the host window, only dispatched to the World. !

Item was changed:
  ----- Method: HandMorph>>processEvents (in category 'event handling') -----
  processEvents
  "Process user input events from the local input devices."
 
  | evt evtBuf type hadAny |
  ActiveEvent ifNotNil:
  ["Meaning that we were invoked from within an event response.
  Make sure z-order is up to date"
 
  self mouseOverHandler processMouseOver: lastMouseEvent].
  hadAny := false.
  [(evtBuf := Sensor nextEvent) isNil] whileFalse:
  [evt := nil. "for unknown event types"
  type := evtBuf first.
  type = EventTypeMouse ifTrue: [evt := self generateMouseEvent: evtBuf].
  type = EventTypeKeyboard
  ifTrue: [evt := self generateKeyboardEvent: evtBuf].
  type = EventTypeDragDropFiles
  ifTrue: [evt := self generateDropFilesEvent: evtBuf].
+ type = EventTypeWindow
+ ifTrue:[evt := self generateWindowEvent: evtBuf].
  "All other events are ignored"
  (type ~= EventTypeDragDropFiles and: [evt isNil]) ifTrue: [^self].
  evt isNil
  ifFalse:
  ["Finally, handle it"
 
  self handleEvent: evt.
  hadAny := true.
 
  "For better user feedback, return immediately after a mouse event has been processed."
  evt isMouse ifTrue: [^self]]].
  "note: if we come here we didn't have any mouse events"
  mouseClickState notNil
  ifTrue:
  ["No mouse events during this cycle. Make sure click states time out accordingly"
 
  mouseClickState handleEvent: lastMouseEvent asMouseMove from: self].
  hadAny
  ifFalse:
  ["No pending events. Make sure z-order is up to date"
 
  self mouseOverHandler processMouseOver: lastMouseEvent]!

Item was added:
+ ----- Method: WindowEvent>>isWindowEvent (in category 'testing') -----
+ isWindowEvent
+ ^true!

Item was added:
+ ----- Method: MorphicEvent>>isWindowEvent (in category 'testing') -----
+ isWindowEvent
+ ^false!

Item was added:
+ ----- Method: WindowEvent>>rectangle (in category 'accessing') -----
+ rectangle
+ ^rectangle!

Item was added:
+ ----- Method: WindowEvent>>action (in category 'accessing') -----
+ action
+ ^action!

Item was changed:
  BorderedMorph subclass: #PasteUpMorph
  instanceVariableNames: 'presenter model cursor padding backgroundMorph turtleTrailsForm turtlePen lastTurtlePositions isPartsBin autoLineLayout indicateCursor resizeToFit wantsMouseOverHalos worldState griddingOn'
+ classVariableNames: 'DisableDeferredUpdates MinCycleLapse StillAlive WindowEventHandler'
- classVariableNames: 'DisableDeferredUpdates MinCycleLapse StillAlive'
  poolDictionaries: ''
  category: 'Morphic-Worlds'!
 
  !PasteUpMorph commentStamp: '<historical>' prior: 0!
  A morph whose submorphs comprise a paste-up of rectangular subparts which "show through".  Anything called a 'Playfield' is a PasteUpMorph.
 
  Facilities commonly needed on pages of graphical presentations and on simulation playfields, such as the painting of new objects, turtle trails, gradient fills, background paintings, parts-bin behavior, collision-detection, etc., are (or will be) provided.
 
  A World, the entire Smalltalk screen, is a PasteUpMorph.  A World responds true to isWorld.  Morph subclasses that have specialized menus (BookMorph) build them in the message addBookMenuItemsTo:hand:.  A PasteUpMorph that is a world, builds its menu in HandMorph buildWorldMenu.
 
  presenter A Presenter in charge of stopButton stepButton and goButton,
  mouseOverHalosEnabled soundsEnabled fenceEnabled coloredTilesEnabled.
  model <not used>
  cursor ??
  padding ??
  backgroundMorph A Form that covers the background.
  turtleTrailsForm Moving submorphs may leave trails on this form.
  turtlePen Draws the trails.
  lastTurtlePositions A Dictionary of (aPlayer -> aPoint) so turtle trails can be drawn
  only once each step cycle.  The point is the start of the current stroke.
  isPartsBin If true, every object dragged out is copied.
  autoLineLayout ??
  indicateCursor ??
  resizeToFit ??
  wantsMouseOverHalos If true, simply moving the cursor over a submorph brings up its halo.
  worldState If I am also a World, keeps the hands, damageRecorder, stepList etc.
  griddingOn If true, submorphs are on a grid
 
  !

Item was added:
+ ----- Method: WindowEvent>>rectangle: (in category 'accessing') -----
+ rectangle: aValue
+ rectangle := aValue.!

Item was added:
+ ----- Method: PasteUpMorph>>wantsWindowEvent: (in category 'event handling') -----
+ wantsWindowEvent: anEvent
+ ^self isWorldMorph or: [self windowEventHandler notNil]!

Item was added:
+ ----- Method: WindowEvent>>action: (in category 'accessing') -----
+ action: aValue
+ action := aValue.!

Item was added:
+ ----- Method: PasteUpMorph>>windowEventHandler: (in category 'event handling') -----
+ windowEventHandler: anObject
+ "This is a class variable so it is global to all projects and does not get saved"
+ WindowEventHandler := anObject
+ !

Item was added:
+ ----- Method: PasteUpMorph>>windowEventHandler (in category 'event handling') -----
+ windowEventHandler
+ "This is a class variable so it is global to all projects and does not get saved"
+ ^WindowEventHandler!

Item was added:
+ ----- Method: Morph>>handleWindowEvent: (in category 'events-processing') -----
+ handleWindowEvent: anEvent
+ "Handle an event concerning our host window"
+ anEvent wasHandled ifTrue:[^self]. "not interested"
+ (self wantsWindowEvent: anEvent) ifFalse:[^self].
+ anEvent wasHandled: true.
+ self windowEvent: anEvent.
+ !

Item was added:
+ ----- Method: WindowEvent>>sentTo: (in category 'dispatching') -----
+ sentTo:anObject
+ "Dispatch the receiver into anObject"
+ ^anObject handleWindowEvent: self.!

Item was added:
+ ----- Method: Morph>>windowEvent: (in category 'event handling') -----
+ windowEvent: anEvent
+ "Host window event"!