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