-
Notifications
You must be signed in to change notification settings - Fork 16
/
Copy pathDisplay.luon
110 lines (97 loc) · 3.22 KB
/
Display.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
(*
* Copyright 2024 Rochus Keller <mailto:me@rochus-keller.ch>
*
* 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 me@rochus-keller.ch.
*
* 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 Display
type
Bitmap* = record
pixWidth, pixHeight: integer
buffer: array of byte
end
Context = record
sourceBits*: Bitmap
destBits*: Bitmap
halftoneBits*: Bitmap
combinationRule*: integer
destX*, clipX*, clipWidth*, sourceX*, width*: integer
destY*, clipY*, clipHeight*, sourceY*, height*: integer
end
var run* : boolean
procedure processEvents*(): integer extern // number of pending events or -1 for finish
procedure nextEvent(): integer extern
procedure setCursorPos*(x,y: integer) extern
procedure setCursorBitmap*(bm: Bitmap) extern
procedure setScreenBitmap*(bm: Bitmap) extern
procedure getScreenBitmap*(): Bitmap extern
procedure updateArea*(x,y,w,h: integer; cx, cy, cw, ch: integer ) extern
procedure getTicks(): integer extern
procedure close() extern
procedure copyBits*(c: Context) extern
procedure createBitmap*(bs: array of byte; pixWidth, pixHeight: integer): Bitmap
var bm: Bitmap; l: integer
begin
new(bm)
bm.buffer := bs
l := len(bs)
assert( l >= pixWidth * pixHeight div 8 )
bm.pixWidth := pixWidth
bm.pixHeight := pixHeight
return bm
end createBitmap
procedure wordAt*(bm: Bitmap; i: integer): integer
begin
dec(i) // Smalltalk array indexes start with 1
i := i * 2 // i comes as number of words
assert(i+1 < len(bm.buffer))
return bitshl(bm.buffer[i], 8 ) + bm.buffer[i+1]
end wordAt
procedure wordAtPut*(bm: Bitmap; i, v: integer)
begin
dec(i)
i := i * 2
assert(i+1 < len(bm.buffer))
bm.buffer[i] := clip(bitand( bitshr( v, 8 ), 0ffh ))
bm.buffer[i+1] := clip(bitand( v, 0ffh ))
end wordAtPut
const
DeltaTime = 0
XLocation = 1
YLocation = 2
BiStateOn = 3
BiStateOff = 4
AbsoluteTime = 5 // followed by two words
procedure getEventType(e: integer): integer inline
begin
return bitshr(e,12)
end getEventType
procedure getEventName(t: integer): string inline
begin
case t of
| DeltaTime: return "DeltaTime"
| XLocation: return "XLocation"
| YLocation: return "YLocation"
| BiStateOn: return "BiStateOn"
| BiStateOff: return "BiStateOff"
| AbsoluteTime: return "AbsoluteTime"
end
end getEventName
procedure getEventValue(e: integer): integer inline
begin
return bitand(e, 1111_1111_1111b)
end getEventValue
end Display