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
|
Const
{$WARNING this belongs to the ipc unit}
IPC_PRIVATE = 0;
Constructor TX11Image.Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat);
Begin
FWidth := AWidth;
FHeight := AHeight;
FDisplay := ADisplay;
End;
Constructor TX11NormalImage.Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat);
Var
xpad, xpitch : Integer;
tmp_FPixels : PChar;
Begin
Inherited;
xpad := AFormat.Bits;
If AFormat.Bits = 24 Then
xpad := 32;
xpitch := AWidth * AFormat.Bits Div 8;
Inc(xpitch, 3);
xpitch := xpitch And (Not 3);
FPixels := GetMem(xpitch * AHeight);
Pointer(tmp_FPixels) := Pointer(FPixels);
FImage := XCreateImage(ADisplay, DefaultVisual(ADisplay, AScreen),
DefaultDepth(ADisplay, AScreen),
ZPixmap, 0, tmp_FPixels,
AWidth, AHeight, xpad, 0);
If FImage = Nil Then
Raise TPTCError.Create('cannot create XImage');
End;
Destructor TX11NormalImage.Destroy;
Begin
If FImage <> Nil Then
Begin
{ Restore XImage's buffer pointer }
FImage^.data := Nil;
XDestroyImage(FImage);
End;
If FPixels <> Nil Then
FreeMem(FPixels);
Inherited Destroy;
End;
Procedure TX11NormalImage.Put(AWindow : TWindow; AGC : TGC; AX, AY : Integer);
Begin
XPutImage(FDisplay, AWindow, AGC, FImage, 0, 0, AX, AY, FWidth, FHeight);
XSync(FDisplay, False);
End;
Procedure TX11NormalImage.Put(AWindow : TWindow; AGC : TGC; ASX, ASY, ADX, ADY,
AWidth, AHeight : Integer);
Begin
XPutImage(FDisplay, AWindow, AGC, FImage, ASX, ASY, ADX, ADY, AWidth, AHeight);
XSync(FDisplay, False);
End;
Function TX11NormalImage.Lock : Pointer;
Begin
Result := FPixels;
End;
Function TX11NormalImage.Pitch : Integer;
Begin
Result := FImage^.bytes_per_line;
End;
Function TX11NormalImage.Name : String;
Begin
Result := 'XImage';
End;
{$IFDEF ENABLE_X11_EXTENSION_XSHM}
Var
Fshm_error : Boolean;
Fshm_oldhandler : Function(disp : PDisplay; xev : PXErrorEvent) : Integer; CDecl;
Function Fshm_errorhandler(disp : PDisplay; xev : PXErrorEvent) : Integer; CDecl;
Begin
If xev^.error_code=BadAccess Then
Begin
Fshm_error := True;
Result := 0;
End
Else
Result := Fshm_oldhandler(disp, xev);
End;
Constructor TX11ShmImage.Create(ADisplay : PDisplay; AScreen, AWidth, AHeight : Integer; AFormat : TPTCFormat);
Begin
Inherited;
FShmInfo.shmid := -1;
FShmInfo.shmaddr := Pointer(-1);
FImage := XShmCreateImage(ADisplay, DefaultVisual(ADisplay, AScreen),
DefaultDepth(ADisplay, AScreen),
ZPixmap, Nil, @FShmInfo, AWidth, AHeight);
If FImage = Nil Then
Raise TPTCError.Create('cannot create SHM image');
FShmInfo.shmid := shmget(IPC_PRIVATE, FImage^.bytes_per_line * FImage^.height,
IPC_CREAT Or &777);
If FShmInfo.shmid = -1 Then
Raise TPTCError.Create('cannot get shared memory segment');
FShmInfo.shmaddr := shmat(FShmInfo.shmid, Nil, 0);
FShmInfo.readOnly := False;
FImage^.data := FShmInfo.shmaddr;
If Pointer(FShmInfo.shmaddr) = Pointer(-1) Then
Raise TPTCError.Create('cannot allocate shared memory');
// Try and attach the segment to the server. Bugfix: Have to catch
// bad access errors in case it runs over the net.
Fshm_error := False;
Fshm_oldhandler := XSetErrorHandler(@Fshm_errorhandler);
Try
If XShmAttach(ADisplay, @FShmInfo) = 0 Then
Raise TPTCError.Create('cannot attach shared memory segment to display');
XSync(ADisplay, False);
If Fshm_error Then
Raise TPTCError.Create('cannot attach shared memory segment to display');
FShmAttached := True;
Finally
XSetErrorHandler(Fshm_oldhandler);
End;
End;
Destructor TX11ShmImage.Destroy;
Begin
If FShmAttached Then
Begin
XShmDetach(FDisplay, @FShmInfo);
XSync(FDisplay, False);
End;
If FImage <> Nil Then
XDestroyImage(FImage);
If Pointer(FShmInfo.shmaddr) <> Pointer(-1) Then
shmdt(FShmInfo.shmaddr);
If FShmInfo.shmid <> -1 Then
shmctl(FShmInfo.shmid, IPC_RMID, Nil);
Inherited Destroy;
End;
Procedure TX11ShmImage.Put(AWindow : TWindow; AGC : TGC; AX, AY : Integer);
Begin
XShmPutImage(FDisplay, AWindow, AGC, FImage, 0, 0, AX, AY, FWidth, FHeight, False);
XSync(FDisplay, False);
End;
Procedure TX11ShmImage.Put(AWindow : TWindow; AGC : TGC; ASX, ASY, ADX, ADY,
AWidth, AHeight : Integer);
Begin
XShmPutImage(FDisplay, AWindow, AGC, FImage, ASX, ASY, ADX, ADY, FWidth, FHeight, False);
XSync(FDisplay, False);
End;
Function TX11ShmImage.Lock : Pointer;
Begin
Result := Pointer(FShmInfo.shmaddr);
End;
Function TX11ShmImage.Pitch : Integer;
Begin
Result := FImage^.bytes_per_line;
End;
Function TX11ShmImage.Name : String;
Begin
Result := 'MIT-Shm';
End;
{$ENDIF ENABLE_X11_EXTENSION_XSHM}
|
