Form subclass: #ExampleSurface
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SurfacePlugin-Examples'!
!ExampleSurface commentStamp: '<historical>' prior: 0!
An example surface for the example surface plugin.!


!ExampleSurface methodsFor: 'initialize' stamp: 'ar 4/26/2006 13:55'!
destroy
	"Free my bits"
	self primitiveDestroySurface: bits.
! !


!ExampleSurface methodsFor: 'private' stamp: 'ar 4/26/2006 13:54'!
fromHandle: h
	"Create me from the given handle"
	width := self primitiveGetSurfaceWidth: h.
	height := self primitiveGetSurfaceHeight: h.
	depth := self primitiveGetSurfaceDepth: h.
	bits := h.! !

!ExampleSurface methodsFor: 'private' stamp: 'ar 4/26/2006 13:53'!
primitiveCreateSurfaceWidth: width height: height depth: bitsPerPixel
	<primitive: 'primitiveCreateSurface' module: 'ExampleSurfacePlugin'>
	^self primitiveFailed! !

!ExampleSurface methodsFor: 'private' stamp: 'ar 4/26/2006 13:55'!
primitiveDestroySurface: h
	<primitive: 'primitiveDestroySurface' module: 'ExampleSurfacePlugin'>
	^self primitiveFailed! !

!ExampleSurface methodsFor: 'private' stamp: 'ar 4/26/2006 13:54'!
primitiveGetSurfaceBits: h
	<primitive: 'primitiveGetSurfaceBits' module: 'ExampleSurfacePlugin'>
	^self primitiveFailed! !

!ExampleSurface methodsFor: 'private' stamp: 'ar 4/26/2006 13:54'!
primitiveGetSurfaceDepth: h
	<primitive: 'primitiveGetSurfaceDepth' module: 'ExampleSurfacePlugin'>
	^self primitiveFailed! !

!ExampleSurface methodsFor: 'private' stamp: 'ar 4/26/2006 13:54'!
primitiveGetSurfaceHeight: h
	<primitive: 'primitiveGetSurfaceHeight' module: 'ExampleSurfacePlugin'>
	^self primitiveFailed! !

!ExampleSurface methodsFor: 'private' stamp: 'ar 4/26/2006 13:54'!
primitiveGetSurfaceWidth: h
	<primitive: 'primitiveGetSurfaceWidth' module: 'ExampleSurfacePlugin'>
	^self primitiveFailed! !

!ExampleSurface methodsFor: 'private' stamp: 'ar 4/26/2006 13:52'!
setExtent: extent depth: bitsPerPixel
	"Create a virtual bit map with the given extent and bitsPerPixel."
	width := extent x asInteger.
	width < 0 ifTrue: [width := 0].
	height := extent y asInteger.
	height < 0 ifTrue: [height := 0].
	depth := bitsPerPixel.
	bits := self primitiveCreateSurfaceWidth: width height: height depth: bitsPerPixel.! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ExampleSurface class
	instanceVariableNames: ''!

!ExampleSurface class methodsFor: 'examples' stamp: 'ar 4/26/2006 14:00'!
example			"ExampleSurface example"
	"Create a new example surface; then one from its handle; then copy between them etc"
	| formA formB |
	formA := self extent: 100@100 depth: (Display depth max: 8).
	"Copy from display to external form"
	Display displayOn: formA at: 0@0.
	"Copy from external form to display"
	formA displayOn: Display at: 0@0.
	"Create a form from a handle - this is literally the same form!!"
	formB := self new fromHandle: formA bits.
	"Display right next to formA"
	formB displayOn: Display at: formA width@0.
	"Do an overlapping blt between formA and formB"
	formA displayOn: formB at: formA extent // 2.
	"Show the result"
	formA displayOn: Display at: 0@0.
	formB displayOn: Display at: formA width@0.
! !


InterpreterPlugin subclass: #ExampleSurfacePlugin
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SurfacePlugin-Examples'!
!ExampleSurfacePlugin commentStamp: '<historical>' prior: 0!
This is an example for using the surface plugin.!


!ExampleSurfacePlugin methodsFor: 'initialize' stamp: 'ar 4/26/2006 13:46'!
initialiseModule
	self export: true.
	^self memInitialize! !


!ExampleSurfacePlugin methodsFor: 'primitives' stamp: 'ar 4/26/2006 13:50'!
primitiveCreateSurface
	"Primitive. Create a surface of the given width/height/depth. Answer the handle."
	| depth height width id |
	self export: true.
	interpreterProxy methodArgumentCount = 3 
		ifFalse:[^interpreterProxy primitiveFail].
	depth := interpreterProxy stackIntegerValue: 0.
	height := interpreterProxy stackIntegerValue: 1.
	width := interpreterProxy stackIntegerValue: 2.
	interpreterProxy failed ifTrue:[^nil]. "invalid arguments"
	"make sure depth is power of two"
	(depth bitAnd: depth-1) = 0 
		ifFalse:[^interpreterProxy primitiveFail].
	"Create bitmap surface"
	id := self memCreateSurfaceWidth: width Height: height Depth: depth.
	id < 0 ifTrue:[^interpreterProxy primitiveFail].
	interpreterProxy pop: interpreterProxy methodArgumentCount+1. "args+rcvr"
	interpreterProxy pushInteger: id.! !

!ExampleSurfacePlugin methodsFor: 'primitives' stamp: 'ar 4/26/2006 13:49'!
primitiveDestroySurface
	"Primitive. Destroy a surface."
	| id ok |
	self export: true.
	interpreterProxy methodArgumentCount = 1
		ifFalse:[^interpreterProxy primitiveFail].
	id := interpreterProxy stackIntegerValue: 0.
	interpreterProxy failed ifTrue:[^nil]. "invalid arguments"
	ok := self memDestroySurface: id.
	interpreterProxy pop: interpreterProxy methodArgumentCount+1. "args + rcvr"
	interpreterProxy pushBool: ok.! !

!ExampleSurfacePlugin methodsFor: 'primitives' stamp: 'ar 4/26/2006 13:49'!
primitiveGetSurfaceBits
	"Primitive. Return the witdth of a surface."
	| id result |
	self export: true.
	interpreterProxy methodArgumentCount = 1
		ifFalse:[^interpreterProxy primitiveFail].
	id := interpreterProxy stackIntegerValue: 0.
	interpreterProxy failed ifTrue:[^nil]. "invalid arguments"
	result := self memGetSurfaceBits: id.
	interpreterProxy pop: interpreterProxy methodArgumentCount+1. "args+rcvr"
	interpreterProxy push: (interpreterProxy positive32BitIntegerFor: result).! !

!ExampleSurfacePlugin methodsFor: 'primitives' stamp: 'ar 4/26/2006 13:50'!
primitiveGetSurfaceDepth
	"Primitive. Return the height of a surface."
	| id result |
	self export: true.
	interpreterProxy methodArgumentCount = 1
		ifFalse:[^interpreterProxy primitiveFail].
	id := interpreterProxy stackIntegerValue: 0.
	interpreterProxy failed ifTrue:[^nil]. "invalid arguments"
	result := self memGetSurfaceDepth: id.
	interpreterProxy pop: interpreterProxy methodArgumentCount+1. "args+rcvr"
	interpreterProxy pushInteger: result.! !

!ExampleSurfacePlugin methodsFor: 'primitives' stamp: 'ar 4/26/2006 13:50'!
primitiveGetSurfaceHeight
	"Primitive. Return the height of a surface."
	| id result |
	self export: true.
	interpreterProxy methodArgumentCount = 1
		ifFalse:[^interpreterProxy primitiveFail].
	id := interpreterProxy stackIntegerValue: 0.
	interpreterProxy failed ifTrue:[^nil]. "invalid arguments"
	result := self memGetSurfaceHeight: id.
	interpreterProxy pop: interpreterProxy methodArgumentCount+1. "args+rcvr"
	interpreterProxy pushInteger: result.! !

!ExampleSurfacePlugin methodsFor: 'primitives' stamp: 'ar 4/26/2006 13:50'!
primitiveGetSurfaceWidth
	"Primitive. Return the witdth of a surface."
	| id result |
	self export: true.
	interpreterProxy methodArgumentCount = 1
		ifFalse:[^interpreterProxy primitiveFail].
	id := interpreterProxy stackIntegerValue: 0.
	interpreterProxy failed ifTrue:[^nil]. "invalid arguments"
	result := self memGetSurfaceWidth: id.
	interpreterProxy pop: interpreterProxy methodArgumentCount+1. "args+rcvr"
	interpreterProxy pushInteger: result.! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ExampleSurfacePlugin class
	instanceVariableNames: ''!

!ExampleSurfacePlugin class methodsFor: 'accessing' stamp: 'ar 4/26/2006 12:35'!
hasHeaderFile
	"If there is a single intrinsic header file to be associated with the plugin, here is where you want to flag"
	^true! !

!ExampleSurfacePlugin class methodsFor: 'accessing' stamp: 'ar 4/26/2006 12:35'!
requiresCrossPlatformFiles
	"default is ok for most, any plugin needing platform specific files must say so"
	^true! !