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