1 { Version 030505. Copyright � Alexey A.Chernobaev, 1996-2003 }
2 
3 unit RWGML;
4 {
5   ������ � ������ ������ �������� � GML-�������.
6   ���������� � ������������ � "GML: Graph Modelling Language. Draft version.
7   Michael Himsolt. December 19, 1996."
8   ������� �� ������� ��������:
9   1) ��� ����������� �� ����� ������ (�� �������� - �� ����� 254-� ��������);
10   2) ������ �� �����������;
11   3) ������ �� �������������� � ISO 8859-1 ���������;
12   4) ������ ����������� � ������� ������� (ASCII 34); ������� �������,
13      �������� � ������ ������, �����������.
14 }
15 
16 interface
17 
18 {$I VCheck.inc}
19 
20 uses
21   SysUtils, ExtType, Pointerv, VectStr, VTxtStrm, VFormat, GMLObj;
22 
23 const
24   ListOpen = '[';
25   ListClose = ']';
26   GMLIndent: String = '  '; { ������, ������������ ��� ������ GML-�������� }
27 
28 type
29   EGMLReadError = class(Exception);
30 
31   TGMLReader = class
32   protected
33     Line: String;
34     Pos, LineLen: Integer;
35     FLineNumber: Int32;
36     FStream: TTextStream;
37   public
38     constructor Create(AStream: TTextStream);
39     procedure Error(const Msg: String);
HaveDatanull40     function HaveData: Bool;
GetTermnull41     function GetTerm: String;
ReadObjectnull42     function ReadObject(const AKey: String): TGMLObject;
FindKeynull43     function FindKey(const AKey: String): Bool;
44     { ����� ��������� ������ � ������ AKey (AKey ������ ���� � lower case) }
45     procedure ReadObjects(AList: TClassList; ReadingList: Bool);
46     property LineNumber: Int32 read FLineNumber;
47   end;
48 
CreateGMLObjectFromStreamnull49 function CreateGMLObjectFromStream(TextStream: TTextStream): TGMLObject;
50 { ������ �� ���������� ������ � ������� ��������� GML-������ �������� ������;
51   ���� ��� ������ ���������� ������ ���� ����� ����, �� ������������
52   �������������� �������� }
53 
54 procedure ReadGMLObjectsFromStream(GMLObjects: TClassList; TextStream: TTextStream);
55 { ������ �� ���������� ������ ������ ������ GML-�������� (��������, ������) }
56 
57 procedure WriteGMLObjectsToStream(const Indent: String; GMLObjects: TClassList;
58   TextStream: TTextStream);
59 { ���������� � ��������� ����� ������ GML-�������� � �������� Indent }
60 
61 implementation
62 
63 const
64   Spaces = [#0..' '];
65   Comment = '#';
66   Delimiters = [ListOpen, ListClose];
67   Quote = '"';
68 
69   SUnexpectedEOF = 'Unexpected end of file';
70   SWrongIdentifier = 'Wrong identifier';
71   SListCloseExpected = '''' + ListClose + ''' expected';
72   SUnterminatedString = 'Unterminated string';
73   SWrongNumber = 'Wrong number';
74   SOnLine = ' on line #';
75 
76 constructor TGMLReader.Create(AStream: TTextStream);
77 begin
78   inherited Create;
79   FStream:=AStream;
80   FLineNumber:=AStream.LineNumber;
81   Pos:=1;
82 end;
83 
84 procedure TGMLReader.Error(const Msg: String);
85 {$IFDEF V_DELPHI}{$IFDEF WIN32}
ReturnAddrnull86   function ReturnAddr: Pointer;
87   asm
88           mov     eax, [ebp+4]
89   end;
90 {$ENDIF}{$ENDIF}
91 begin
92   raise EGMLReadError.Create(Msg + SOnLine + IntToStr(FLineNumber))
93     {$IFDEF V_DELPHI}{$IFDEF WIN32}at ReturnAddr{$ENDIF}{$ENDIF};
94 end;
95 
TGMLReader.HaveDatanull96 function TGMLReader.HaveData: Bool;
97 { ���� ������� ������ ��������� ���������, �� ������ ��������� ������ � �������,
98   ��������� ������ ������ � ������-����������� (������, ������������ � �������
99   Comment); ���� ��������� ����� ������, �� ���������� True, ����� - False; �
100   ��������� ������ � ����������� ������ ���������� ��������� � �������� �������
101   � ������ <= ' ', ����� ���� ��� ���������� � ���� Line � �����������
102   ������������ LineLen:=Length(Line); Pos:=1 }
103 begin
104   if Pos > LineLen then begin
105     repeat
106       if FStream.EOF then begin
107         Result:=False;
108         Exit;
109       end;
110       Line:=FStream.ReadTrimmed;
111     until (Line <> '') and (Line[1] <> Comment);
112     LineLen:=Length(Line);
113     Pos:=1;
114   end;
115   Result:=True;
116 end;
117 
GetTermnull118 function TGMLReader.GetTerm: String;
119 { ���������� ��������� ������� }
120 var
121   OldPos: Integer;
122   B: Bool;
123   C: Char;
124 begin
125   B:=HaveData;
126   FLineNumber:=FStream.LineNumber;
127   if not B then Error(SUnexpectedEOF);
128   OldPos:=Pos;
129   Inc(Pos);
130   if not (Line[OldPos] in Delimiters) then
131     if Line[OldPos] <> Quote then
132       { �� Quote => ������ �� ����� ��� ����������� }
133       while (Pos <= LineLen) and not (Line[Pos] in (Spaces + Delimiters)) do
134         Inc(Pos)
135     else
136       { Quote => ������ ������, � ������� ����������� ��������� Quote }
137       while Pos <= LineLen do begin
138         C:=Line[Pos];
139         Inc(Pos);
140         if (C = Quote) and (Pos <= LineLen) then
141           if Line[Pos] = Quote then Inc(Pos)
142           else
143             Break;
144       end;
145   Result:=Copy(Line, OldPos, Pos - OldPos);
146   while (Pos <= LineLen) and (Line[Pos] in Spaces) do Inc(Pos);
147 end;
148 
TGMLReader.ReadObjectnull149 function TGMLReader.ReadObject(const AKey: String): TGMLObject;
150 var
151   KeyLineNumber: Integer;
152   T: String;
153   NewList: TClassList;
154 begin
155   KeyLineNumber:=FLineNumber;
156   if not IsCorrectIdentifier(AKey,false) then
157     Error(SWrongIdentifier + ' ''' + AKey + '''');
158   T:=GetTerm;
159   if T = ListOpen then begin
160     NewList:=TClassList.Create;
161     try
162       ReadObjects(NewList, True);
163     except
164       NewList.FreeItems;
165       NewList.Free;
166       raise;
167     end;
168     Result:=TGMLObject.CreateList(AKey, NewList);
169   end
170   else if T[1] = Quote then begin
171     if (Length(T) < 2) or (T[Length(T)] <> Quote) then
172       Error(SUnterminatedString);
173     Result:=TGMLObject.CreateString(AKey, LiteralToString(T));
174   end
175   else begin
176     Result:=nil;
177     try
178       if System.Pos('.', T) = 0 then
179         Result:=TGMLObject.CreateInt(AKey, StrToInt(T))
180       else
181         Result:=TGMLObject.CreateReal(AKey, StringToReal(T));
182     except
183       Result.Free;
184       Error(SWrongNumber + ' ''' + T + '''');
185     end;
186   end;
187   Result.Tag:=KeyLineNumber;
188 end;
189 
FindKeynull190 function TGMLReader.FindKey(const AKey: String): Bool;
191 var
192   Key: String;
193 begin
194   while HaveData do begin
195     Key:=LowerCase(GetTerm);
196     if Key = AKey then begin
197       Result:=True;
198       Exit;
199     end
200     else begin
201       if not IsCorrectIdentifier(Key,false) then
202         Error(SWrongIdentifier + ' ''' + Key + '''');
203       if GetTerm = ListOpen then
204         if not FindKey(ListClose) then Error(SListCloseExpected);
205     end;
206   end;
207   Result:=False;
208 end;
209 
210 procedure TGMLReader.ReadObjects(AList: TClassList; ReadingList: Bool);
211 var
212   Key: String;
213 begin
214   while HaveData do begin
215     Key:=GetTerm;
216     if ReadingList and (Key = ListClose) then Exit;
217     AList.Add(ReadObject(Key));
218   end;
219   if ReadingList then begin
220     FLineNumber:=FStream.LineNumber;
221     Error(SListCloseExpected);
222   end;
223 end;
224 
CreateGMLObjectFromStreamnull225 function CreateGMLObjectFromStream(TextStream: TTextStream): TGMLObject;
226 var
227   GMLReader: TGMLReader;
228 begin
229   GMLReader:=TGMLReader.Create(TextStream);
230   try
231     Result:=GMLReader.ReadObject(GMLReader.GetTerm);
232   finally
233     GMLReader.Free;
234   end;
235 end;
236 
237 procedure ReadGMLObjectsFromStream(GMLObjects: TClassList; TextStream: TTextStream);
238 var
239   GMLReader: TGMLReader;
240 begin
241   GMLReader:=TGMLReader.Create(TextStream);
242   try
243     GMLReader.ReadObjects(GMLObjects, False);
244   finally
245     GMLReader.Free;
246   end;
247 end;
248 
249 procedure WriteGMLObjectsToStream(const Indent: String; GMLObjects: TClassList;
250   TextStream: TTextStream);
251 var
252   I: Integer;
253   GMLObject: TGMLObject;
254 
255   procedure WriteValue(const Value: String);
256   begin
257     TextStream.WriteString(Indent + GMLObject.Key + ' ' + Value);
258   end;
259 
CorrectedRealnull260   function CorrectedReal(const Value: String): String;
261   { ��� ����, ����� �������� � GML ������������ ����� �� �����, � ������
262     ������ ����������� ������ �������������� '.' }
263   var
264     I: Integer;
265   begin
266     Result:=Value;
267     I:=Pos('.', Value);
268     if I = 0 then Result:=Result + '.0';
269   end;
270 
271 begin
272   for I:=0 to GMLObjects.Count - 1 do begin
273     GMLObject:=TGMLObject(GMLObjects[I]);
274     Case GMLObject.GMLType of
275       GMLInt:
276         WriteValue(IntToStr(GMLObject.Data.AsInt));
277       GMLReal:
278         WriteValue(CorrectedReal(RealToString(GMLObject.Data.AsReal, DefaultRealFormat)));
279       GMLString:
280         WriteValue(StringToLiteral2(GMLObject.Data.AsString^));
281     Else {GMLList}
282       WriteValue(ListOpen);
283       WriteGMLObjectsToStream(Indent + GMLIndent, GMLObject.Data.AsList,
284         TextStream);
285       TextStream.WriteString(Indent + ListClose);
286     End;
287   end;
288 end;
289 
290 end.
291