← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/fpvectorial/svgvectorialreader.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/fpvectorial/svgvectorialreader.pas
 
1
{
 
2
Reads an SVG Document
 
3
 
 
4
License: The same modified LGPL as the Free Pascal RTL
 
5
         See the file COPYING.modifiedLGPL for more details
 
6
 
 
7
AUTHORS: Felipe Monteiro de Carvalho
 
8
}
 
9
unit svgvectorialreader;
 
10
 
 
11
{$mode objfpc}{$H+}
 
12
 
 
13
interface
 
14
 
 
15
uses
 
16
  Classes, SysUtils, math,
 
17
  xmlread, dom, fgl,
 
18
  fpvectorial, fpvutils;
 
19
 
 
20
type
 
21
  TSVGTokenType = (sttMoveTo, sttLineTo, sttBezierTo, sttFloatValue);
 
22
 
 
23
  TSVGToken = class
 
24
    TokenType: TSVGTokenType;
 
25
    Value: Float;
 
26
  end;
 
27
 
 
28
  TSVGTokenList = specialize TFPGList<TSVGToken>;
 
29
 
 
30
  { TSVGPathTokenizer }
 
31
 
 
32
  TSVGPathTokenizer = class
 
33
  public
 
34
    FPointSeparator, FCommaSeparator: TFormatSettings;
 
35
    Tokens: TSVGTokenList;
 
36
    constructor Create;
 
37
    Destructor Destroy; override;
 
38
    procedure AddToken(AStr: string);
 
39
    procedure TokenizePathString(AStr: string);
 
40
  end;
 
41
 
 
42
  { TvSVGVectorialReader }
 
43
 
 
44
  TvSVGVectorialReader = class(TvCustomVectorialReader)
 
45
  private
 
46
    FPointSeparator, FCommaSeparator: TFormatSettings;
 
47
    FSVGPathTokenizer: TSVGPathTokenizer;
 
48
    procedure ReadPathFromNode(APath: TDOMNode; AData: TvVectorialPage; ADoc: TvVectorialDocument);
 
49
    procedure ReadPathFromString(AStr: string; AData: TvVectorialPage; ADoc: TvVectorialDocument);
 
50
    function  StringWithUnitToFloat(AStr: string): Single;
 
51
    procedure ConvertSVGCoordinatesToFPVCoordinates(
 
52
      const AData: TvVectorialPage;
 
53
      const ASrcX, ASrcY: Float; var ADestX, ADestY: Float);
 
54
    procedure ConvertSVGDeltaToFPVDelta(
 
55
      const AData: TvVectorialPage;
 
56
      const ASrcX, ASrcY: Float; var ADestX, ADestY: Float);
 
57
  public
 
58
    { General reading methods }
 
59
    constructor Create; override;
 
60
    Destructor Destroy; override;
 
61
    procedure ReadFromStream(AStream: TStream; AData: TvVectorialDocument); override;
 
62
  end;
 
63
 
 
64
implementation
 
65
 
 
66
const
 
67
  // SVG requires hardcoding a DPI value
 
68
 
 
69
  // The Opera Browser and Inkscape use 90 DPI, so we follow that
 
70
 
 
71
  // 1 Inch = 25.4 milimiters
 
72
  // 90 inches per pixel = (1 / 90) * 25.4 = 0.2822
 
73
  // FLOAT_MILIMETERS_PER_PIXEL = 0.3528; // DPI 72 = 1 / 72 inches per pixel
 
74
 
 
75
  FLOAT_MILIMETERS_PER_PIXEL = 0.2822; // DPI 90 = 1 / 90 inches per pixel
 
76
  FLOAT_PIXELS_PER_MILIMETER = 3.5433; // DPI 90 = 1 / 90 inches per pixel
 
77
 
 
78
{ TSVGPathTokenizer }
 
79
 
 
80
constructor TSVGPathTokenizer.Create;
 
81
begin
 
82
  inherited Create;
 
83
 
 
84
  FPointSeparator := DefaultFormatSettings;
 
85
  FPointSeparator.DecimalSeparator := '.';
 
86
  FPointSeparator.ThousandSeparator := '#';// disable the thousand separator
 
87
 
 
88
  Tokens := TSVGTokenList.Create;
 
89
end;
 
90
 
 
91
destructor TSVGPathTokenizer.Destroy;
 
92
begin
 
93
  Tokens.Free;
 
94
 
 
95
  inherited Destroy;
 
96
end;
 
97
 
 
98
procedure TSVGPathTokenizer.AddToken(AStr: string);
 
99
var
 
100
  lToken: TSVGToken;
 
101
begin
 
102
  lToken := TSVGToken.Create;
 
103
 
 
104
  if AStr = 'm' then lToken.TokenType := sttMoveTo
 
105
  else if AStr = 'l' then lToken.TokenType := sttLineTo
 
106
  else if AStr = 'c' then lToken.TokenType := sttBezierTo
 
107
  else
 
108
  begin
 
109
    lToken.TokenType := sttFloatValue;
 
110
    lToken.Value := StrToFloat(AStr, FPointSeparator);
 
111
  end;
 
112
 
 
113
  Tokens.Add(lToken);
 
114
end;
 
115
 
 
116
procedure TSVGPathTokenizer.TokenizePathString(AStr: string);
 
117
const
 
118
  Str_Space: Char = ' ';
 
119
  Str_Comma: Char = ',';
 
120
var
 
121
  i: Integer;
 
122
  lTmpStr: string;
 
123
  lState: Integer;
 
124
  lCurChar: Char;
 
125
begin
 
126
  lState := 0;
 
127
 
 
128
  i := 1;
 
129
  while i <= Length(AStr) do
 
130
  begin
 
131
    case lState of
 
132
    0: // Adding to the tmp string
 
133
    begin
 
134
      lCurChar := AStr[i];
 
135
      if lCurChar = Str_Space then
 
136
      begin
 
137
        lState := 1;
 
138
        AddToken(lTmpStr);
 
139
        lTmpStr := '';
 
140
      end
 
141
      else if lCurChar = Str_Comma then
 
142
      begin
 
143
        AddToken(lTmpStr);
 
144
        lTmpStr := '';
 
145
      end
 
146
      else
 
147
        lTmpStr := lTmpStr + lCurChar;
 
148
 
 
149
      Inc(i);
 
150
    end;
 
151
    1: // Removing spaces
 
152
    begin
 
153
      if AStr[i] <> Str_Space then lState := 0
 
154
      else Inc(i);
 
155
    end;
 
156
    end;
 
157
  end;
 
158
end;
 
159
 
 
160
{ Example of a supported SVG image:
 
161
 
 
162
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
 
163
<!-- Created with fpVectorial (http://wiki.lazarus.freepascal.org/fpvectorial) -->
 
164
 
 
165
<svg
 
166
  xmlns:dc="http://purl.org/dc/elements/1.1/"
 
167
  xmlns:cc="http://creativecommons.org/ns#"
 
168
  xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
 
169
  xmlns:svg="http://www.w3.org/2000/svg"
 
170
  xmlns="http://www.w3.org/2000/svg"
 
171
  xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
 
172
  width="100mm"
 
173
  height="100mm"
 
174
  id="svg2"
 
175
  version="1.1"
 
176
  sodipodi:docname="New document 1">
 
177
  <g id="layer1">
 
178
  <path
 
179
    style="fill:none;stroke:#000000;stroke-width:10px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
 
180
    d="m 0,283.486888731396 l 106.307583274274,-35.4358610914245 "
 
181
  id="path0" />
 
182
  <path
 
183
    style="fill:none;stroke:#000000;stroke-width:10px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
 
184
    d="m 0,354.358610914245 l 354.358610914245,0 l 0,-354.358610914245 l -354.358610914245,0 l 0,354.358610914245 "
 
185
  id="path1" />
 
186
  <path
 
187
    style="fill:none;stroke:#000000;stroke-width:10px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1"
 
188
    d="m 0,354.358610914245 l 35.4358610914245,-35.4358610914245 c 0,-35.4358610914246 35.4358610914245,-35.4358610914246 35.4358610914245,0 l 35.4358610914245,35.4358610914245 "
 
189
  id="path2" />
 
190
  </g>
 
191
</svg>
 
192
}
 
193
 
 
194
{ TvSVGVectorialReader }
 
195
 
 
196
procedure TvSVGVectorialReader.ReadPathFromNode(APath: TDOMNode;
 
197
  AData: TvVectorialPage; ADoc: TvVectorialDocument);
 
198
var
 
199
  lNodeName, lStyleStr, lDStr: WideString;
 
200
  i: Integer;
 
201
begin
 
202
  for i := 0 to APath.Attributes.Length - 1 do
 
203
  begin
 
204
    lNodeName := APath.Attributes.Item[i].NodeName;
 
205
    if  lNodeName = 'style' then
 
206
      lStyleStr := APath.Attributes.Item[i].NodeValue
 
207
    else if lNodeName = 'd' then
 
208
      lDStr := APath.Attributes.Item[i].NodeValue
 
209
  end;
 
210
 
 
211
  AData.StartPath();
 
212
  ReadPathFromString(UTF8Encode(lDStr), AData, ADoc);
 
213
  AData.EndPath();
 
214
end;
 
215
 
 
216
procedure TvSVGVectorialReader.ReadPathFromString(AStr: string;
 
217
  AData: TvVectorialPage; ADoc: TvVectorialDocument);
 
218
var
 
219
  i: Integer;
 
220
  X, Y, X2, Y2, X3, Y3: Float;
 
221
  CurX, CurY: Float;
 
222
begin
 
223
  FSVGPathTokenizer.Tokens.Clear;
 
224
  FSVGPathTokenizer.TokenizePathString(AStr);
 
225
  CurX := 0;
 
226
  CurY := 0;
 
227
 
 
228
  i := 0;
 
229
  while i < FSVGPathTokenizer.Tokens.Count do
 
230
  begin
 
231
    if FSVGPathTokenizer.Tokens.Items[i].TokenType = sttMoveTo then
 
232
    begin
 
233
      CurX := FSVGPathTokenizer.Tokens.Items[i+1].Value;
 
234
      CurY := FSVGPathTokenizer.Tokens.Items[i+2].Value;
 
235
      ConvertSVGCoordinatesToFPVCoordinates(AData, CurX, CurY, CurX, CurY);
 
236
 
 
237
      AData.AddMoveToPath(CurX, CurY);
 
238
 
 
239
      Inc(i, 3);
 
240
    end
 
241
    else if FSVGPathTokenizer.Tokens.Items[i].TokenType = sttLineTo then
 
242
    begin
 
243
      X := FSVGPathTokenizer.Tokens.Items[i+1].Value;
 
244
      Y := FSVGPathTokenizer.Tokens.Items[i+2].Value;
 
245
      ConvertSVGDeltaToFPVDelta(AData, X, Y, X, Y);
 
246
 
 
247
      // LineTo uses relative coordenates in SVG
 
248
      CurX := CurX + X;
 
249
      CurY := CurY + Y;
 
250
 
 
251
      AData.AddLineToPath(CurX, CurY);
 
252
 
 
253
      Inc(i, 3);
 
254
    end
 
255
    else if FSVGPathTokenizer.Tokens.Items[i].TokenType = sttBezierTo then
 
256
    begin
 
257
      X2 := FSVGPathTokenizer.Tokens.Items[i+1].Value;
 
258
      Y2 := FSVGPathTokenizer.Tokens.Items[i+2].Value;
 
259
      X3 := FSVGPathTokenizer.Tokens.Items[i+3].Value;
 
260
      Y3 := FSVGPathTokenizer.Tokens.Items[i+4].Value;
 
261
      X := FSVGPathTokenizer.Tokens.Items[i+5].Value;
 
262
      Y := FSVGPathTokenizer.Tokens.Items[i+6].Value;
 
263
 
 
264
      ConvertSVGDeltaToFPVDelta(AData, X2, Y2, X2, Y2);
 
265
      ConvertSVGDeltaToFPVDelta(AData, X3, Y3, X3, Y3);
 
266
      ConvertSVGDeltaToFPVDelta(AData, X, Y, X, Y);
 
267
 
 
268
      AData.AddBezierToPath(X2 + CurX, Y2 + CurY, X3 + CurX, Y3 + CurY, X + CurX, Y + CurY);
 
269
 
 
270
      // BezierTo uses relative coordenates in SVG
 
271
      CurX := CurX + X;
 
272
      CurY := CurY + Y;
 
273
 
 
274
      Inc(i, 7);
 
275
    end
 
276
    else
 
277
    begin
 
278
      Inc(i);
 
279
    end;
 
280
  end;
 
281
end;
 
282
 
 
283
function TvSVGVectorialReader.StringWithUnitToFloat(AStr: string): Single;
 
284
var
 
285
  UnitStr, ValueStr: string;
 
286
  Len: Integer;
 
287
begin
 
288
  // Check the unit
 
289
  Len := Length(AStr);
 
290
  UnitStr := Copy(AStr, Len-1, 2);
 
291
  if UnitStr = 'mm' then
 
292
  begin
 
293
    ValueStr := Copy(AStr, 1, Len-2);
 
294
    Result := StrToInt(ValueStr);
 
295
  end;
 
296
end;
 
297
 
 
298
procedure TvSVGVectorialReader.ConvertSVGCoordinatesToFPVCoordinates(
 
299
  const AData: TvVectorialPage; const ASrcX, ASrcY: Float;
 
300
  var ADestX,ADestY: Float);
 
301
begin
 
302
  ADestX := ASrcX * FLOAT_MILIMETERS_PER_PIXEL;
 
303
  ADestY := AData.Height - ASrcY * FLOAT_MILIMETERS_PER_PIXEL;
 
304
end;
 
305
 
 
306
procedure TvSVGVectorialReader.ConvertSVGDeltaToFPVDelta(
 
307
  const AData: TvVectorialPage; const ASrcX, ASrcY: Float; var ADestX,
 
308
  ADestY: Float);
 
309
begin
 
310
  ADestX := ASrcX * FLOAT_MILIMETERS_PER_PIXEL;
 
311
  ADestY := - ASrcY * FLOAT_MILIMETERS_PER_PIXEL;
 
312
end;
 
313
 
 
314
constructor TvSVGVectorialReader.Create;
 
315
begin
 
316
  inherited Create;
 
317
 
 
318
  FPointSeparator := DefaultFormatSettings;
 
319
  FPointSeparator.DecimalSeparator := '.';
 
320
  FPointSeparator.ThousandSeparator := '#';// disable the thousand separator
 
321
 
 
322
  FSVGPathTokenizer := TSVGPathTokenizer.Create;
 
323
end;
 
324
 
 
325
destructor TvSVGVectorialReader.Destroy;
 
326
begin
 
327
  FSVGPathTokenizer.Free;
 
328
 
 
329
  inherited Destroy;
 
330
end;
 
331
 
 
332
procedure TvSVGVectorialReader.ReadFromStream(AStream: TStream;
 
333
  AData: TvVectorialDocument);
 
334
var
 
335
  Doc: TXMLDocument;
 
336
  lFirstLayer, lCurNode: TDOMNode;
 
337
  lPage: TvVectorialPage;
 
338
begin
 
339
  try
 
340
    // Read in xml file from the stream
 
341
    ReadXMLFile(Doc, AStream);
 
342
 
 
343
    // Read the properties of the <svg> tag
 
344
    AData.Width := StringWithUnitToFloat(Doc.DocumentElement.GetAttribute('width'));
 
345
    AData.Height := StringWithUnitToFloat(Doc.DocumentElement.GetAttribute('height'));
 
346
 
 
347
    // Now process the elements inside the first layer
 
348
    lFirstLayer := Doc.DocumentElement.FirstChild;
 
349
    lCurNode := lFirstLayer.FirstChild;
 
350
    lPage := AData.AddPage();
 
351
    lPage.Width := AData.Width;
 
352
    lPage.Height := AData.Height;
 
353
    while Assigned(lCurNode) do
 
354
    begin
 
355
      ReadPathFromNode(lCurNode, lPage, AData);
 
356
      lCurNode := lCurNode.NextSibling;
 
357
    end;
 
358
  finally
 
359
    // finally, free the document
 
360
    Doc.Free;
 
361
  end;
 
362
end;
 
363
 
 
364
initialization
 
365
 
 
366
  RegisterVectorialReader(TvSVGVectorialReader, vfSVG);
 
367
 
 
368
end.
 
369