Packages June 2016

packages@lists.squeakfoundation.org

1 participants
85 discussions

The Trunk: SMLoader-tpr.87.mcz
by commits＠source.squeak.org 21 Jun '16

21 Jun '16

tim Rowledge uploaded a new version of SMLoader to project The Trunk: http://source.squeak.org/trunk/SMLoader-tpr.87.mcz ==================== Summary ==================== Name: SMLoader-tpr.87 Author: tpr Time: 21 June 2016, 1:29:19.632444 pm UUID: e1857350-474a-4c4d-a5af-f8d6226c3f79 Ancestors: SMLoader-mt.86 Improve (hopefully) the SM release browser so that a) when hitting the save button it automatically accepts changed text in the name/version/script etc views, thus avoiding the need to accept each one individually. b) instead of a blank script view we provide some examples to offer a clue to the user =============== Diff against SMLoader-mt.86 =============== Item was added: + ----- Method: SMReleaseBrowser>>exampleLoadScript (in category 'private') ----- + exampleLoadScript + "this is an example load script to offer the user rather than a blank view" + + ^'"This is where you need to provide an install script; you may need to handle prerequisites first and then load the actual package(s) Take a look at http://wiki.squeak.org/squeak/6182 for more info, especially about creating a ''load latest version'' script" + "Example to load a prerequisite package - " + SMSqueakMap default + installPackageNamed: ''myPackage'' + version: ''release name''. + "Example to load myPackage if a certain class is not already in the image -" + (Smalltalk hasClassNamed: #MyPackage) + ifFalse:[SMSqueakMap default + installPackageNamed: ''myPackage'' + version: ''release name'']. + "Or load several specifc mcz files -" + #( ''MyPackagePartA-abc.1.mcz'' ''MyPackagePartB-abc.42.mcz'' ) do: + [:each| (Installer repository: ''http://www.squeaksource.com/MyPackages'') install: each]'! Item was changed: ----- Method: SMReleaseBrowser>>loadScript (in category 'model access') ----- loadScript "The Smalltalk code needed to install this release of this package." + ^ loadScript + ifNil: [| scriptName | + scriptName := release downloadFileName. + loadScript := scriptName isEmptyOrNil + ifFalse: [(scriptName asLowercase endsWith: '.st') + ifTrue: [release contents]] + ifTrue: [self exampleLoadScript]]! - ^ loadScript ifNil: - [ | scriptName | - scriptName := release downloadFileName. - loadScript := scriptName isEmptyOrNil ifFalse: - [ (scriptName asLowercase endsWith: '.st') ifTrue: [ release contents ] ] ]! Item was changed: ----- Method: SMReleaseBrowser>>validateCanSave (in category 'private') ----- validateCanSave + "accept any changes in the text field morphs etc, then validate the input as best we can" + self changed: #acceptChanges. self username isEmptyOrNil ifTrue: [ self userError: 'username required' ]. self note isEmptyOrNil ifTrue: [ self userError: 'note required' ]. self version isEmptyOrNil ifTrue: [ self userError: 'version required' ] ifFalse: [ (self version includes: $+) ifTrue: [ self userError: 'Plus sign not allowed in version name because it is reserved by HTTP.' ] ]!

1 0

The Trunk: Morphic-mt.1184.mcz
by commits＠source.squeak.org 21 Jun '16

21 Jun '16

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1184.mcz ==================== Summary ==================== Name: Morphic-mt.1184 Author: mt Time: 21 June 2016, 2:12:23.053974 pm UUID: 6dad4a60-1b46-d049-a8af-afaae6989874 Ancestors: Morphic-mt.1183 Fixes regression (?) to make opening sub-sub menus -- not to the right but to the left due to limited screen space -- work again. =============== Diff against Morphic-mt.1183 =============== Item was changed: ----- Method: MenuMorph>>mouseMove: (in category 'events') ----- mouseMove: evt " If the mouse moves over an item not selected, we try to set it as selected. If this happens depends on that the current selected item wants to release its selection. " + self selectedItem ifNil: [ + self + selectItem: ( + self items + detect: [ :each | each containsPoint: evt position ] + ifNone: [ nil ]) + event: evt]. - "Note: The following does not traverse upwards but it's the best I can do for now" - popUpOwner ifNotNil:[(popUpOwner activateOwnerMenu: evt) ifTrue: [^ self]]. - self selectedItem ifNil: [ ^ self ]. - (self selectedItem containsPoint: evt position) ifTrue: [ ^ self ]. - self - selectItem: ( - self items - detect: [ :each | each containsPoint: evt position ] - ifNone: [ nil ]) - event: evt. - "Transfer control to *either* the currently active submenu or the pop up owner, if any. Since the active sub menu is always displayed upfront check it first." + self selectedItem ifNotNil: [ + (self selectedItem activateSubmenu: evt) - selectedItem ifNotNil: [ - (selectedItem activateSubmenu: evt) ifTrue: [ ^self ] ifFalse: [ (self containsPoint: evt position) ifFalse: [ + self selectItem: nil event: evt ] ] ]. + + "Note: The following does not traverse upwards but it's the best I can do for now" + popUpOwner ifNotNil:[(popUpOwner activateOwnerMenu: evt) ifTrue: [^ self]]. + ! - self selectItem: nil event: evt ] ] ].!

1 0

The Trunk: Morphic-mt.1183.mcz
by commits＠source.squeak.org 21 Jun '16

21 Jun '16

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1183.mcz ==================== Summary ==================== Name: Morphic-mt.1183 Author: mt Time: 21 June 2016, 2:05:38.378974 pm UUID: 56a07e0a-08c1-6d4b-8275-9c6a2affdba7 Ancestors: Morphic-mt.1182 Fixes regression in docking bar. A simple click now keeps the menu open again. =============== Diff against Morphic-mt.1182 =============== Item was changed: ----- Method: DockingBarItemMorph>>mouseDown: (in category 'events') ----- mouseDown: evt "Handle a mouse down event. Menu items get activated when the mouse is over them." (evt shiftPressed and:[self wantsKeyboardFocusOnShiftClick]) ifTrue: [ ^super mouseDown: evt ]. "enable label editing" isSelected ifTrue: [ - evt hand newMouseFocus: nil. owner selectItem: nil event: evt. ] ifFalse: [ - (self containsPoint: evt position) ifFalse: [ self halt ]. owner activate: evt. "Redirect to menu for valid transitions" owner selectItem: self event: evt. ] ! Item was changed: ----- Method: DockingBarItemMorph>>mouseUp: (in category 'events') ----- mouseUp: evt "Handle a mouse up event. Menu items get activated when the mouse is over them. Do nothing if we're not in a 'valid menu transition', meaning that the current hand focus must be aimed at the owning menu." evt hand mouseFocus == owner ifFalse: [ ^self ]. self contentString ifNotNil: [ self contents: self contentString withMarkers: true inverse: true. self refreshWorld. + (Delay forMilliseconds: 200) wait ].! - (Delay forMilliseconds: 200) wait ]. - owner rootMenu selectItem: nil event: evt. - self invokeWithEvent: evt! Item was added: + ----- Method: DockingBarMorph>>indicateKeyboardFocus (in category 'testing') ----- + indicateKeyboardFocus + ^ false! Item was changed: ----- Method: DockingBarMorph>>mouseDown: (in category 'events-processing') ----- mouseDown: evt (self fullContainsPoint: evt position) ifFalse: [ self selectItem: nil event: evt. + self deleteIfPopUp: evt ]! - evt hand releaseMouseFocus: self ]! Item was added: + ----- Method: DockingBarMorph>>mouseUp: (in category 'events-processing') ----- + mouseUp: evt + + evt hand newMouseFocus: self.! Item was changed: ----- Method: MenuMorph>>mouseMove: (in category 'events') ----- mouseMove: evt " If the mouse moves over an item not selected, we try to set it as selected. If this happens depends on that the current selected item wants to release its selection. " + "Note: The following does not traverse upwards but it's the best I can do for now" + popUpOwner ifNotNil:[(popUpOwner activateOwnerMenu: evt) ifTrue: [^ self]]. + self selectedItem ifNil: [ ^ self ]. (self selectedItem containsPoint: evt position) ifTrue: [ ^ self ]. self selectItem: ( self items detect: [ :each | each containsPoint: evt position ] ifNone: [ nil ]) event: evt. "Transfer control to *either* the currently active submenu or the pop up owner, if any. Since the active sub menu is always displayed upfront check it first." selectedItem ifNotNil: [ (selectedItem activateSubmenu: evt) ifTrue: [ ^self ] ifFalse: [ (self containsPoint: evt position) ifFalse: [ + self selectItem: nil event: evt ] ] ].! - self selectItem: nil event: evt ] ] ]. - - "Note: The following does not traverse upwards but it's the best I can do for now" - popUpOwner ifNotNil:[popUpOwner activateOwnerMenu: evt]! Item was changed: ----- Method: MenuMorph>>mouseUp: (in category 'events') ----- mouseUp: evt "Handle a mouse up event. Note: This might be sent from a modal shell." (self fullContainsPoint: evt position) ifFalse:[ + ^ self deleteIfPopUp: evt]. - "Mouse up outside. Release eventual focus and delete if pop up." - evt hand releaseMouseFocus: self. - ^self deleteIfPopUp: evt]. stayUp ifFalse:[ "Still in pop-up transition; keep focus" evt hand newMouseFocus: self].!

1 0

The Trunk: MorphicTests-mt.33.mcz
by commits＠source.squeak.org 20 Jun '16

20 Jun '16

Marcel Taeumel uploaded a new version of MorphicTests to project The Trunk: http://source.squeak.org/trunk/MorphicTests-mt.33.mcz ==================== Summary ==================== Name: MorphicTests-mt.33 Author: mt Time: 20 June 2016, 5:14:51.500796 pm UUID: 18fd6b33-66f2-d541-84a8-d8ede4a28134 Ancestors: MorphicTests-mt.32 More tests for Morphic event dispatchs. Use custom hand morph for these tests. =============== Diff against MorphicTests-mt.32 =============== Item was added: + HandMorph subclass: #HandMorphForEventTests + instanceVariableNames: 'eventsDuringCapture eventsDuringBubble eventsRejected eventsFiltered isHandling' + classVariableNames: '' + poolDictionaries: '' + category: 'MorphicTests-Events'! Item was added: + ----- Method: HandMorphForEventTests>>eventsDuringBubble (in category 'accessing') ----- + eventsDuringBubble + ^ eventsDuringBubble ifNil: [eventsDuringBubble := OrderedCollection new]! Item was added: + ----- Method: HandMorphForEventTests>>eventsDuringCapture (in category 'accessing') ----- + eventsDuringCapture + ^ eventsDuringCapture ifNil: [eventsDuringCapture := OrderedCollection new]! Item was added: + ----- Method: HandMorphForEventTests>>eventsFiltered (in category 'accessing') ----- + eventsFiltered + ^ eventsFiltered ifNil: [eventsFiltered := OrderedCollection new]! Item was added: + ----- Method: HandMorphForEventTests>>eventsRejected (in category 'accessing') ----- + eventsRejected + ^ eventsRejected ifNil: [eventsRejected := OrderedCollection new]! Item was added: + ----- Method: HandMorphForEventTests>>filterEvent:for: (in category 'event filtering') ----- + filterEvent: anEvent for: aMorphOrNil + + self eventsFiltered add: anEvent copy -> aMorphOrNil. + ^ anEvent! Item was added: + ----- Method: HandMorphForEventTests>>handleEvent: (in category 'events-processing') ----- + handleEvent: anEvent + + (isHandling == true and: [(#(mouseOver mouseMove) includes: anEvent type) not]) ifTrue: [Error signal: 'Recursive handling detected!!']. + isHandling := true. + self eventsDuringBubble add: anEvent copy. + [^ super handleEvent: anEvent] + ensure: [isHandling := false].! Item was added: + ----- Method: HandMorphForEventTests>>handleEventSilently: (in category 'events-processing') ----- + handleEventSilently: anEvent + + ^ super handleEvent: anEvent! Item was added: + ----- Method: HandMorphForEventTests>>processEvent:using: (in category 'events-processing') ----- + processEvent: anEvent using: dispatcher + + self eventsDuringCapture add: anEvent copy. + ^ super processEvent: anEvent using: dispatcher! Item was added: + ----- Method: HandMorphForEventTests>>rejectsEvent: (in category 'events-processing') ----- + rejectsEvent: anEvent + + ^ (super rejectsEvent: anEvent) + ifTrue: [self eventsRejected add: anEvent copy. true] + ifFalse: [false]! Item was added: + ----- Method: MorphicEventDispatcherTests>>test08FocusEventBubblingNoHand (in category 'tests') ----- + test08FocusEventBubblingNoHand + "If you drag something, do not bubble up to the hand." + + | m1 | + m1 := MorphForEventTests new noMouseDown. + hand grabMorph: m1. + + hand newKeyboardFocus: m1. + + self assert: (hand eventsDuringBubble noneSatisfy: [:ea | ea isKeystroke]). + self assert: (m1 eventsDuringBubble noneSatisfy: [:ea | ea isKeystroke]). + + self + shouldnt: [hand handleEventSilently: (self keystroke: $x at: 0@0)] + raise: Error. + + self assert: (hand eventsDuringBubble noneSatisfy: [:ea | ea isKeystroke]). + self assert: (m1 eventsDuringBubble anySatisfy: [:ea | ea isKeystroke]). + ! Item was added: + ----- Method: MorphicEventDispatcherTests>>test09FocusEventCapturingNoHand (in category 'tests') ----- + test09FocusEventCapturingNoHand + "Avoid duplication of capture step in hand for focus events." + + | m1 | + m1 := MorphForEventTests new noMouseDown. + hand grabMorph: m1. + + hand newKeyboardFocus: m1. + + self assert: (hand eventsDuringCapture noneSatisfy: [:ea | ea isKeystroke]). + self assert: (m1 eventsDuringCapture noneSatisfy: [:ea | ea isKeystroke]). + + hand handleEventSilently: (self keystroke: $x at: 0@0). + + self assert: (hand eventsDuringCapture noneSatisfy: [:ea | ea isKeystroke]). + self assert: (m1 eventsDuringCapture noneSatisfy: [:ea | ea isKeystroke]).! Item was changed: ----- Method: UserInputEventTests>>setUp (in category 'running') ----- setUp super setUp. + - world := (PasteUpMorph newWorldForProject: nil) extent: 300@200; viewBox: (0@0 extent: 300@200); yourself. (world instVarNamed: #worldState) instVarNamed: #canvas put: (Form extent: 300@200 depth: 32) getCanvas. + hand := HandMorphForEventTests new. + + world + removeHand: world firstHand; "the default hand" + addHand: hand.! - hand := world firstHand.! Item was added: + ----- Method: UserInputEventTests>>tearDown (in category 'running') ----- + tearDown + + hand showHardwareCursor: true. "Nasty side-effect" + super tearDown.!

1 0

The Trunk: Morphic-mt.1182.mcz
by commits＠source.squeak.org 20 Jun '16

20 Jun '16

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1182.mcz ==================== Summary ==================== Name: Morphic-mt.1182 Author: mt Time: 20 June 2016, 5:13:55.570796 pm UUID: 825d8e52-1878-af49-9f7a-437b23e68d8c Ancestors: Morphic-mt.1181 Moves implementation of focus event dispatching from various places into MorphicEventDispatcher. This will ensure consistency in the future because MorphicEventDispatcher encode the tree iteration with capturing and bubbling. Doing a focus event is just a shortcut into the tree. TextMorphs use that. Pop-up menus use that. Modal dialogs use that. Fixes missing coordinate transformations when capturing and bubbling for focus events. Simplify focus-related code in MenuMorph, UserDialogBoxMorph, and DockingBarMorph. At the time of writing, there seems to be no need anymore for Morph >> #handleFocusEvent:. Still, keep it for compatibility to other projects. =============== Diff against Morphic-mt.1181 =============== Item was removed: - ----- Method: DockingBarMorph>>handleFocusEvent: (in category 'events-processing') ----- - handleFocusEvent: evt - "Handle focus events. Valid menu transitions are determined based on the menu currently holding the focus after the mouse went down on one of its children." - - | result filteredEvent | - (evt isMouse and:[ evt isMouseUp ]) ifTrue:[^ evt]. - - result := self processEvent: evt. - filteredEvent := result == #rejected ifTrue: [evt] ifFalse: [result]. - - "Need to handle keyboard input if we have the focus." - filteredEvent isKeyboard ifTrue: [^ super handleFocusEvent: filteredEvent]. - - "We need to handle button clicks outside and transitions to local popUps so throw away everything else" - (filteredEvent isMouseOver or:[filteredEvent isMouse not]) ifTrue:[^filteredEvent]. - "What remains are mouse buttons and moves" - filteredEvent isMove ifFalse:[^super handleFocusEvent: filteredEvent]. "handle clicks outside by regular means" - "Now it's getting tricky. On #mouseMove we might transfer control to *either* the currently active submenu or the pop up owner, if any. Since the active sub menu is always displayed upfront check it first." - selectedItem ifNotNil:[(selectedItem activateSubmenu: filteredEvent) ifTrue:[^filteredEvent]]. - ! Item was added: + ----- Method: DockingBarMorph>>mouseMove: (in category 'events-processing') ----- + mouseMove: evt + "We might transfer control to *either* the currently active submenu or the pop up owner, if any. Since the active sub menu is always displayed upfront check it first." + + selectedItem ifNotNil:[selectedItem activateSubmenu: evt].! Item was added: + ----- Method: DockingBarMorph>>processFocusEvent:using: (in category 'events-processing') ----- + processFocusEvent: evt using: dispatcher + + ^ dispatcher dispatchFocusEventFully: evt with: self! Item was added: + ----- Method: DockingBarMorph>>wantsEveryMouseMove (in category 'events-processing') ----- + wantsEveryMouseMove + ^ true! Item was changed: ----- Method: HandMorph>>sendFocusEvent:to:clear: (in category 'private events') ----- sendFocusEvent: anEvent to: focusHolder clear: aBlock "Send the event to the morph currently holding the focus" + | result w | w := focusHolder world ifNil:[aBlock value. ^ anEvent]. w becomeActiveDuring:[ ActiveHand := self. ActiveEvent := anEvent. + result := focusHolder processFocusEvent: anEvent. - result := focusHolder handleFocusEvent: - (anEvent transformedBy: (focusHolder transformedFrom: self)). ]. + ^ result == #rejected ifTrue: [anEvent] ifFalse: [result "filtered event"]! - ^result == #rejected ifTrue: [anEvent] ifFalse: [result "filtered event"]! Item was removed: - ----- Method: MenuMorph>>handleFocusEvent: (in category 'events') ----- - handleFocusEvent: evt - "Handle focus events. Valid menu transitions are determined based on the menu currently holding the focus after the mouse went down on one of its children." - | result filteredEvent | - result := self processEvent: evt. - filteredEvent := result == #rejected ifTrue: [evt] ifFalse: [result]. - - "Need to handle keyboard input if we have the focus." - filteredEvent isKeyboard ifTrue: [^ super handleFocusEvent: filteredEvent]. - - "We need to handle button clicks outside and transitions to local popUps so throw away everything else" - (filteredEvent isMouseOver or:[filteredEvent isMouse not]) ifTrue:[^filteredEvent]. - "What remains are mouse buttons and moves" - filteredEvent isMove ifFalse:[^super handleFocusEvent: filteredEvent]. "handle clicks outside by regular means" - "Now it's getting tricky. On #mouseMove we might transfer control to *either* the currently active submenu or the pop up owner, if any. Since the active sub menu is always displayed upfront check it first." - selectedItem ifNotNil: [ - (selectedItem activateSubmenu: filteredEvent) - ifTrue: [ ^filteredEvent ] - ifFalse: [ - (self containsPoint: filteredEvent position) ifFalse: [ - self selectItem: nil event: filteredEvent ] ] ]. - "Note: The following does not traverse upwards but it's the best I can do for now" - popUpOwner ifNotNil:[(popUpOwner activateOwnerMenu: filteredEvent) ifTrue:[^filteredEvent]]. - ^ filteredEvent! Item was removed: - ----- Method: MenuMorph>>handleMouseMove: (in category 'events') ----- - handleMouseMove: evt - " If the mouse moves over an item not selected, we try to set it as selected. - If this happens depends on that the current selected item wants to release - its selection. " - - self selectedItem ifNil: [ ^super handleMouseMove: evt ]. - (self selectedItem containsPoint: evt position) ifTrue: [ ^super handleMouseMove: evt ]. - self - selectItem: ( - self items - detect: [ :each | each containsPoint: evt position ] - ifNone: [ nil ]) - event: evt. - super handleMouseMove: evt! Item was added: + ----- Method: MenuMorph>>mouseMove: (in category 'events') ----- + mouseMove: evt + " If the mouse moves over an item not selected, we try to set it as selected. + If this happens depends on that the current selected item wants to release + its selection. " + + self selectedItem ifNil: [ ^ self ]. + (self selectedItem containsPoint: evt position) ifTrue: [ ^ self ]. + self + selectItem: ( + self items + detect: [ :each | each containsPoint: evt position ] + ifNone: [ nil ]) + event: evt. + + "Transfer control to *either* the currently active submenu or the pop up owner, if any. Since the active sub menu is always displayed upfront check it first." + selectedItem ifNotNil: [ + (selectedItem activateSubmenu: evt) + ifTrue: [ ^self ] + ifFalse: [ + (self containsPoint: evt position) ifFalse: [ + self selectItem: nil event: evt ] ] ]. + + "Note: The following does not traverse upwards but it's the best I can do for now" + popUpOwner ifNotNil:[popUpOwner activateOwnerMenu: evt]! Item was added: + ----- Method: MenuMorph>>processFocusEvent:using: (in category 'events') ----- + processFocusEvent: evt using: dispatcher + + ^ dispatcher dispatchFocusEventFully: evt with: self! Item was added: + ----- Method: MenuMorph>>wantsEveryMouseMove (in category 'events') ----- + wantsEveryMouseMove + ^ true! Item was changed: ----- Method: Morph>>handleFocusEvent: (in category 'events-processing') ----- handleFocusEvent: anEvent + "Handle the given event. This message is sent if the receiver currently has the focus and is therefore receiving events directly from some hand. However, it might already have been handled due to overrides in #processFocusEvent:using:. We might want to get rid of this call-back in the future..." - "Handle the given event. This message is sent if the receiver currently has the focus and is therefore receiving events directly from some hand. + ^ anEvent wasHandled + ifTrue: [anEvent] + ifFalse: [self handleEvent: anEvent]! - 1) Event bubbling. Do event bubbling known from MorphicEventDispatcher by calling #handleEvent: also on all owners. - 2) Event capture filters. Walk along the owner chain in reverse order and apply capture filters as known from MorphicEventDispatcher. - - If you want to overwrite this in a subclass (for example to implement modal dialogs) ensure to call super instead if #handleEvent: directly." - - | filteredEvent | - filteredEvent := anEvent. - - "TODO: Add a check to ensure that our event dispatcher is actually of kind MorphicEventDispatcher?!! We do copy its behavior though... like self defaultEventDispatcher class == MorphicEventDispatcher? Or #isKindOf:? Anyway, the outermost morph determines the event dispatcher. See HandMorph >> #sendEvent:focus:clear: and PasteUpMorph >> #processEvent:." - - "Event capturing. Filters only because the capturing phase was bypassed by using the keyboard/mouse focus." - self withAllOwners reverseDo: [:morph | "reverse order to comply with default MorphEventDispatcher" - morph == anEvent hand ifFalse: [ "Fixes drag-and-drop bug." - filteredEvent := morph sendFilterEventCapture: filteredEvent for: morph. - filteredEvent wasIgnored ifTrue: [^ filteredEvent]]]. - - "Event bubbling. Filters are processed in #handleEvent:." - self withAllOwnersDo: [:morph | - morph == anEvent hand ifFalse: [ "Fixes drag-and-drop bug." - filteredEvent := morph handleEvent: filteredEvent. - filteredEvent wasIgnored ifTrue: [^ filteredEvent]]]. - - ^ filteredEvent! Item was added: + ----- Method: Morph>>processFocusEvent: (in category 'events-processing') ----- + processFocusEvent: anEvent + + ^self processFocusEvent: anEvent using: self defaultEventDispatcher! Item was added: + ----- Method: Morph>>processFocusEvent:using: (in category 'events-processing') ----- + processFocusEvent: anEvent using: defaultDispatcher + "Event dispatching shortcut." + + ^ defaultDispatcher dispatchFocusEvent: anEvent with: self! Item was changed: + ----- Method: MorphicEventDispatcher>>dispatchEvent:toSubmorphsOf: (in category 'support') ----- - ----- Method: MorphicEventDispatcher>>dispatchEvent:toSubmorphsOf: (in category 'private') ----- dispatchEvent: anEvent toSubmorphsOf: aMorph "Dispatch the given event to the submorphs of the given morph. For coordinate transformations, work only with copies. Either return the given event or a copy of any filtered event to employ immutability to some extent. --- PRIVATE!!" | localEvent filteredEvent | aMorph submorphsDo: [:child | localEvent := anEvent transformedBy: (child transformedFrom: aMorph). filteredEvent := child processEvent: localEvent using: self. "use same dispatcher" filteredEvent == #rejected ifFalse: [ "some event or #rejected symbol" self flag: #overlappingChildren. "mt: We cannot give two overlapping siblings the chance to handle the event!!" + ^ self nextFromOriginal: anEvent local: localEvent filtered: filteredEvent]]. - filteredEvent == localEvent - ifTrue: [ - localEvent wasHandled ifTrue: [anEvent copyHandlerState: localEvent]. - anEvent wasIgnored: localEvent wasIgnored. - ^ anEvent] - ifFalse: [ - filteredEvent := filteredEvent copy. - filteredEvent translateTo: anEvent position. "restore to untransformed coordinates" - filteredEvent wasHandled ifFalse: [filteredEvent copyHandlerState: anEvent]. "restore handler if needed" - ^ filteredEvent]]]. ^ #rejected! Item was changed: + ----- Method: MorphicEventDispatcher>>dispatchEvent:withHandler:withMorph: (in category 'support') ----- - ----- Method: MorphicEventDispatcher>>dispatchEvent:withHandler:withMorph: (in category 'private') ----- dispatchEvent: anEvent withHandler: aHandler withMorph: aMorph "Perform the actual event dispatch. Use the given object as handler. Ask submorphs first to handle the event. Then bubble up. Stop if ignored. Note that event rejection and event filters are two separete concepts. Filters come from the outside. Rejection is a morph's decision. * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event." | result filteredEvent | result := self dispatchEvent: anEvent toSubmorphsOf: aMorph. result == #rejected "Anybody?" ifFalse: [filteredEvent := result] ifTrue: [ "My submorphs did not want it. Do I want it anyway? It's about locked children..." (aMorph containsPoint: anEvent position event: anEvent) ifFalse: [^ #rejected]. filteredEvent := anEvent "there was no filtering, only basic rejects"]. "Receiver is in the top-most unlocked, visible chain." (aHandler notNil and: [filteredEvent wasIgnored not]) ifTrue: [filteredEvent := aHandler handleEvent: filteredEvent]. ^ filteredEvent! Item was added: + ----- Method: MorphicEventDispatcher>>dispatchFocusEvent:with: (in category 'focus events') ----- + dispatchFocusEvent: anEventWithGlobalPosition with: focusMorph + "Dispatch the given event to the given morph. Simulate capturing phase, handle the event, then do bubbling." + + | currentEvent | + "1) Capturing phase." + currentEvent := self doCapturingForFocusEvent: anEventWithGlobalPosition with: focusMorph. + currentEvent == #rejected ifTrue: [^ #rejected]. + currentEvent wasIgnored ifTrue: [^ currentEvent]. + + "2) No sub-tree processing here. Use #dispatchFocusEventFully:with: if you want that, too." + + "3) Let the focus morph handle the event." + currentEvent := self doHandlingForFocusEvent: currentEvent with: focusMorph. + currentEvent wasIgnored ifTrue: [^ currentEvent]. + + "4) Bubbling phase" + ^ self doBubblingForFocusEvent: currentEvent with: focusMorph! Item was added: + ----- Method: MorphicEventDispatcher>>dispatchFocusEventFully:with: (in category 'focus events') ----- + dispatchFocusEventFully: anEventWithGlobalPosition with: focusMorph + "Dispatch the given event to the given morph. Do capturing, processing in sub-tree, and bubbling." + + | currentEvent | + "1) Capturing phase." + currentEvent := self doCapturingForFocusEvent: anEventWithGlobalPosition with: focusMorph. + currentEvent == #rejected ifTrue: [^ #rejected]. + currentEvent wasIgnored ifTrue: [^ currentEvent]. + + "2) Sub-tree processing." + currentEvent := self doProcessingForFocusEvent: currentEvent with: focusMorph. + currentEvent wasIgnored ifTrue: [^ currentEvent]. + + "3) Let the focus morph handle the event. Usually no effect because previous sub-tree processing involved the focus morph already -- at least in the bubbling phase. Skip it?" + currentEvent := self doHandlingForFocusEvent: currentEvent with: focusMorph. + currentEvent wasIgnored ifTrue: [^ currentEvent]. + + "4) Bubbling phase." + ^ self doBubblingForFocusEvent: currentEvent with: focusMorph! Item was added: + ----- Method: MorphicEventDispatcher>>doBubblingForFocusEvent:with: (in category 'support') ----- + doBubblingForFocusEvent: anEvent with: focusMorph + "Simulate real event bubbling up to the focused morph's outermost owner. Applies event bubble filters via Morph >> #handleEvent:. Watch out for coordinate transformations and some globals (ActiveWorld, ...)." + + | currentEvent filteredEvent localEvent referenceMorph | + currentEvent := anEvent. + referenceMorph := anEvent hand. + + focusMorph allOwnersDo: [:ownerMorph | + ownerMorph == anEvent hand ifFalse: [ "Never bubble up to the hand morph but only up to the world." + localEvent := currentEvent transformedBy: (ownerMorph transformedFrom: referenceMorph). + filteredEvent := ownerMorph handleEvent: localEvent. + currentEvent := self nextFromOriginal: currentEvent local: localEvent filtered: filteredEvent. + currentEvent wasIgnored ifTrue: [^ currentEvent]]]. + + ^ currentEvent! Item was added: + ----- Method: MorphicEventDispatcher>>doCapturingForFocusEvent:with: (in category 'support') ----- + doCapturingForFocusEvent: anEvent with: focusMorph + "Simulate real event capturing down to the focused morph. Apply event capture filters. Watch out for coordinate transformations. Keep the filter-ignore-reject order like in Morph >> #processEvent:using:." + + | currentEvent filteredEvent localEvent referenceMorph | + currentEvent := anEvent. + referenceMorph := anEvent hand. + + "Event capturing. Filters only because the capturing phase was bypassed by using the keyboard/mouse focus." + focusMorph withAllOwners reverseDo: [:ownerMorph | "reverse order to comply with regular dispatching" + ownerMorph == anEvent hand ifFalse: [ "Never dispatch the hand morph. It already did so." + localEvent := currentEvent transformedBy: (ownerMorph transformedFrom: referenceMorph). + + filteredEvent := ownerMorph sendFilterEventCapture: localEvent for: ownerMorph. + + "Ignoring has higher priority but the reject-check must be with local event coodinates." + (filteredEvent wasIgnored not and: [ownerMorph rejectsEvent: filteredEvent]) + ifTrue: [^ #rejected]. + + currentEvent := self nextFromOriginal: currentEvent local: localEvent filtered: filteredEvent. + currentEvent wasIgnored ifTrue: [^ currentEvent]]]. + + ^ currentEvent! Item was added: + ----- Method: MorphicEventDispatcher>>doHandlingForFocusEvent:with: (in category 'support') ----- + doHandlingForFocusEvent: currentEvent with: focusMorph + + | localEvent filteredEvent | + localEvent := currentEvent transformedBy: (focusMorph transformedFrom: currentEvent hand). + filteredEvent := focusMorph handleFocusEvent: localEvent. + ^ self nextFromOriginal: currentEvent local: localEvent filtered: filteredEvent.! Item was added: + ----- Method: MorphicEventDispatcher>>doProcessingForFocusEvent:with: (in category 'support') ----- + doProcessingForFocusEvent: currentEvent with: focusMorph + "Sub-tree processing (including capturing from focus morph down to something and bubbling up back to focus morph). Never reject in the end." + + | localEvent filteredEvent | + localEvent := currentEvent transformedBy: (focusMorph transformedFrom: currentEvent hand). + filteredEvent := focusMorph processEvent: localEvent using: self. + ^ filteredEvent == #rejected + ifTrue: [currentEvent] "Can happen if you click, e.g., outside the bounds of the focus morph" + ifFalse: [self nextFromOriginal: currentEvent local: localEvent filtered: filteredEvent]! Item was added: + ----- Method: MorphicEventDispatcher>>nextFromOriginal:local:filtered: (in category 'support') ----- + nextFromOriginal: originalEvent local: localEvent filtered: filteredEvent + "Take the filtered event if different but always keep the original coordinates." + + filteredEvent == localEvent + ifTrue: [ "Use original event but keep track of ignored flag." + localEvent wasHandled ifTrue: [originalEvent copyHandlerState: localEvent]. + originalEvent wasIgnored: localEvent wasIgnored. + ^ originalEvent] + ifFalse: [ "There was an event transformation. Copy, revert coordinates, keep handler state." + | result | + result := filteredEvent copy. "Never mutate position without copying. MouseClickState etc. will break otherwise." + result translateTo: originalEvent position. "restore to untransformed coordinates" + result wasHandled ifFalse: [result copyHandlerState: originalEvent]. + ^ result]. + ! Item was removed: - ----- Method: UserDialogBoxMorph>>handleFocusEvent: (in category 'constructing') ----- - handleFocusEvent: evt - "Handle focus events. Valid menu transitions are determined based on the menu currently holding the focus after the mouse went down on one of its children. Need to handle keyboard input if we have the focus." - - | result filteredEvent | - result := self processEvent: evt. - filteredEvent := result == #rejected ifTrue: [evt] ifFalse: [result]. - - ^ super handleFocusEvent: filteredEvent! Item was added: + ----- Method: UserDialogBoxMorph>>processFocusEvent:using: (in category 'events') ----- + processFocusEvent: evt using: dispatcher + + ^ dispatcher dispatchFocusEventFully: evt with: self!

1 0

The Trunk: WebClient-Core-topa.101.mcz
by commits＠source.squeak.org 17 Jun '16

17 Jun '16

Tobias Pape uploaded a new version of WebClient-Core to project The Trunk: http://source.squeak.org/trunk/WebClient-Core-topa.101.mcz ==================== Summary ==================== Name: WebClient-Core-topa.101 Author: topa Time: 17 June 2016, 9:00:40.215483 pm UUID: 97088e21-0ce9-4029-be2c-4e82d0f0050a Ancestors: WebClient-Core-ul.100 Only close streams that are still connected. =============== Diff against WebClient-Core-ul.100 =============== Item was changed: ----- Method: WebClient>>close (in category 'initialize') ----- close "Close the client's stream" stream ifNotNil:[ + stream isConnected ifTrue: [stream close]. + stream := nil]. - stream close. - stream := nil. - ]. !

1 0

The Trunk: Kernel-eem.1030.mcz
by commits＠source.squeak.org 17 Jun '16

17 Jun '16

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.1030.mcz ==================== Summary ==================== Name: Kernel-eem.1030 Author: eem Time: 16 June 2016, 5:12:46.623829 pm UUID: 67cc43ba-8129-470e-b40f-36d8fc58dee7 Ancestors: Kernel-eem.1029 Fix simulation of the withArgs:executeMethod: and tryPrimitive:withArgs: primitives, as well as providing support for receiver:tryPrimitive:withArgs: when it is implemented. =============== Diff against Kernel-eem.1029 =============== Item was changed: ----- Method: ContextPart>>doPrimitive:method:receiver:args: (in category 'private') ----- + doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments - doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. If successful, push result and return resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes execution needs to be intercepted and simulated to avoid execution running away." | value | "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents the debugger from entering various run-away activities such as spawning a new process, etc. Injudicious use results in the debugger not being able to debug interesting code, such as the debugger itself. hence use primitive 19 with care :-)" "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" primitiveIndex = 19 ifTrue: [ToolSet debugContext: self label:'Code simulation error' contents: nil]. ((primitiveIndex between: 201 and: 222) and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: [((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]. primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]]. primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" [^self send: arguments first to: receiver with: arguments allButFirst super: false]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)]. "Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: + [| effective | + effective := Processor activeProcess effectiveProcess. - [| active effective | - active := Processor activeProcess. - effective := active effectiveProcess. "active == effective" value := primitiveIndex = 186 ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]]. primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:" + [((self objectClass: (arguments at: 1)) == Array + and: [(self objectClass: (arguments at: 2)) includesBehavior: CompiledMethod]) ifFalse: + [^ContextPart primitiveFailTokenFor: #'bad argument']. + (arguments at: 2) numArgs = (arguments at: 1) size ifFalse: + [^ContextPart primitiveFailTokenFor: #'bad number of arguments']. + (arguments at: 2) primitive > 0 ifTrue: + [(arguments at: 2) isQuick ifTrue: + [^self push: (receiver withArgs: (arguments at: 1) executeMethod: (arguments at: 2))]. + ^self doPrimitive: (arguments at: 2) primitive method: (arguments at: 2) receiver: receiver args: (arguments at: 1)]. + ^MethodContext - [^MethodContext sender: self receiver: receiver method: (arguments at: 2) arguments: (arguments at: 1)]. "Closure primitives" (primitiveIndex = 200 and: [self == receiver]) ifTrue: "ContextPart>>closureCopy:copiedValues:; simulated to get startpc right" [^self push: (BlockClosure outerContext: receiver startpc: pc + 2 numArgs: arguments first copiedValues: arguments last)]. + primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" + [(arguments size = 3 + and: [(self objectClass: arguments second) == SmallInteger + and: [(self objectClass: arguments last) == Array]]) ifTrue: + [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. + (arguments size = 2 + and: [(self objectClass: arguments first) == SmallInteger - primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM" - [(arguments size = 2 - and: [arguments first isInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^ContextPart primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last]. value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] + ifFalse: + ["should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs" + receiver tryPrimitive: primitiveIndex withArgs: arguments]]. - ifFalse: [receiver tryPrimitive: primitiveIndex withArgs: arguments]]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]!

1 0

The Trunk: Kernel-eem.1029.mcz
by commits＠source.squeak.org 17 Jun '16

17 Jun '16

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.1029.mcz ==================== Summary ==================== Name: Kernel-eem.1029 Author: eem Time: 16 June 2016, 4:17:52.232323 pm UUID: 118ce27e-414e-4a37-940d-ce167fa5afb7 Ancestors: Kernel-mt.1028 Supply missing simulation methods for the new Mutex primitives and hence render through on code like the following funcitonal again: Mutex new critical: [[Object new] on: Notification do: [:noti| ]] =============== Diff against Kernel-mt.1028 =============== Item was added: + ----- Method: Mutex>>primitiveEnterCriticalSectionOnBehalfOf: (in category 'system simulation') ----- + primitiveEnterCriticalSectionOnBehalfOf: effectiveProcess + "Primitive. Simulate primitiveEnterCriticalSection. The receiver + must be unowned or owned by the effectiveProcess to proceed. + Answer if the process is already owned by the current process." + <primitive: 186> + ^{ContextPart primitiveFailToken. nil}! Item was added: + ----- Method: Mutex>>primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: (in category 'system simulation') ----- + primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effectiveProcess + "Primitive. Simulate primitiveEnterCriticalSection. Attempt to set the ownership + of the receiver. If the receiver is unowned set its owningProcess to the + effectiveProcess and answer false. If the receiver is owned by the effectiveProcess + answer true. If the receiver is owned by some other process answer nil." + <primitive: 187> + ^{ContextPart primitiveFailToken. nil}!

1 0

The Trunk: Graphics-mt.351.mcz
by commits＠source.squeak.org 16 Jun '16

16 Jun '16

Marcel Taeumel uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-mt.351.mcz ==================== Summary ==================== Name: Graphics-mt.351 Author: mt Time: 16 June 2016, 1:56:13.140696 pm UUID: 40df15d7-0c28-2b4e-8be2-231d75e087f8 Ancestors: Graphics-lpc.350 Removes manual kerning corrections for the 7-point DejaVu Sans, which are not necessary anymore. =============== Diff against Graphics-lpc.350 =============== Item was changed: ----- Method: StrikeFont>>ascentKern (in category 'accessing') ----- ascentKern "Return the kern delta for ascenders." + + self depth > 1 ifTrue: [^ 0]. + + "Optimization for traditional 1-bit fonts." + ^ (emphasis allMask: 2) + ifFalse: [0] + ifTrue: [(self ascent-5+4)//4 max: 0] "See makeItalicGlyphs" - (emphasis noMask: 2) ifTrue: [^ 0]. - ^ (self ascent-5+4)//4 max: 0 "See makeItalicGlyphs" ! Item was changed: ----- Method: StrikeFont>>baseKern (in category 'accessing') ----- baseKern "Return the base kern value to be used for all characters." + self depth > 1 ifTrue: [^ 0]. - | italic | - italic := emphasis allMask: 2. + "Optimization for traditional 1-bit fonts." + ^ (emphasis allMask: 2) + ifFalse: [0] + ifTrue: [((self height-1-self ascent+4)//4 max: 0) "See makeItalicGlyphs" + + (((self ascent-5+4)//4 max: 0))]! - glyphs depth > 1 ifTrue: [ - ^(italic or: [ pointSize < 9 ]) - ifTrue: [ 1 ] - ifFalse: [ 0] ]. - - italic ifFalse: [^ 0]. - ^ ((self height-1-self ascent+4)//4 max: 0) "See makeItalicGlyphs" - + (((self ascent-5+4)//4 max: 0))! Item was changed: ----- Method: StrikeFont>>descentKern (in category 'accessing') ----- descentKern "Return the kern delta for descenders." - (emphasis noMask: 2) ifTrue: [^ 0]. - ^ (self height-1-self ascent+4)//4 max: 0 "See makeItalicGlyphs" + self depth > 1 ifTrue: [^ 0]. + + "Optimization for traditional 1-bit fonts." + ^ (emphasis allMask: 2) + ifFalse: [0] + ifTrue: [(self height-1-self ascent+4)//4 max: 0] "See makeItalicGlyphs" + !

1 0

The Trunk: Graphics-lpc.350.mcz
by commits＠source.squeak.org 15 Jun '16

15 Jun '16

Laura Perez Cerrato uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-lpc.350.mcz ==================== Summary ==================== Name: Graphics-lpc.350 Author: lpc Time: 15 June 2016, 2:00:37.274582 pm UUID: 5d02a1bd-65f6-469c-b8b5-456e1dfef5eb Ancestors: Graphics-mt.349 Support for both the current version and the new version of JPEGReadWriter2Plugin =============== Diff against Graphics-mt.349 =============== Item was changed: Form subclass: #ColorForm instanceVariableNames: 'colors cachedDepth cachedColormap' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Display Objects'! + ColorForm class + instanceVariableNames: 'grayScalePalette'! !ColorForm commentStamp: '<historical>' prior: 0! ColorForm is a normal Form plus a color map of up to 2^depth Colors. Typically, one reserves one entry in the color map for transparent. This allows 1, 3, 15, or 255 non-transparent colors in ColorForms of depths 1, 2, 4, and 8 bits per pixel. ColorForms don't support depths greater than 8 bits because that would require excessively large color maps with little real benefit, since 16-bit and 32-bit depths already support thousands and millions of colors. ColorForms have several uses: 1) Precise colors. You can have up to 256 true colors, instead being limited to the 8-bit color palette. 2) Easy transparency. Just store (Color transparent) at the desired position in the color map. 3) Cheap color remapping by changing the color map. A color map is an Array of up to 2^depth Color objects. A Bitmap colorMap is automatically computed and cached for rapid display. Note that if you change the color map, you must resubmit it via the colors: method to flush this cache. ColorForms can be a bit tricky. Note that: a) When you BitBlt from one ColorForm to another, you must remember to copy the color map of the source ColorForm to the destination ColorForm. b) A ColorForm's color map is an array of depth-independent Color objects. BitBlt requires a BitMap of actual pixel values, adjusted to the destination depth. These are different things!! ColorForms automatically maintain a cache of the BitBlt-style color map corresponding to the colors array for the last depth on which the ColorForm was displayed, so there should be little need for clients to work with BitBlt-style color maps. c) The default map for 8 bit depth has black in the first entry, not transparent. Say (cform colors at: 1 put: Color transparent). ! + ColorForm class + instanceVariableNames: 'grayScalePalette'! Item was added: + ----- Method: ColorForm class>>grayScalePalette (in category 'constants') ----- + grayScalePalette + grayScalePalette ifNil: [ + grayScalePalette := (0 to: 255) collect: [:brightness | Color gray: brightness asFloat / 255.0]. + grayScalePalette at: 1 put: Color transparent]. + ^ grayScalePalette! Item was added: + ----- Method: ColorForm>>isGrayScale (in category 'testing') ----- + isGrayScale + ^ self colors = ColorForm grayScalePalette.! Item was changed: ----- Method: Form>>asGrayScale (in category 'converting') ----- asGrayScale "Assume the receiver is a grayscale image. Return a grayscale ColorForm computed by extracting the brightness levels of one color component. This technique allows a 32-bit Form to be converted to an 8-bit ColorForm to save space while retaining a full 255 levels of gray. (The usual colormapping technique quantizes to 8, 16, or 32 levels, which loses information.)" + | f32 srcForm result map bb | - | f32 srcForm result map bb grays | self depth = 32 ifFalse: [ f32 := Form extent: width@height depth: 32. self displayOn: f32. ^ f32 asGrayScale]. self unhibernate. srcForm := Form extent: (width * 4)@height depth: 8. srcForm bits: bits. result := ColorForm extent: width@height depth: 8. map := Bitmap new: 256. 2 to: 256 do: [:i | map at: i put: i - 1]. map at: 1 put: 1. "map zero pixel values to near-black" bb := (BitBlt toForm: result) sourceForm: srcForm; combinationRule: Form over; colorMap: map. 0 to: width - 1 do: [:dstX | bb sourceRect: (((dstX * 4) + 2)@0 extent: 1@height); destOrigin: dstX@0; copyBits]. "final BitBlt to zero-out pixels that were truely transparent in the original" map := Bitmap new: 512. map at: 1 put: 16rFF. (BitBlt toForm: result) sourceForm: self; sourceRect: self boundingBox; destOrigin: 0@0; combinationRule: Form erase; colorMap: map; copyBits. + + result colors: ColorForm grayScalePalette. - grays := (0 to: 255) collect: [:brightness | Color gray: brightness asFloat / 255.0]. - grays at: 1 put: Color transparent. - result colors: grays. ^ result ! Item was added: + ----- Method: Form>>isGrayScale (in category 'testing') ----- + isGrayScale + ^ false! Item was changed: ----- Method: JPEGReadWriter2>>compress:quality: (in category 'public access') ----- compress: aForm quality: quality + "Encode the given Form and answer the compressed ByteArray. Quality goes from 0 (low) to 100 (high), where -1 means default. + We can only compress: + * 32-bit deep Forms + * -32-bit deep Forms + * 16-bit deep Forms + * -16-bit deep Forms + * GrayScale ColorForms (see #isGrayScale)" - "Encode the given Form and answer the compressed ByteArray. Quality goes from 0 (low) to 100 (high), where -1 means default." - | sourceForm jpegCompressStruct jpegErrorMgr2Struct buffer byteCount | + aForm unhibernate. + + sourceForm := self supports8BitGrayscaleJPEGs + ifTrue: [ + (aForm depth = 32) | (aForm depth = 16) | (aForm isGrayScale) + ifTrue: [aForm] + ifFalse: [aForm asFormOfDepth: 32 ]] + ifFalse: [ + (aForm nativeDepth > 0) & ((aForm depth = 32) | ((aForm depth = 16) & (aForm width even))) + ifTrue: [aForm] + ifFalse: [aForm asFormOfDepth: 32 ]]. + - "odd width images of depth 16 give problems; avoid them." - sourceForm := (aForm depth = 32) | (aForm width even & (aForm depth = 16)) - ifTrue: [aForm] - ifFalse: [aForm asFormOfDepth: 32]. jpegCompressStruct := ByteArray new: self primJPEGCompressStructSize. jpegErrorMgr2Struct := ByteArray new: self primJPEGErrorMgr2StructSize. buffer := ByteArray new: sourceForm width * sourceForm height + 1024. byteCount := self primJPEGWriteImage: jpegCompressStruct onByteArray: buffer form: sourceForm quality: quality progressiveJPEG: false errorMgr: jpegErrorMgr2Struct. byteCount = 0 ifTrue: [self error: 'buffer too small for compressed data']. ^ buffer copyFrom: 1 to: byteCount ! Item was changed: ----- Method: JPEGReadWriter2>>nextImageSuggestedDepth: (in category 'public access') ----- + nextImageSuggestedDepth: suggestedDepth + "Decode and answer a Form of the given depth from my stream. Close the stream if it is a file stream. + We can read RGB JPEGs into: + * 32-bit Forms + * -32-bit Forms + * 16-bit Forms (with or without dithering!!) + * -16-bit Forms (with or without dithering!!) + We can read grayscale JPEGs into: + * 32-bit Forms + * -32-bit Forms + * 16-bit Forms (with or without dithering!!) + * -16-bit Forms (with or without dithering!!) + * 8-bit grayScale ColorForms (see #isGrayScale) + * -8-bit grayScale ColorForms (see #isGrayScale)" - nextImageSuggestedDepth: depth - "Decode and answer a Form of the given depth from my stream. Close the stream if it is a file stream. Possible depths are 16-bit and 32-bit." + | bytes width height components form jpegDecompressStruct jpegErrorMgr2Struct | - | bytes width height form jpegDecompressStruct jpegErrorMgr2Struct depthToUse | bytes := stream upToEnd. stream close. jpegDecompressStruct := ByteArray new: self primJPEGDecompressStructSize. jpegErrorMgr2Struct := ByteArray new: self primJPEGErrorMgr2StructSize. self primJPEGReadHeader: jpegDecompressStruct fromByteArray: bytes errorMgr: jpegErrorMgr2Struct. width := self primImageWidth: jpegDecompressStruct. height := self primImageHeight: jpegDecompressStruct. + components := self primImageNumComponents: jpegDecompressStruct. + form := + self supports8BitGrayscaleJPEGs + ifTrue: [ + components = 3 + ifTrue: [ Form extent: width@height depth: suggestedDepth ] + ifFalse: [ (Form extent: width@height depth: suggestedDepth) asGrayScale ]] + ifFalse: [ + Form + extent: width@height + depth: + (suggestedDepth = 32 + ifTrue: [ 32 ] + ifFalse: [ + ((suggestedDepth = 16) & (width even)) + ifTrue: [ 16 ] + ifFalse: [ 32 ]])]. + - "Odd width images of depth 16 gave problems. Avoid them (or check carefully!!)" - depthToUse := ((depth = 32) | width odd) ifTrue: [32] ifFalse: [16]. - form := Form extent: width@height depth: depthToUse. - (width = 0 or: [height = 0]) ifTrue: [^ form]. self primJPEGReadImage: jpegDecompressStruct fromByteArray: bytes onForm: form doDithering: true errorMgr: jpegErrorMgr2Struct. + ^ form! - ^ form - ! Item was changed: ----- Method: JPEGReadWriter2>>nextPutImage:quality:progressiveJPEG: (in category 'public access') ----- nextPutImage: aForm quality: quality progressiveJPEG: progressiveFlag + "Encode the given Form on my stream with the given settings. Quality goes from 0 (low) to 100 (high), where -1 means default. If progressiveFlag is true, encode as a progressive JPEG. + We can compress: + * 32-bit deep Forms + * -32-bit deep Forms + * 16-bit deep + * -16-bit deep + * GrayScale ColorForms (see #isGrayScale)" - "Encode the given Form on my stream with the given settings. Quality goes from 0 (low) to 100 (high), where -1 means default. If progressiveFlag is true, encode as a progressive JPEG." | sourceForm jpegCompressStruct jpegErrorMgr2Struct buffer byteCount | + aForm unhibernate. + + sourceForm := self supports8BitGrayscaleJPEGs + ifTrue: [ + (aForm depth = 32) | (aForm depth = 16) | (aForm isGrayScale) + ifTrue: [aForm] + ifFalse: [aForm asFormOfDepth: 32 ]] + ifFalse: [ + (aForm nativeDepth > 0) & ((aForm depth = 32) | ((aForm depth = 16) & (aForm width even))) + ifTrue: [aForm] + ifFalse: [aForm asFormOfDepth: 32 ]]. + - "odd width images of depth 16 give problems; avoid them." - sourceForm := (aForm depth = 32) | (aForm width even & (aForm depth = 16)) - ifTrue: [aForm] - ifFalse: [aForm asFormOfDepth: 32]. jpegCompressStruct := ByteArray new: self primJPEGCompressStructSize. jpegErrorMgr2Struct := ByteArray new: self primJPEGErrorMgr2StructSize. buffer := ByteArray new: sourceForm width * sourceForm height + 1024. "Try to write the image. Retry with a larger buffer if needed." [ byteCount := self primJPEGWriteImage: jpegCompressStruct onByteArray: buffer form: sourceForm quality: quality progressiveJPEG: progressiveFlag errorMgr: jpegErrorMgr2Struct. byteCount = 0 and: [ buffer size < (sourceForm width * sourceForm height * 3 + 1024) ] ] whileTrue: [ buffer := ByteArray new: buffer size * 2 ]. byteCount = 0 ifTrue: [ self error: 'buffer too small for compressed data' ]. stream next: byteCount putAll: buffer startingAt: 1. self close. ! Item was added: + ----- Method: JPEGReadWriter2>>primImageNumComponents: (in category 'primitives') ----- + primImageNumComponents: aJPEGDecompressStruct + + <primitive: 'primImageNumComponents' module: 'JPEGReadWriter2Plugin'> + ^ 3! Item was added: + ----- Method: JPEGReadWriter2>>primSupports8BitGrayscaleJPEGs (in category 'primitives') ----- + primSupports8BitGrayscaleJPEGs + <primitive: 'primSupports8BitGrayscaleJPEGs' module: 'JPEGReadWriter2Plugin'> + ^ false! Item was added: + ----- Method: JPEGReadWriter2>>supports8BitGrayscaleJPEGs (in category 'testing') ----- + supports8BitGrayscaleJPEGs + ^ self primSupports8BitGrayscaleJPEGs! Item was changed: ----- Method: JPEGReadWriter2>>uncompress:into: (in category 'public access') ----- uncompress: aByteArray into: aForm + ^ self uncompress: aByteArray into: aForm doDithering: true - "Uncompress an image from the given ByteArray into the given Form. - Fails if the given Form has the wrong dimensions or depth. - If aForm has depth 16, do ordered dithering." - - | jpegDecompressStruct jpegErrorMgr2Struct w h | - aForm unhibernate. - jpegDecompressStruct := ByteArray new: self primJPEGDecompressStructSize. - jpegErrorMgr2Struct := ByteArray new: self primJPEGErrorMgr2StructSize. - self - primJPEGReadHeader: jpegDecompressStruct - fromByteArray: aByteArray - errorMgr: jpegErrorMgr2Struct. - w := self primImageWidth: jpegDecompressStruct. - h := self primImageHeight: jpegDecompressStruct. - ((aForm width = w) & (aForm height = h)) ifFalse: [ - ^ self error: 'form dimensions do not match']. - - "odd width images of depth 16 give problems; avoid them" - w odd - ifTrue: [ - aForm depth = 32 ifFalse: [^ self error: 'must use depth 32 with odd width']] - ifFalse: [ - ((aForm depth = 16) | (aForm depth = 32)) ifFalse: [^ self error: 'must use depth 16 or 32']]. - - self primJPEGReadImage: jpegDecompressStruct - fromByteArray: aByteArray - onForm: aForm - doDithering: true - errorMgr: jpegErrorMgr2Struct. ! Item was changed: ----- Method: JPEGReadWriter2>>uncompress:into:doDithering: (in category 'public access') ----- uncompress: aByteArray into: aForm doDithering: ditherFlag "Uncompress an image from the given ByteArray into the given Form. Fails if the given Form has the wrong dimensions or depth. + We can read RGB JPEGs into: + * 32-bit Forms + * -32-bit Forms + * 16-bit Forms (with or without dithering!!) + * -16-bit Forms (with or without dithering!!) + We can read grayscale JPEGs into: + * 32-bit Forms + * -32-bit Forms + * 16-bit Forms (with or without dithering!!) + * -16-bit Forms (with or without dithering!!) + * 8-bit grayScale ColorForms (see #isGrayScale) + * -8-bit grayScale ColorForms (see #isGrayScale)" - If aForm has depth 16 and ditherFlag = true, do ordered dithering." + | jpegDecompressStruct jpegErrorMgr2Struct width height components | + - | jpegDecompressStruct jpegErrorMgr2Struct w h | aForm unhibernate. + jpegDecompressStruct := ByteArray new: self primJPEGDecompressStructSize. jpegErrorMgr2Struct := ByteArray new: self primJPEGErrorMgr2StructSize. self primJPEGReadHeader: jpegDecompressStruct fromByteArray: aByteArray errorMgr: jpegErrorMgr2Struct. + width := self primImageWidth: jpegDecompressStruct. + height := self primImageHeight: jpegDecompressStruct. + components := self primImageNumComponents: jpegDecompressStruct. + + ((aForm width = width) & (aForm height = height)) ifFalse: [ + ^ self error: 'form dimensions do not match' ]. + self supports8BitGrayscaleJPEGs - w := self primImageWidth: jpegDecompressStruct. - h := self primImageHeight: jpegDecompressStruct. - ((aForm width = w) & (aForm height = h)) ifFalse: [ - ^ self error: 'form dimensions do not match']. - - "odd width images of depth 16 give problems; avoid them" - w odd ifTrue: [ + components = 3 + ifTrue: [ + aForm depth = 8 + ifTrue: [ ^ self error: 'Cannot uncompress multi-channel JPEGs into 8-bit deep forms' ]]. + components = 1 + ifTrue: [ + aForm depth = 8 + ifTrue: [ + aForm isGrayScale + ifFalse: [ ^ self error: 'Cannot uncompress single-channel JPEGs into 8-bit deep forms that are not grayscale' ]]]] + - aForm depth = 32 ifFalse: [^ self error: 'must use depth 32 with odd width']] ifFalse: [ + aForm nativeDepth < 0 + ifTrue: [ ^ self error: 'Current plugin version doesn''t support uncompressing JPEGs into little-endian forms' ] + ifFalse: [ + aForm depth = 16 + ifTrue: [ + width odd + ifTrue: [ ^ self error: 'Current plugin version doesn''t support uncompressing JPEGs with an odd width into 16-bit deep forms' ]]. + aForm depth = 8 + ifTrue: [ ^ self error: 'Current plugin version doesn''t support uncompressing JPEGs into 8-bit deep forms' ]]]. - ((aForm depth = 16) | (aForm depth = 32)) ifFalse: [^ self error: 'must use depth 16 or 32']]. self primJPEGReadImage: jpegDecompressStruct fromByteArray: aByteArray onForm: aForm doDithering: ditherFlag errorMgr: jpegErrorMgr2Struct. !

1 0

← Newer
1
2
3
4
5
6
7
8
9
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages June 2016