-
Notifications
You must be signed in to change notification settings - Fork 16
/
Copy pathBitBlt.luon
272 lines (252 loc) · 8.3 KB
/
BitBlt.luon
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
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
(*
* Copyright 2024 Rochus Keller <mailto:[email protected]>
*
* This file is part of the Luon Smalltalk-80 VM.
*
* The following is the license that applies to this copy of the
* application. For a license to use the application under conditions
* other than those described here, please email to [email protected].
*
* GNU General Public License Usage
* This file may be used under the terms of the GNU General Public
* License (GPL) versions 2.0 or 3.0 as published by the Free Software
* Foundation and appearing in the file LICENSE.GPL included in
* the packaging of this file. Please review the following information
* to ensure GNU General Public Licensing requirements will be met:
* http://www.fsf.org/licensing/licenses/info/GPLv2.html and
* http://www.gnu.org/copyleft/gpl.html.
*)
// migrated from the C++ version
module BitBlt
import D := Display
// This is a textbook implementation according to Blue Book chapter 18 "Simulation of BitBlt".
// Known to be inefficient; focus is on functionality and compliance.
type
Context* = D.Context
var
ctx: Context
sourceRaster: integer
destRaster: integer
skew, nWords, vDir, hDir: integer
mask1, mask2, skewMask: integer
sx, sy, dx, dy, w, h: integer // pixel
sourceIndex, destIndex, sourceDelta, destDelta: integer
preload: boolean
RightMasks: array of integer
const
AllOnes = 0ffffh
procedure copyBits*(c: Context)
begin
ctx := c
clipRange()
if (w <= 0) or (h <= 0) then return end
computeMasks()
checkOverlap()
calculateOffsets()
copyLoop()
end copyBits
procedure clipRange()
begin
// set sx/y, dx/y, w and h so that dest doesn't exceed clipping range and
// source only covers what needed by clipped dest
if ctx.destX >= ctx.clipX then
sx := ctx.sourceX
dx := ctx.destX
w := ctx.width
else
sx := ctx.sourceX + ( ctx.clipX - ctx.destX )
w := ctx.width - ( ctx.clipX - ctx.destX )
dx := ctx.clipX
end
if ( dx + w ) > ( ctx.clipX + ctx.clipWidth ) then
w := w - ( ( dx + w ) - ( ctx.clipX + ctx.clipWidth ) )
end
if ctx.destY >= ctx.clipY then
sy := ctx.sourceY
dy := ctx.destY
h := ctx.height
else
sy := ctx.sourceY + ctx.clipY - ctx.destY
h := ctx.height - ctx.clipY + ctx.destY
dy := ctx.clipY
end
if ( dy + h ) > ( ctx.clipY + ctx.clipHeight ) then
h := h - ( ( dy + h ) - ( ctx.clipY + ctx.clipHeight ) )
end
if ctx.sourceBits = nil then return end
if sx < 0 then
dx := dx - sx;
w := w + sx;
sx := 0;
end
if ( sx + w ) > ctx.sourceBits.pixWidth then
w := w - ( sx + w - ctx.sourceBits.pixWidth )
end
if sy < 0 then
dy := dy - sy
h := h + sy
sy := 0
end
if ( sy + h ) > ctx.sourceBits.pixHeight then
h := h - ( sy + h - ctx.sourceBits.pixHeight )
end
end clipRange
procedure not16(x: integer): integer inline
begin
return bitand(bitnot(x), 0ffffh)
end not16
procedure computeMasks()
var startBits, endBits: integer
begin
// destBits = destForm bits
destRaster := ( ( ctx.destBits.pixWidth - 1 ) div 16 ) + 1
if ctx.sourceBits # nil then
sourceRaster := ( ( ctx.sourceBits.pixWidth - 1 ) div 16 ) + 1
else
sourceRaster := 0
end
// halftoneBits = halftoneForm bits
skew := bitand(( sx - dx ), 15)
startBits := 16 - bitand( dx, 15 )
mask1 := RightMasks[ startBits (* + 1 *) ] // ST array index starts with 1
endBits := 15 - bitand( ( dx + w - 1 ), 15 )
mask2 := not16(RightMasks[ endBits (* + 1 *) ])
if skew = 0 then skewMask := 0 else skewMask := RightMasks[ 16 - skew (* + 1 *) ] end
if w < startBits then
mask1 := bitand(mask1, mask2)
mask2 := 0
nWords := 1
else
// nWords = ( w - startBits - 1 ) / 16 + 2; // BB error, doesn't work
// fix found in https://github.com/dbanay/Smalltalk/blob/master/src/bitblt.cpp
// ERROR dbanay : nWords <- (w - startBits + 15) // 16 + 1 for False case"
nWords := ( w - startBits + 15) div 16 + 1
end
end computeMasks
procedure checkOverlap()
var t: integer
begin
hDir := 1; vDir := 1
if (ctx.sourceBits # nil) and (ctx.destBits # nil) and
(ctx.sourceBits.buffer = ctx.destBits) and (dy >= sy) then
if dy > sy then
vDir := -1
sy := sy + h - 1
dy := dy + h - 1
elsif dx > sx then
hDir := -1
sx := sx + w - 1
dx := dx + w - 1
skewMask := not16(skewMask)
t := mask1
mask1 := mask2
mask2 := t
end
end
end checkOverlap
procedure calculateOffsets()
begin
preload := (ctx.sourceBits # nil) and (skew # 0) and (skew <= bitand( sx, 15 ) )
if hDir < 0 then preload := preload = false end
sourceIndex := sy * sourceRaster + ( sx div 16 )
destIndex := dy * destRaster + ( dx div 16 )
sourceDelta := ( sourceRaster * vDir ) - ( (nWords + ord(preload) ) * hDir )
destDelta := ( destRaster * vDir ) - ( nWords * hDir )
end calculateOffsets
procedure copyLoop()
var prevWord, thisWord, skewWord, mergeMask,
halftoneWord, mergeWord, word, i, destWord: integer
begin
for i := 1 to h do
if ctx.halftoneBits # nil then
halftoneWord := D.wordAt(ctx.halftoneBits, 1 + bitand( dy, 15 ) )
dy := dy + vDir
else
halftoneWord := AllOnes
end
skewWord := halftoneWord
if preload and (ctx.sourceBits # nil) then
prevWord := D.wordAt(ctx.sourceBits, sourceIndex + 1 )
sourceIndex := sourceIndex + hDir
else
prevWord := 0
end
mergeMask := mask1
for word := 1 to nWords do
if ctx.sourceBits # nil then
prevWord := bitand(prevWord, skewMask)
if (word <= sourceRaster) and (sourceIndex >= 0)
and (sourceIndex < len(ctx.sourceBits.buffer) div 2 ) then
thisWord := D.wordAt(ctx.sourceBits, sourceIndex + 1 )
else
thisWord := 0
end
skewWord := bitor( prevWord, bitand( thisWord, bitnot(skewMask) ) )
prevWord := thisWord
skewWord := bitor( bitshl( skewWord, skew ),
bitshr( skewWord, -( skew - 16 ) ) )
end
if destIndex >= len(ctx.destBits.buffer) div 2 then return end
destWord := D.wordAt(ctx.destBits, destIndex + 1 )
mergeWord := merge( ctx.combinationRule, bitand(skewWord, halftoneWord), destWord )
D.wordAtPut(ctx.destBits, destIndex + 1,
bitor( bitand(mergeMask, mergeWord), bitand( bitnot(mergeMask), destWord ) ) )
sourceIndex := sourceIndex + hDir
destIndex := destIndex + hDir
if word = ( nWords - 1 ) then
mergeMask := mask2
else
mergeMask := AllOnes
end
end
sourceIndex := sourceIndex + sourceDelta
destIndex := destIndex + destDelta
end
end copyLoop
procedure merge(combinationRule, source, destination: integer): integer
begin
case combinationRule of
| 0:
return 0
| 1:
return bitand(source, destination)
| 2:
return bitand(source, not16(destination))
| 3:
return source
| 4:
return bitand( not16(source), destination)
| 5:
return destination
| 6:
return bitxor(source, destination)
| 7:
return bitor(source, destination)
| 8:
return bitand( not16(source), not16(destination) )
| 9:
return bitxor( not16(source), destination )
| 10:
return not16(destination)
| 11:
return bitor(source, not16(destination))
| 12:
return not16(source)
| 13:
return bitor( not16(source), destination)
| 14:
return bitor( not16(source), not16(destination) )
| 15:
return AllOnes;
else
assert( false )
end
return 0
end merge
begin
RightMasks := {
0, 01h, 03h, 07h, 0fh,
01fh, 03fh, 07fh, 0ffh,
01ffh, 03ffh, 0h7ffh, 0fffh,
01fffh, 03fffh, 07fffh, 0ffffh }
end BitBlt