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

« back to all changes in this revision

Viewing changes to components/fpvectorial/avisocncgcodereader.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
[ 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:
 
1
{
 
2
Reads AvisoCNC G-Code
 
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
         Pedro Sol Pegorini L de Lima
 
9
}
 
10
unit avisocncgcodereader;
 
11
 
 
12
{$mode objfpc}{$H+}
 
13
 
 
14
interface
 
15
 
 
16
uses
 
17
  Classes, SysUtils,
 
18
  fpvectorial;
 
19
 
 
20
type
 
21
 
 
22
  { Used by tcutils.SeparateString }
 
23
  T10Strings = array[0..9] of shortstring;
 
24
 
 
25
  { TvAvisoCNCGCodeReader }
 
26
 
 
27
  TvAvisoCNCGCodeReader = class(TvCustomVectorialReader)
 
28
  private
 
29
    LastX, LastY, LastZ: Double;
 
30
    function  SeparateString(AString: string; ASeparator: Char): T10Strings;
 
31
    procedure ReadString(AStr: string; AData: TvVectorialPage);
 
32
    function  GetCoordinate(AStr: shortstring): Integer;
 
33
    function  GetCoordinateValue(AStr: shortstring): Double;
 
34
  public
 
35
    { General reading methods }
 
36
    procedure ReadFromStrings(AStrings: TStrings; AData: TvVectorialDocument); override;
 
37
  end;
 
38
 
 
39
implementation
 
40
 
 
41
const
 
42
  { Coordinate constants }
 
43
 
 
44
  INT_COORDINATE_NONE = 0;
 
45
  INT_COORDINATE_X = 1;
 
46
  INT_COORDINATE_Y = 2;
 
47
  INT_COORDINATE_Z = 3;
 
48
 
 
49
  { GCode constants }
 
50
 
 
51
  STR_GCODE_LINEAR_MOVE = 'G01';
 
52
  STR_GCODE_STEPPER_MOVE = 'S01';
 
53
  STR_GCODE_2DBEZIER_MOVE = 'B02';
 
54
  STR_GCODE_3DBEZIER_MOVE = 'B03';
 
55
  STR_GCODE_DRILL_UP = 'P01';
 
56
  STR_GCODE_DRILL_DOWN = 'P02';
 
57
 
 
58
{ TvAvisoCNCGCodeReader }
 
59
 
 
60
{@@
 
61
  Reads a string and separates it in substring
 
62
  using ASeparator to delimite them.
 
63
 
 
64
  Limits:
 
65
 
 
66
  Number of substrings: 10 (indexed 0 to 9)
 
67
  Length of each substring: 255 (they are shortstrings)
 
68
}
 
69
function TvAvisoCNCGCodeReader.SeparateString(AString: string; ASeparator: Char): T10Strings;
 
70
var
 
71
  i, CurrentPart: Integer;
 
72
begin
 
73
  CurrentPart := 0;
 
74
 
 
75
  { Clears the result }
 
76
  for i := 0 to 9 do Result[i] := '';
 
77
 
 
78
  { Iterates througth the string, filling strings }
 
79
  for i := 1 to Length(AString) do
 
80
  begin
 
81
    if Copy(AString, i, 1) = ASeparator then
 
82
    begin
 
83
      Inc(CurrentPart);
 
84
 
 
85
      { Verifies if the string capacity wasn't exceeded }
 
86
      if CurrentPart > 9 then Exit;
 
87
    end
 
88
    else
 
89
      Result[CurrentPart] := Result[CurrentPart] + Copy(AString, i, 1);
 
90
  end;
 
91
end;
 
92
 
 
93
procedure TvAvisoCNCGCodeReader.ReadString(AStr: string;
 
94
  AData: TvVectorialPage);
 
95
var
 
96
  AParams: T10Strings;
 
97
  DestX, DestY, DestZ: Double;
 
98
  i: Integer;
 
99
begin
 
100
  {$ifdef FPVECTORIALDEBUG}
 
101
  WriteLn('TvAvisoCNCGCodeReader.ReadString ', AStr);
 
102
  {$endif}
 
103
  AParams := SeparateString(AStr, ' ');
 
104
 
 
105
  {
 
106
    Format may be:
 
107
    G01 X3
 
108
    G01 X3 Y4
 
109
    G01 X3 Y4 Z2
 
110
  }
 
111
  if AParams[0] = STR_GCODE_DRILL_UP then
 
112
  begin
 
113
    AData.AddLineToPath(LastX, LastY, 0);
 
114
    LastZ := 0;
 
115
  end
 
116
  else if AParams[0] = STR_GCODE_DRILL_DOWN then
 
117
  begin
 
118
    AData.AddLineToPath(LastX, LastY, 50);
 
119
    LastZ := 50;
 
120
  end
 
121
  else if AParams[0] = STR_GCODE_LINEAR_MOVE then
 
122
  begin
 
123
    DestX := LastX;
 
124
    DestY := LastY;
 
125
    DestZ := LastZ;
 
126
 
 
127
    for i := 1 to 3 do
 
128
    begin
 
129
      case GetCoordinate(AParams[i]) of
 
130
      INT_COORDINATE_X: DestX := GetCoordinateValue(AParams[i]);
 
131
      INT_COORDINATE_Y: DestY := GetCoordinateValue(AParams[i]);
 
132
      INT_COORDINATE_Z: DestZ := GetCoordinateValue(AParams[i]);
 
133
      else
 
134
        // error
 
135
      end;
 
136
    end;
 
137
 
 
138
    AData.AddLineToPath(DestX, DestY, DestZ);
 
139
 
 
140
    LastX := DestX;
 
141
    LastY := DestY;
 
142
    LastZ := DestZ;
 
143
  end
 
144
  else if AParams[0] = STR_GCODE_2DBEZIER_MOVE then
 
145
  begin
 
146
    AData.AddBezierToPath(
 
147
      GetCoordinateValue(AParams[1]),
 
148
      GetCoordinateValue(AParams[2]),
 
149
      GetCoordinateValue(AParams[3]),
 
150
      GetCoordinateValue(AParams[4]),
 
151
      GetCoordinateValue(AParams[5]),
 
152
      GetCoordinateValue(AParams[6])
 
153
      );
 
154
 
 
155
    LastX := GetCoordinateValue(AParams[5]);
 
156
    LastY := GetCoordinateValue(AParams[6]);
 
157
  end
 
158
  else if AParams[0] = STR_GCODE_3DBEZIER_MOVE then
 
159
  begin
 
160
    AData.AddBezierToPath(
 
161
      GetCoordinateValue(AParams[1]),
 
162
      GetCoordinateValue(AParams[2]),
 
163
      GetCoordinateValue(AParams[3]),
 
164
      GetCoordinateValue(AParams[4]),
 
165
      GetCoordinateValue(AParams[5]),
 
166
      GetCoordinateValue(AParams[6]),
 
167
      GetCoordinateValue(AParams[7]),
 
168
      GetCoordinateValue(AParams[8]),
 
169
      GetCoordinateValue(AParams[9])
 
170
      );
 
171
 
 
172
    LastX := GetCoordinateValue(AParams[7]);
 
173
    LastY := GetCoordinateValue(AParams[8]);
 
174
    LastZ := GetCoordinateValue(AParams[9]);
 
175
  end;
 
176
  {else
 
177
  begin
 
178
     Ignore any of these codes:
 
179
 
 
180
      STR_GCODE_STEPPER_MOVE
 
181
 
 
182
      and anything else
 
183
  end;}
 
184
end;
 
185
 
 
186
function TvAvisoCNCGCodeReader.GetCoordinate(AStr: shortstring): Integer;
 
187
begin
 
188
  Result := INT_COORDINATE_NONE;
 
189
 
 
190
  if AStr = '' then Exit
 
191
  else if AStr[1] = 'X' then Result := INT_COORDINATE_X
 
192
  else if AStr[1] = 'Y' then Result := INT_COORDINATE_Y
 
193
  else if AStr[1] = 'Z' then Result := INT_COORDINATE_Z;
 
194
end;
 
195
 
 
196
function TvAvisoCNCGCodeReader.GetCoordinateValue(AStr: shortstring): Double;
 
197
begin
 
198
  Result := 0.0;
 
199
 
 
200
  if Length(AStr) <= 1 then Exit;
 
201
 
 
202
  Result := StrToFloat(Copy(AStr, 2, Length(AStr) - 1));
 
203
end;
 
204
 
 
205
{@@
 
206
  The information of each separate path is lost in G-Code files
 
207
  Only one path uniting all of them is created when reading G-Code
 
208
}
 
209
procedure TvAvisoCNCGCodeReader.ReadFromStrings(AStrings: TStrings;
 
210
  AData: TvVectorialDocument);
 
211
var
 
212
  i: Integer;
 
213
  FirstPage: TvVectorialPage;
 
214
begin
 
215
  {$ifdef FPVECTORIALDEBUG}
 
216
  WriteLn('TvAvisoCNCGCodeReader.ReadFromStrings AStrings = ', PtrInt(AStrings), ' AData = ', PtrInt(AData));
 
217
  {$endif}
 
218
 
 
219
  FirstPage := AData.AddPage();
 
220
  FirstPage.StartPath(0, 0);
 
221
 
 
222
  for i := 0 to AStrings.Count - 1 do
 
223
    ReadString(AStrings.Strings[i], FirstPage);
 
224
 
 
225
  {$ifdef FPVECTORIALDEBUG}
 
226
  WriteLn('AData.EndPath');
 
227
  {$endif}
 
228
  FirstPage.EndPath();
 
229
end;
 
230
 
 
231
initialization
 
232
 
 
233
  RegisterVectorialReader(TvAvisoCNCGCodeReader, vfGCodeAvisoCNCPrototipoV5);
 
234
 
 
235
end.
 
236