1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
|
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! !
|
