- Timestamp:
- Jun 26, 2023, 12:17:46 PM (17 months ago)
- Location:
- branches/xpascal
- Files:
-
- 1 added
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/xpascal/Executor.pas
r230 r231 159 159 implementation 160 160 161 uses 162 SourceNode; 163 161 164 resourcestring 162 165 SUnsupportedOperandType = 'Unsupported exception operand type.'; -
branches/xpascal/Generators/GeneratorXml.pas
r230 r231 4 4 5 5 uses 6 Classes, SysUtils, Source, Generator;6 Classes, SysUtils, Source, SourceNode, Generator; 7 7 8 8 type -
branches/xpascal/Languages/xpascal.cs.po
r230 r231 25 25 26 26 #: generatorxml.sunsupportednodetype 27 #, fuzzy28 27 msgctxt "generatorxml.sunsupportednodetype" 29 28 msgid "Unsupported node type" … … 43 42 msgstr "Chyba indexu" 44 43 45 #: source.sno 44 #: sourcenode.sno 45 msgctxt "sourcenode.sno" 46 46 msgid "No" 47 47 msgstr "Ne" 48 48 49 #: source .sunsupporteddatatype49 #: sourcenode.sunsupporteddatatype 50 50 #, object-pascal-format 51 msgctxt "sourcenode.sunsupporteddatatype" 51 52 msgid "Unsupported field value data type %s" 52 53 msgstr "NepodporovanÃœ datovÃœ typ pole %s" 53 54 54 #: source .sunsupportedvalueindex55 #: sourcenode.sunsupportedvalueindex 55 56 #, object-pascal-format 57 msgctxt "sourcenode.sunsupportedvalueindex" 56 58 msgid "Unsupported value index %d" 57 59 msgstr "Nepodporovaná hodnota indexu %d" 58 60 59 #: source.syes 61 #: sourcenode.syes 62 msgctxt "sourcenode.syes" 60 63 msgid "Yes" 61 64 msgstr "Ano" … … 149 152 msgid "Source:" 150 153 msgstr "Zdroj:" 151 -
branches/xpascal/Languages/xpascal.pot
r230 r231 32 32 msgstr "" 33 33 34 #: source.sno 34 #: sourcenode.sno 35 msgctxt "sourcenode.sno" 35 36 msgid "No" 36 37 msgstr "" 37 38 38 #: source .sunsupporteddatatype39 #: sourcenode.sunsupporteddatatype 39 40 #, object-pascal-format 41 msgctxt "sourcenode.sunsupporteddatatype" 40 42 msgid "Unsupported field value data type %s" 41 43 msgstr "" 42 44 43 #: source .sunsupportedvalueindex45 #: sourcenode.sunsupportedvalueindex 44 46 #, object-pascal-format 47 msgctxt "sourcenode.sunsupportedvalueindex" 45 48 msgid "Unsupported value index %d" 46 49 msgstr "" 47 50 48 #: source.syes 51 #: sourcenode.syes 52 msgctxt "sourcenode.syes" 49 53 msgid "Yes" 50 54 msgstr "" -
branches/xpascal/Optimizer.pas
r230 r231 4 4 5 5 uses 6 Classes, SysUtils, Source ;6 Classes, SysUtils, Source, SourceNode; 7 7 8 8 type -
branches/xpascal/Source.pas
r230 r231 4 4 5 5 uses 6 Classes, SysUtils, Generics.Collections ;6 Classes, SysUtils, Generics.Collections, SourceNode; 7 7 8 8 type … … 11 11 TBeginEnd = class; 12 12 TBlock = class; 13 14 TDataType = (dtNone, dtString, dtBoolean, dtInteger, dtFloat, dtColor,15 dtTime, dtDate, dtDateTime, dtEnumeration, dtObject);16 17 { TField }18 19 TField = class20 Index: Integer;21 DataType: TDataType;22 Name: string;23 constructor Create(ADataType: TDataType; AName: string);24 end;25 26 TFields = class(TObjectList<TField>)27 end;28 29 { TSourceNode }30 31 TSourceNode = class32 private33 function GetFieldsCount: Integer; virtual;34 public35 Parent: TSourceNode;36 function GetField(Index: Integer): TField; virtual;37 procedure GetValue(Index: Integer; out Value); virtual;38 function GetValueInteger(Index: Integer): Integer;39 function GetValueString(Index: Integer): string;40 function GetValueBoolean(Index: Integer): Boolean;41 function GetValueObject(Index: Integer): TObject;42 function GetValueAsText(Index: Integer): string;43 procedure SetValue(Index: Integer; var Value); virtual;44 procedure SetValueInteger(Index: Integer; Value: Integer);45 procedure SetValueString(Index: Integer; Value: string);46 procedure SetValueBoolean(Index: Integer; Value: Boolean);47 procedure SetValueObject(Index: Integer; Value: TObject);48 function GetFields: TFields;49 property FieldsCount: Integer read GetFieldsCount;50 end;51 52 { TSourceNodeList }53 54 TSourceNodeList<T> = class(TSourceNode)55 private56 Parent: TSourceNode;57 function GetCount: Integer;58 function GetItem(Index: Integer): T;59 procedure SetItem(Index: Integer; AValue: T);60 public61 List: TObjectList<TSourceNode>;62 procedure Clear;63 function Add(AObject: T): Integer;64 constructor Create;65 destructor Destroy; override;66 property Items[Index: Integer]: T read GetItem write SetItem; default;67 property Count: Integer read GetCount;68 end;69 13 70 14 { TValue } … … 453 397 454 398 const 455 DataTypeStr: array[TDataType] of string = ('None', 'String', 'Boolean',456 'Integer', 'Float', 'Color', 'Time', 'Date', 'DateTime', 'Enumeration',457 'Reference');458 399 ExpressionOperatorText: array[TExpressionOperator] of string = ('', '+', 459 400 '-', '*', '/', 'div', 'mod', 'and', 'xor', 'or', 'shl', … … 471 412 resourcestring 472 413 SIndexError = 'Index error'; 473 SUnsupportedValueIndex = 'Unsupported value index %d';474 SUnsupportedDataType = 'Unsupported field value data type %s';475 SYes = 'Yes';476 SNo = 'No';477 414 478 415 function GetOperatorByName(Name: string): TExpressionOperator; … … 560 497 end; 561 498 562 { TField }563 564 constructor TField.Create(ADataType: TDataType; AName: string);565 begin566 DataType := ADataType;567 Name := AName;568 end;569 570 { TSourceNodeList }571 572 function TSourceNodeList<T>.GetCount: Integer;573 begin574 Result := List.Count;575 end;576 577 function TSourceNodeList<T>.GetItem(Index: Integer): T;578 begin579 Result := T(List[Index]);580 end;581 582 procedure TSourceNodeList<T>.SetItem(Index: Integer; AValue: T);583 begin584 List[Index] := AValue;585 end;586 587 procedure TSourceNodeList<T>.Clear;588 begin589 List.Clear;590 end;591 592 function TSourceNodeList<T>.Add(AObject: T): Integer;593 begin594 Result := List.Add(AObject);595 end;596 597 constructor TSourceNodeList<T>.Create;598 begin599 List := TObjectList<TSourceNode>.Create;600 end;601 602 destructor TSourceNodeList<T>.Destroy;603 begin604 FreeAndNil(List);605 inherited;606 end;607 608 499 { TVariable } 609 500 … … 666 557 FreeAndNil(Value); 667 558 inherited; 668 end;669 670 { TSourceNode }671 672 procedure TSourceNode.GetValue(Index: Integer; out Value);673 begin674 raise Exception.Create(Format(SUnsupportedValueIndex, [Index]));675 end;676 677 function TSourceNode.GetFieldsCount: Integer;678 begin679 Result := 0;680 end;681 682 function TSourceNode.GetField(Index: Integer): TField;683 begin684 Result := nil;685 raise Exception.Create(Format(SUnsupportedValueIndex, [Index]));686 end;687 688 procedure TSourceNode.SetValue(Index: Integer; var Value);689 begin690 raise Exception.Create(Format(SUnsupportedValueIndex, [Index]));691 end;692 693 function TSourceNode.GetValueInteger(Index: Integer): Integer;694 begin695 GetValue(Index, Result);696 end;697 698 function TSourceNode.GetValueString(Index: Integer): string;699 begin700 GetValue(Index, Result);701 end;702 703 function TSourceNode.GetValueBoolean(Index: Integer): Boolean;704 begin705 GetValue(Index, Result);706 end;707 708 function TSourceNode.GetValueObject(Index: Integer): TObject;709 begin710 GetValue(Index, Result);711 end;712 713 function TSourceNode.GetValueAsText(Index: Integer): string;714 var715 Field: TField;716 Item: TObject;717 begin718 Field := GetField(Index);719 try720 if Field.DataType = dtInteger then Result := IntToStr(GetValueInteger(Index))721 else if Field.DataType = dtString then Result := GetValueString(Index)722 //else if Field.DataType = dtEnumeration then Result := Field.EnumStates[Integer(GetValueEnumeration(Index))]723 else if Field.DataType = dtObject then begin724 Item := TObject(GetValueObject(Index));725 if Assigned(Item) then Result := Item.ClassName726 else Result := '';727 end else if Field.DataType = dtBoolean then begin728 if GetValueBoolean(Index) then Result := SYes else Result := SNo;729 end else730 raise Exception.Create(Format(SUnsupportedDataType, [DataTypeStr[Field.DataType]]));731 finally732 Field.Free;733 end;734 end;735 736 737 procedure TSourceNode.SetValueInteger(Index: Integer; Value: Integer);738 begin739 SetValue(Index, Value);740 end;741 742 procedure TSourceNode.SetValueString(Index: Integer; Value: string);743 begin744 SetValue(Index, Value);745 end;746 747 procedure TSourceNode.SetValueBoolean(Index: Integer; Value: Boolean);748 begin749 SetValue(Index, Value);750 end;751 752 procedure TSourceNode.SetValueObject(Index: Integer; Value: TObject);753 begin754 SetValue(Index, Value);755 end;756 757 function TSourceNode.GetFields: TFields;758 var759 I: Integer;760 begin761 Result := TFields.Create;762 for I := 0 to GetFieldsCount - 1 do763 Result.Add(GetField(I));764 559 end; 765 560 -
branches/xpascal/xpascal.lpi
r230 r231 85 85 </Item3> 86 86 </RequiredPackages> 87 <Units Count=" 19">87 <Units Count="20"> 88 88 <Unit0> 89 89 <Filename Value="xpascal.lpr"/> … … 177 177 <ResourceBaseClass Value="Form"/> 178 178 </Unit18> 179 <Unit19> 180 <Filename Value="SourceNode.pas"/> 181 <IsPartOfProject Value="True"/> 182 </Unit19> 179 183 </Units> 180 184 </ProjectOptions> -
branches/xpascal/xpascal.lpr
r230 r231 10 10 Forms, Parser, Tokenizer, Source, Executor, Interpreter, Generator, 11 11 FormMessages, FormSource, Optimizer, FormOutput, FormMain, 12 ParserPascal, Tests, FormConsole ;12 ParserPascal, Tests, FormConsole, SourceNode; 13 13 14 14 {$R *.res}
Note:
See TracChangeset
for help on using the changeset viewer.