1{
2    Free Pascal port of the OpenPTC C++ library.
3    Copyright (C) 2001-2003, 2006, 2007, 2009-2011  Nikolay Nikolov (nickysn@users.sourceforge.net)
4    Original C++ version by Glenn Fiedler (ptc@gaffer.org)
5
6    This library is free software; you can redistribute it and/or
7    modify it under the terms of the GNU Lesser General Public
8    License as published by the Free Software Foundation; either
9    version 2.1 of the License, or (at your option) any later version
10    with the following modification:
11
12    As a special exception, the copyright holders of this library give you
13    permission to link this library with independent modules to produce an
14    executable, regardless of the license terms of these independent modules,and
15    to copy and distribute the resulting executable under terms of your choice,
16    provided that you also meet, for each linked independent module, the terms
17    and conditions of the license of that module. An independent module is a
18    module which is not derived from or based on this library. If you modify
19    this library, you may extend this exception to your version of the library,
20    but you are not obligated to do so. If you do not wish to do so, delete this
21    exception statement from your version.
22
23    This library is distributed in the hope that it will be useful,
24    but WITHOUT ANY WARRANTY; without even the implied warranty of
25    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
26    Lesser General Public License for more details.
27
28    You should have received a copy of the GNU Lesser General Public
29    License along with this library; if not, write to the Free Software
30    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
31}
32
33type
34  TPTCSurface = class(TInterfacedObject, IPTCSurface)
35  private
36    {data}
37    FWidth: Integer;
38    FHeight: Integer;
39    FPitch: Integer;
40    FArea: IPTCArea;
41    FClip: IPTCArea;
42    FFormat: IPTCFormat;
43    FLocked: Boolean;
44    FPixels: Pointer;
45    {objects}
46    FCopy: TPTCCopy;
47    FClear: TPTCClear;
48    FPalette: IPTCPalette;
49  public
50    constructor Create(AWidth, AHeight: Integer; AFormat: IPTCFormat);
51    destructor Destroy; override;
52    procedure Copy(ASurface: IPTCSurface);
53    procedure Copy(ASurface: IPTCSurface;
54                   ASource, ADestination: IPTCArea);
55    function Lock: Pointer;
56    procedure Unlock;
57    procedure Load(const APixels: Pointer;
58                   AWidth, AHeight, APitch: Integer;
59                   AFormat: IPTCFormat;
60                   APalette: IPTCPalette);
61    procedure Load(const APixels: Pointer;
62                   AWidth, AHeight, APitch: Integer;
63                   AFormat: IPTCFormat;
64                   APalette: IPTCPalette;
65                   ASource, ADestination: IPTCArea);
66    procedure Save(APixels: Pointer;
67                   AWidth, AHeight, APitch: Integer;
68                   AFormat: IPTCFormat;
69                   APalette: IPTCPalette);
70    procedure Save(APixels: Pointer;
71                   AWidth, AHeight, APitch: Integer;
72                   AFormat: IPTCFormat;
73                   APalette: IPTCPalette;
74                   ASource, ADestination: IPTCArea);
75    procedure Clear;
76    procedure Clear(AColor: IPTCColor);
77    procedure Clear(AColor: IPTCColor; AArea: IPTCArea);
78    procedure Palette(APalette: IPTCPalette);
79    function Palette: IPTCPalette;
80    procedure Clip(AArea: IPTCArea);
81    function GetWidth: Integer;
82    function GetHeight: Integer;
83    function GetPitch: Integer;
84    function GetArea: IPTCArea;
85    function Clip: IPTCArea;
86    function GetFormat: IPTCFormat;
87    function Option(const AOption: string): Boolean;
88
89    property Width: Integer read GetWidth;
90    property Height: Integer read GetHeight;
91    property Pitch: Integer read GetPitch;
92    property Area: IPTCArea read GetArea;
93    property Format: IPTCFormat read GetFormat;
94  end;
95
96class function TPTCSurfaceFactory.CreateNew(AWidth, AHeight: Integer; AFormat: IPTCFormat): IPTCSurface;
97begin
98  Result := TPTCSurface.Create(AWidth, AHeight, AFormat);
99end;
100
101constructor TPTCSurface.Create(AWidth, AHeight: Integer; AFormat: IPTCFormat);
102var
103  size: Integer;
104begin
105  FLocked := False;
106  LOG('creating surface');
107  LOG('width', AWidth);
108  LOG('height', AHeight);
109  LOG('format', AFormat);
110  FWidth := AWidth;
111  FHeight := AHeight;
112  FFormat := AFormat;
113  FArea := TPTCArea.Create(0, 0, AWidth, AHeight);
114  FClip := TPTCArea.Create(FArea);
115  FPitch := AWidth * AFormat.Bytes;
116  size := AWidth * AHeight * AFormat.Bytes;
117  if size = 0 then
118    raise TPTCError.Create('zero surface size');
119  FPixels := GetMem(size);
120  FCopy := TPTCCopy.Create;
121  FClear := TPTCClear.Create;
122  FPalette := TPTCPalette.Create;
123  clear;
124end;
125
126destructor TPTCSurface.Destroy;
127begin
128  if FLocked then
129  begin
130    LOG('destroying surface that is still locked!!!');
131  end;
132  FCopy.Free;
133  FClear.Free;
134  FreeMem(FPixels);
135  inherited Destroy;
136end;
137
138procedure TPTCSurface.Copy(ASurface: IPTCSurface);
139begin
140  ASurface.Load(FPixels, FWidth, FHeight, FPitch, FFormat, FPalette);
141end;
142
143procedure TPTCSurface.Copy(ASurface: IPTCSurface;
144                           ASource, ADestination: IPTCArea);
145begin
146  ASurface.Load(FPixels, FWidth, FHeight, FPitch, FFormat, FPalette,
147                ASource, ADestination);
148end;
149
150function TPTCSurface.Lock: Pointer;
151begin
152  if FLocked then
153    raise TPTCError.Create('surface is already locked');
154  FLocked := True;
155  Result := FPixels;
156end;
157
158procedure TPTCSurface.Unlock;
159begin
160  if not FLocked then
161    raise TPTCError.Create('surface is not locked');
162  FLocked := False;
163end;
164
165procedure TPTCSurface.Load(const APixels: Pointer;
166                           AWidth, AHeight, APitch: Integer;
167                           AFormat: IPTCFormat;
168                           APalette: IPTCPalette);
169begin
170  if FClip.Equals(FArea) then
171  begin
172    FCopy.Request(AFormat, FFormat);
173    FCopy.Palette(APalette, FPalette);
174    FCopy.Copy(APixels, 0, 0, AWidth, AHeight, APitch, FPixels, 0, 0,
175               FWidth, FHeight, FPitch);
176  end
177  else
178    Load(APixels, AWidth, AHeight, APitch, AFormat, APalette,
179         TPTCArea.Create(0, 0, AWidth, AHeight), FArea);
180end;
181
182procedure TPTCSurface.Load(const APixels: Pointer;
183                           AWidth, AHeight, APitch: Integer;
184                           AFormat: IPTCFormat;
185                           APalette: IPTCPalette;
186                           ASource, ADestination: IPTCArea);
187var
188  clipped_source: IPTCArea;
189  clipped_destination: IPTCArea;
190begin
191  TPTCClipper.Clip(ASource, TPTCArea.Create(0, 0, AWidth, AHeight),
192                   clipped_source,
193                   ADestination, FClip,
194                   clipped_destination);
195  FCopy.Request(AFormat, FFormat);
196  FCopy.Palette(APalette, FPalette);
197  FCopy.Copy(APixels, clipped_source.left, clipped_source.top,
198             clipped_source.width, clipped_source.height, APitch,
199             FPixels, clipped_destination.left, clipped_destination.top,
200             clipped_destination.width, clipped_destination.height, FPitch);
201end;
202
203procedure TPTCSurface.Save(APixels: Pointer;
204                           AWidth, AHeight, APitch: Integer;
205                           AFormat: IPTCFormat;
206                           APalette: IPTCPalette);
207begin
208  if FClip.Equals(FArea) then
209  begin
210    FCopy.Request(FFormat, AFormat);
211    FCopy.Palette(FPalette, APalette);
212    FCopy.Copy(FPixels, 0, 0, FWidth, FHeight, FPitch, APixels, 0, 0,
213               AWidth, AHeight, APitch);
214  end
215  else
216    Save(APixels, AWidth, AHeight, APitch, AFormat, APalette,
217         FArea, TPTCArea.Create(0, 0, width, height));
218end;
219
220procedure TPTCSurface.Save(APixels: Pointer;
221                           AWidth, AHeight, APitch: Integer;
222                           AFormat: IPTCFormat;
223                           APalette: IPTCPalette;
224                           ASource, ADestination: IPTCArea);
225var
226  clipped_source: IPTCArea;
227  clipped_destination: IPTCArea;
228begin
229  TPTCClipper.Clip(ASource, FClip,
230                   clipped_source,
231                   ADestination, TPTCArea.Create(0, 0, AWidth, AHeight),
232                   clipped_destination);
233  FCopy.Request(FFormat, AFormat);
234  FCopy.Palette(FPalette, APalette);
235  FCopy.Copy(FPixels, clipped_source.left, clipped_source.top,
236             clipped_source.width, clipped_source.height, FPitch,
237             APixels, clipped_destination.left, clipped_destination.top,
238             clipped_destination.width, clipped_destination.height, APitch);
239end;
240
241procedure TPTCSurface.Clear;
242var
243  Color: IPTCColor;
244begin
245  if Format.Direct then
246    Color := TPTCColor.Create(0, 0, 0, 0)
247  else
248    Color := TPTCColor.Create(0);
249
250  Clear(Color);
251end;
252
253procedure TPTCSurface.Clear(AColor: IPTCColor);
254begin
255  Clear(AColor, FArea);
256end;
257
258procedure TPTCSurface.Clear(AColor: IPTCColor; AArea: IPTCArea);
259var
260  clipped_area: IPTCArea;
261begin
262  clipped_area := TPTCClipper.Clip(AArea, FClip);
263  FClear.Request(FFormat);
264  FClear.Clear(FPixels, clipped_area.left, clipped_area.top,
265               clipped_area.width, clipped_area.height, FPitch, AColor);
266end;
267
268procedure TPTCSurface.Palette(APalette: IPTCPalette);
269begin
270  FPalette.Load(APalette.Data^);
271end;
272
273function TPTCSurface.Palette: IPTCPalette;
274begin
275  Result := FPalette;
276end;
277
278procedure TPTCSurface.Clip(AArea: IPTCArea);
279begin
280  FClip := TPTCClipper.Clip(AArea, FArea);
281end;
282
283function TPTCSurface.GetWidth: Integer;
284begin
285  Result := FWidth;
286end;
287
288function TPTCSurface.GetHeight: Integer;
289begin
290  Result := FHeight;
291end;
292
293function TPTCSurface.GetPitch: Integer;
294begin
295  Result := FPitch;
296end;
297
298function TPTCSurface.GetArea: IPTCArea;
299begin
300  Result := FArea;
301end;
302
303function TPTCSurface.Clip: IPTCArea;
304begin
305  Result := FClip;
306end;
307
308function TPTCSurface.GetFormat: IPTCFormat;
309begin
310  Result := FFormat;
311end;
312
313function TPTCSurface.Option(const AOption: string): Boolean;
314begin
315  Result := FCopy.Option(AOption);
316end;
317