A new version of GraphicsExternal was added to project The Inbox:
http://source.squeak.org/inbox/GraphicsExternal-cbc.1.mcz

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

Name: GraphicsExternal-cbc.1
Author: cbc
Time: 19 April 2017, 7:55:16.946478 pm
UUID: df42d165-8338-7249-bb13-c1b56113bfd5
Ancestors: 

Moved ExternalForm and ExternalScreen out of EToys and into its own package.  No other changes.

==================== Snapshot ====================

SystemOrganization addCategory: #GraphicsExternal!
SystemOrganization addCategory: #'GraphicsExternal-Tests'!

DisplayScreen subclass: #ExternalScreen
	instanceVariableNames: 'argbMap allocatedForms'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'GraphicsExternal'!

!ExternalScreen commentStamp: '<historical>' prior: 0!
I represent a DisplayScreen that is not part of the Squeak universe. Subclasses must implement the appropriate primitives for creating, destroying and allocating the appropriate external objects.

Note: It is assumed that all external display surfaces are accessible by FXBlt, meaning that any support code must register the surfaces with the surface plugin. This requires that the support code will have a way of accessing the bits of the surface. Although this can be terribly expensive (such as on X where a roundtrip to the server might be required or for an OpenGL display where glReadPixels usually is slow as hell) the appropriate methods should be implemented. This allows for a gradual transition to less expensive model (such as implementing an X11Canvas supporting the drawing primitives of X) and is therefore the preferred solution.

In the eventual case that it's known that BitBlt/FXBlt will *never* be used in conjunction with a particular drawing surface, the support code should return a handle that is a) not a SmallInteger (these are used by the surface plugin) and b) not of the 'bitsSize' of a Form. One possible representation for such a handle would be a ByteArray of a non-integral word size (e.g., a ByteArray of size 5,6, or 7). In this case, all attempts to use FXBlt with the drawing surface will simply fail.
!

----- Method: ExternalScreen>>allocateForm: (in category 'form support') -----
allocateForm: extentPoint
	"Allocate a new form which is similar to the receiver and can be used for accelerated blts"
	| formHandle displayForm |
	formHandle := self primAllocateForm: self depth width: extentPoint x height: extentPoint y.
	formHandle = nil ifTrue:[^super allocateForm: extentPoint].
	displayForm := (ExternalForm extent: extentPoint depth: self depth bits: nil) 
		setExternalHandle: formHandle on: self.
	allocatedForms at: displayForm put: displayForm executor.
	^displayForm!

----- Method: ExternalScreen>>colormapFromARGB (in category 'accessing') -----
colormapFromARGB
	"Return a ColorMap mapping from canonical ARGB pixel values into the receiver"
	^argbMap ifNil:[argbMap := ColorMap mappingFromARGB: self rgbaBitMasks].!

----- Method: ExternalScreen>>copyBits:from:at:clippingBox:rule:fillColor:map: (in category 'blitting support') -----
copyBits: sourceRect from: sourceForm at: destOrigin clippingBox: clipRect rule: rule fillColor: hf map: map
	"Attempt to accelerate blts to the receiver"
	| r |
	((self isBltAccelerated: rule for: sourceForm) and:[map == nil and:[hf == nil]]) ifTrue:[
		"Try an accelerated blt"
		r := (destOrigin extent: sourceRect extent) intersect: (clipRect intersect: clippingBox).
		r area <= 0 ifTrue:[^self].
		(self primBltFast: bits from: sourceForm getExternalHandle
			at: r origin from: sourceRect origin
			extent: r extent) ifNotNil:[^self].
	].
	^super copyBits: sourceRect from: sourceForm at: destOrigin clippingBox: clipRect rule: rule fillColor: hf map: map!

----- Method: ExternalScreen>>destroy (in category 'initialize-release') -----
destroy
	"Destroy the receiver"
	allocatedForms ifNotNil:[
		allocatedForms lock. "Make sure we don't get interrupted"
		allocatedForms forceFinalization. "Clean up all lost references"
		allocatedForms keys do:[:stillValid| stillValid shutDown].
		"All remaining references are simply destroyed"
		allocatedForms associationsDo:[:assoc| assoc key: nil].
		allocatedForms forceFinalization. "destroy all others"
		allocatedForms := nil.
	].
	bits ifNotNil:[self primDestroyDisplaySurface: bits].
	bits := nil.!

----- Method: ExternalScreen>>destroyForm: (in category 'form support') -----
destroyForm: anExternalForm
	"Destroy the given external form"
	self primDestroyForm: anExternalForm getExternalHandle.
	anExternalForm setExternalHandle: nil on: nil.
	allocatedForms removeKey: anExternalForm ifAbsent:[].!

----- Method: ExternalScreen>>displayOn:at:clippingBox:rule:fillColor: (in category 'blitting support') -----
displayOn: destForm at: destOrigin clippingBox: clipRect rule: rule fillColor: hf
	"Attempt to accelerate blts to aDisplayMedium"
	| sourceRect |
	((self isBltAccelerated: rule for: destForm) and:[hf = nil]) ifTrue:[
		"Try an accelerated blt"
		sourceRect := (clipRect translateBy: destOrigin negated) intersect: clippingBox.
		(self primBltFast: bits to: destForm getExternalHandle
			at: 0 at 0 from: sourceRect origin
			extent: sourceRect extent) ifNotNil:[^self]].
	destForm copyBits: self boundingBox
		from: self
		at: destOrigin + self offset
		clippingBox: clipRect
		rule: rule
		fillColor: hf
		map: (self colormapIfNeededFor: destForm).
!

----- Method: ExternalScreen>>fill:rule:fillColor: (in category 'blitting support') -----
fill: aRectangle rule: anInteger fillColor: aColor 
	"Replace a rectangular area of the receiver with the pattern described by aForm 
	according to the rule anInteger."
	| rect |
	(self isFillAccelerated: anInteger for: aColor) ifTrue:[
		rect := aRectangle intersect: clippingBox.
		(self primFill: bits
			color: (self pixelWordFor: aColor)
			x: rect left
			y: rect top
			w: rect width
			h: rect height) ifNotNil:[^self]].
	^super fill: aRectangle rule: anInteger fillColor: aColor!

----- Method: ExternalScreen>>finish (in category 'initialize-release') -----
finish
	"Flush the receiver"
	self primFinish: bits.
	"Now is the time to do some cleanup"
	allocatedForms unlock.
	allocatedForms finalizeValues.!

----- Method: ExternalScreen>>flush (in category 'initialize-release') -----
flush
	"Flush the receiver"
	self primFlush: bits.!

----- Method: ExternalScreen>>hasNonStandardPalette (in category 'testing') -----
hasNonStandardPalette
	"Quite possible."
	^true!

----- Method: ExternalScreen>>isBltAccelerated:for: (in category 'blitting support') -----
isBltAccelerated: ruleInteger for: aForm
	"Return true if the receiver can perform accelerated blt operations by itself.
	It is assumed that blts of forms allocated on the receiverusing Form>>over 
	may be accelerated.
	Although some hardware may allow source-key blts (that is, Form>>paint or similar)
	this is usually questionable and the additional effort for allocating and
	maintaining the OS form doesn't quite seem worth the effort."
	^aForm displayScreen == self and:[ruleInteger = Form over]!

----- Method: ExternalScreen>>isExternalForm (in category 'testing') -----
isExternalForm
	"Sorta. Kinda."
	^true!

----- Method: ExternalScreen>>isFillAccelerated:for: (in category 'blitting support') -----
isFillAccelerated: ruleInteger for: aColor
	"Return true if the receiver can perform accelerated fill operations by itself.
	It is assumed that the hardware can accelerate plain color fill operations."
	^ruleInteger = Form over and:[aColor isColor]!

----- Method: ExternalScreen>>primAllocateForm:width:height: (in category 'primitives-forms') -----
primAllocateForm: d width: w height: h
	"Primitive. Allocate a form with the given parameters"
	^nil!

----- Method: ExternalScreen>>primBltFast:from:at:from:extent: (in category 'primitives-display') -----
primBltFast: displayHandle from: sourceHandle at: destOrigin from: sourceOrigin extent: extent
	"Primitive. Perform a fast blt operation. Return the receiver if successful."
	^nil!

----- Method: ExternalScreen>>primBltFast:to:at:from:extent: (in category 'primitives-display') -----
primBltFast: displayHandle to: dstHandle at: destOrigin from: sourceOrigin extent: extent
	"Primitive. Perform a fast blt operation. Return the receiver if successful."
	^nil!

----- Method: ExternalScreen>>primCreateDisplaySurface:width:height: (in category 'primitives-display') -----
primCreateDisplaySurface: d width: w height: h
	"Primitive. Create a new external display surface. Return the handle used to identify the receiver. Fail if the surface cannot be created."
	^nil!

----- Method: ExternalScreen>>primDestroyDisplaySurface: (in category 'primitives-display') -----
primDestroyDisplaySurface: aHandle
	"Primitive. Destroy the display surface associated with the given handle."
	^nil!

----- Method: ExternalScreen>>primDestroyForm: (in category 'primitives-forms') -----
primDestroyForm: aHandle
	"Primitive. Destroy the form associated with the given handle."
	^nil!

----- Method: ExternalScreen>>primDisplay:colorMasksInto: (in category 'primitives-display') -----
primDisplay: aHandle colorMasksInto: anArray
	"Primitive. Store the bit masks for each color into the given array."
	^nil!

----- Method: ExternalScreen>>primFill:color:x:y:w:h: (in category 'primitives-display') -----
primFill: handle color: pixelWord x: x y: y w: w h: h
	"Primitive. Perform an accelerated fill operation on the receiver."
	^nil!

----- Method: ExternalScreen>>primFinish: (in category 'primitives-display') -----
primFinish: aHandle
	"Primitive. Finish all rendering operations on the receiver.
	Do not return before all rendering operations have taken effect."
	^nil!

----- Method: ExternalScreen>>primFlush: (in category 'primitives-display') -----
primFlush: aHandle
	"Primitive. If any rendering operations are pending, force them to be executed.
	Do not wait until they have taken effect."
	^nil!

----- Method: ExternalScreen>>primForm:colorMasksInto: (in category 'primitives-forms') -----
primForm: aHandle colorMasksInto: anArray
	"Primitive. Store the bit masks for each color into the given array."
	^nil!

----- Method: ExternalScreen>>release (in category 'initialize-release') -----
release
	"I am no longer Display. Release any resources if necessary"
	self destroy!

----- Method: ExternalScreen>>rgbaBitMasks (in category 'accessing') -----
rgbaBitMasks
	"Return the masks for specifying the R,G,B, and A components in the receiver"
	| rgbaBitMasks |
	rgbaBitMasks := Array new: 4.
	self primDisplay: bits colorMasksInto: rgbaBitMasks.
	^rgbaBitMasks!

----- Method: ExternalScreen>>rgbaBitMasksOfForm: (in category 'form support') -----
rgbaBitMasksOfForm: anExternalForm
	| rgbaBitMasks |
	rgbaBitMasks := Array new: 4.
	self primForm: anExternalForm getExternalHandle colorMasksInto: rgbaBitMasks.
	^rgbaBitMasks!

----- Method: ExternalScreen>>setExtent:depth: (in category 'private') -----
setExtent: aPoint depth: bitsPerPixel
	"Create a 3D accelerated display screen"
	| screen |
	(bits isInteger and:[depth == bitsPerPixel and: [aPoint = self extent and: 
					[self supportsDisplayDepth: bitsPerPixel]]]) ifFalse: [
		bits ifNotNil:[self primDestroyDisplaySurface: bits].
		bits := nil.  "Free up old bitmap in case space is low"
		DisplayChangeSignature := (DisplayChangeSignature ifNil: [0]) + 1.
		(self supportsDisplayDepth: bitsPerPixel)
			ifTrue:[depth := bitsPerPixel]
			ifFalse:["Search for a suitable depth"
					depth := self findAnyDisplayDepthIfNone:[nil]].
		depth == nil ifFalse:[
			bits := self primCreateDisplaySurface: depth 
					width: aPoint x height: aPoint y].
		"Bail out if surface could not be created"
		(bits == nil) ifTrue:[
			screen := DisplayScreen extent: aPoint depth: bitsPerPixel.
			self == Display ifTrue:[
				Display := screen.
				Display beDisplay].
			^screen].
		width := aPoint x.
		height := aPoint y.
	].
	clippingBox := super boundingBox.
	allocatedForms ifNil:[
		allocatedForms := ExternalFormRegistry new.
		WeakArray addWeakDependent: allocatedForms].
!

----- Method: ExternalScreen>>shutDown (in category 'initialize-release') -----
shutDown 
	"Minimize Display memory saved in image"
	self destroy.
	width := 240.
	height := 120.
	bits := Bitmap new: self bitsSize.!

----- Method: ExternalScreen>>supportsDisplayDepth: (in category 'primitives-display') -----
supportsDisplayDepth: pixelDepth
	"Return true if this pixel depth is supported on the current host platform."
	^false!

TestCase subclass: #EtoysExternalFormTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'GraphicsExternal-Tests'!

----- Method: EtoysExternalFormTest>>testBlitToAndFromExternalForm (in category 'as yet unclassified') -----
testBlitToAndFromExternalForm
	"Ensure that we can blit to/from all 4 permutatations of Form and ExternalForm."
	| source external1 external2 destination |
	source := Cursor wait asCursorForm asFormOfDepth: 32.
	destination := Form extent: source extent depth: 32.
	external1 := ExternalForm extent: source extent depth: 32.
	external2 := ExternalForm extent: source extent depth: 32.
	self shouldnt: [source bits = destination bits].
	source displayOn: external1.
	external1 displayOn: external2.
	external2 displayOn: destination.
	self should: [source bits = destination bits].!

Form subclass: #ExternalForm
	instanceVariableNames: 'display argbMap'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'GraphicsExternal'!

!ExternalForm commentStamp: '<historical>' prior: 0!
An ExternalForm is just like any other form. It's only difference is that it is allocated on a specific display and can be used for accelerated blts on the particular display.

Upon shutdown of the system ExternalForms will be deallocated from the display and be kept in their internalized form.!

----- Method: ExternalForm>>colormapFromARGB (in category 'accessing') -----
colormapFromARGB
	"Return a ColorMap mapping from canonical ARGB pixel values into the receiver"
	^argbMap ifNil:[argbMap := ColorMap mappingFromARGB: self rgbaBitMasks].!

----- Method: ExternalForm>>colormapFromARGB: (in category 'accessing') -----
colormapFromARGB: aMap
	"Set the ColorMap mapping from canonical ARGB pixel values into the receiver"
	argbMap := aMap!

----- Method: ExternalForm>>destroy (in category 'initialize-release') -----
destroy
	"Destroy the receiver"
	display ifNotNil:[display destroyForm: self]!

----- Method: ExternalForm>>displayScreen (in category 'accessing') -----
displayScreen
	"Return the display screen the receiver is allocated on."
	^display!

----- Method: ExternalForm>>getExternalHandle (in category 'private') -----
getExternalHandle
	"Private. Return the virtual handle used to represent the receiver"
	^bits!

----- Method: ExternalForm>>hasNonStandardPalette (in category 'testing') -----
hasNonStandardPalette
	"Quite possible."
	^display notNil or:[argbMap notNil]!

----- Method: ExternalForm>>isExternalForm (in category 'testing') -----
isExternalForm
	"I am an external form but only as long as I'm allocated on a display"
	^display notNil!

----- Method: ExternalForm>>rgbaBitMasks (in category 'accessing') -----
rgbaBitMasks
	"Return the masks for specifying the R,G,B, and A components in the receiver"
	display 
		ifNil:[^super rgbaBitMasks]
		ifNotNil:[^display rgbaBitMasksOfForm: self]!

----- Method: ExternalForm>>setExternalHandle:on: (in category 'private') -----
setExternalHandle: aHandle on: aDisplay
	"Initialize the receiver from the given external handle"
	display := aDisplay.
	bits := aHandle.!

----- Method: ExternalForm>>shutDown (in category 'initialize-release') -----
shutDown
	"System is going down. Internalize my bits and be finished."
	| copy |
	copy := Form extent: self extent depth: self depth.
	self displayOn: copy.
	copy hibernate. "compact bits of copy"
	self destroy. "Release my external handle"
	bits := copy bits. "Now compressed"
	display := nil. "No longer allocated"
	argbMap := nil. "No longer external"!

WeakKeyDictionary subclass: #ExternalFormRegistry
	instanceVariableNames: 'lockFlag'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'GraphicsExternal'!

!ExternalFormRegistry commentStamp: '<historical>' prior: 0!
The ExternalFormRegistry needs to be synchronized with rendering to prevent forms from being destroyed during rendering. Only at certain points (that is after a rendering cycle is completed) the texture registry may be cleaned up.!

----- Method: ExternalFormRegistry>>finalizeValues (in category 'finalization') -----
finalizeValues
	"This message is sent when an element has gone away."
	lockFlag == true ifTrue:[^self].
	self forceFinalization.!

----- Method: ExternalFormRegistry>>forceFinalization (in category 'finalization') -----
forceFinalization
	self associationsDo:[:assoc|
		assoc key isNil ifTrue:[assoc value destroy].
	].
	super finalizeValues.!

----- Method: ExternalFormRegistry>>lock (in category 'accessing') -----
lock
	lockFlag := true!

----- Method: ExternalFormRegistry>>unlock (in category 'accessing') -----
unlock
	lockFlag := false.!