uscripting.pas 76 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271
  1. // SPDX-License-Identifier: GPL-3.0-only
  2. unit UScripting;
  3. {$mode objfpc}{$H+}
  4. interface
  5. uses
  6. Classes, SysUtils, BGRABitmapTypes, UScriptType;
  7. type
  8. TVariableSet = class;
  9. TScriptResult = (srOk, srInvalidParameters, srCancelledByUser, srException, srFunctionNotDefined);
  10. function ScriptResultToStr(AResult: TScriptResult; AFunction: string): string;
  11. type
  12. TScriptFunction = function(AVars: TVariableSet): TScriptResult of object;
  13. TScriptVariableReference = record
  14. variableSet: TVariableSet;
  15. variableType: TScriptVariableType;
  16. variableIndex: NativeInt;
  17. end;
  18. { TVariableSet }
  19. TVariableSet = class
  20. private
  21. FScalars: array of TScalarVariable;
  22. FNbScalars: NativeInt;
  23. FStrings: array of record name: string; value: string; end;
  24. FNbStrings: NativeInt;
  25. FScalarLists: array of record
  26. name: string;
  27. varType: TScriptVariableType;
  28. list: pointer;
  29. size, count: NativeInt;
  30. end;
  31. FNbScalarLists: NativeInt;
  32. FBoolLists: array of record name: string; list: TBits; count: NativeInt; end;
  33. FNbBoolLists: NativeInt;
  34. FStrLists: array of record name: string; list: array of string; count: NativeInt; end;
  35. FNbStrLists: NativeInt;
  36. FSubsets: array of record name: string; value: TVariableSet; end;
  37. FNbSubsets: NativeInt;
  38. FFunctionName: string;
  39. function GetBooleanByName(const AName: string): boolean;
  40. function GetCount: NativeInt;
  41. function GetFloatByName(const AName: string): double;
  42. function GetGuidByName(const AName: string): TGuid;
  43. function GetIntegerByName(const AName: string): TScriptInteger;
  44. function GetPixelByName(const AName: string): TBGRAPixel;
  45. function GetPoint2DByName(const AName: string): TPointF;
  46. function GetPoint3DByName(const AName: string): TPoint3D;
  47. function GetStringByName(const AName: string): string;
  48. function GetSubsetByName(const AName: string): TVariableSet;
  49. function GetListByName(const AName: string): string;
  50. function GetVariablesAsString: string;
  51. function GetVarName(AIndex: integer): string;
  52. procedure SetBooleanByName(const AName: string; AValue: boolean);
  53. procedure SetFloatByName(const AName: string; AValue: double);
  54. procedure SetGuidByName(const AName: string; const AValue: TGuid);
  55. procedure SetIntegerByName(const AName: string; AValue: TScriptInteger);
  56. procedure SetListByName(const AName: string; AValue: string);
  57. procedure SetPixelByName(const AName: string; AValue: TBGRAPixel);
  58. procedure SetPoint2DByName(const AName: string; AValue: TPointF);
  59. procedure SetPoint3DByName(const AName: string; AValue: TPoint3D);
  60. procedure SetStringByName(const AName: string; AValue: string);
  61. procedure SetSubSetByName(const AName: string; AValue: TVariableSet);
  62. function GetStrListAsString(AIndex: NativeInt): string;
  63. function GetBoolListAsString(AIndex: NativeInt): string;
  64. function GetScalarListAsString(AIndex: NativeInt): string;
  65. function AddScalar(const AName: string; AType: TScriptVariableType): boolean;
  66. function AddScalarList(const AName: string; AType: TScriptVariableType): TScriptVariableReference;
  67. public
  68. FunctionRedirected, IgnoreResult: boolean;
  69. constructor Create(AFunctionName: string);
  70. constructor Create(AFunctionName: string; AVariablesAsString: string);
  71. function LoadFromVariablesAsString(AVariablesAsString: string): TInterpretationErrors;
  72. function Remove(const AName: string): boolean;
  73. function Remove(var ADest: TScriptVariableReference): boolean;
  74. destructor Destroy; override;
  75. function AddFloat(const AName: string; AValue: double): boolean;
  76. function AddInteger(const AName: string; AValue: TScriptInteger): boolean;
  77. function AddPoint(const AName: string; AValue: TPoint3D): boolean; overload;
  78. function AddPoint(const AName: string; AValue: TPointF): boolean; overload;
  79. function AddBoolean(const AName: string; AValue: boolean): boolean;
  80. function AddPixel(const AName: string; const AValue: TBGRAPixel): boolean;
  81. function AddString(const AName: string; AValue: string): boolean;
  82. function AddGuid(const AName: string; const AValue: TGuid): boolean;
  83. function AddSubset(const AName: string; AValue: TVariableSet): boolean;
  84. function AddSubset(const AName: string): TVariableSet;
  85. function AddList(const AName: string; AListExpr: string): TInterpretationErrors;
  86. function AddBooleanList(const AName: string): TScriptVariableReference;
  87. function AddIntegerList(const AName: string): TScriptVariableReference;
  88. function AddFloatList(const AName: string): TScriptVariableReference;
  89. function AddPointList(const AName: string): TScriptVariableReference;
  90. function AddPixelList(const AName: string): TScriptVariableReference;
  91. function AddStringList(const AName: string): TScriptVariableReference;
  92. function AddGuidList(const AName: string): TScriptVariableReference;
  93. function GetVariable(const AName: string): TScriptVariableReference;
  94. function IsDefined(const AName: string): boolean;
  95. class procedure ClearList(const ADest: TScriptVariableReference); static;
  96. class function AppendFloat(const ADest: TScriptVariableReference; AValue: double): boolean; overload; static;
  97. class function AssignFloat(const ADest: TScriptVariableReference; AValue: double): boolean; overload; static;
  98. class function AssignFloatAt(const ADest: TScriptVariableReference; AIndex: NativeInt; AValue: double): boolean; static;
  99. class function AppendInteger(const ADest: TScriptVariableReference; AValue: TScriptInteger): boolean; overload; static;
  100. class function AssignInteger(const ADest: TScriptVariableReference; AValue: TScriptInteger): boolean; overload; static;
  101. class function AssignIntegerAt(const ADest: TScriptVariableReference; AIndex: NativeInt; AValue: TScriptInteger): boolean; static;
  102. class function AppendPoint(const ADest: TScriptVariableReference; const AValue: TPoint3D): boolean; overload; static;
  103. class function AssignPoint(const ADest: TScriptVariableReference; const AValue: TPoint3D): boolean; overload; static;
  104. class function AssignPointAt(const ADest: TScriptVariableReference; AIndex: NativeInt; const AValue: TPoint3D): boolean; overload; static;
  105. class function AppendPoint(const ADest: TScriptVariableReference; const AValue: TPointF): boolean; overload; static;
  106. class function AssignPoint(const ADest: TScriptVariableReference; const AValue: TPointF): boolean; overload; static;
  107. class function AssignPointAt(const ADest: TScriptVariableReference; AIndex: NativeInt; const AValue: TPointF): boolean; overload; static;
  108. class function AppendBoolean(const ADest: TScriptVariableReference; AValue: boolean): boolean; overload; static;
  109. class function AssignBoolean(const ADest: TScriptVariableReference; AValue: boolean): boolean; overload; static;
  110. class function AppendString(const ADest: TScriptVariableReference; AValue: string): boolean; overload; static;
  111. class function AssignString(const ADest: TScriptVariableReference; AValue: string): boolean; overload; static;
  112. class function AppendGuid(const ADest: TScriptVariableReference; const AValue: TGuid): boolean; overload; static;
  113. class function AssignGuid(const ADest: TScriptVariableReference; const AValue: TGuid): boolean; overload; static;
  114. class function AppendPixel(const ADest: TScriptVariableReference; const AValue: TBGRAPixel): boolean; overload; static;
  115. class function AssignPixel(const ADest: TScriptVariableReference; const AValue: TBGRAPixel): boolean; overload; static;
  116. class function AssignList(const ADest: TScriptVariableReference; AListExpr: string): TInterpretationErrors; static;
  117. class function AssignVariable(const ADest, ASource: TScriptVariableReference): boolean; static;
  118. class function IsReferenceDefined(const AReference: TScriptVariableReference): boolean; static;
  119. class function IsList(const AReference: TScriptVariableReference): boolean; static;
  120. class function IsSubSet(const AReference: TScriptVariableReference): boolean; static;
  121. class function GetFloat(const ASource: TScriptVariableReference) : double; static;
  122. class function GetInteger(const ASource: TScriptVariableReference) : TScriptInteger; static;
  123. class function GetPoint2D(const ASource: TScriptVariableReference) : TPointF; static;
  124. class function GetPoint3D(const ASource: TScriptVariableReference) : TPoint3D; static;
  125. class function GetBoolean(const ASource: TScriptVariableReference) : boolean; static;
  126. class function GetString(const ASource: TScriptVariableReference) : string; static;
  127. class function GetGuid(const ASource: TScriptVariableReference) : TGuid; static;
  128. class function GetPixel(const ASource: TScriptVariableReference) : TBGRAPixel; static;
  129. class function GetSubset(const ASource: TScriptVariableReference) : TVariableSet; static;
  130. class function GetList(const ASource: TScriptVariableReference) : string; static;
  131. class function GetListCount(const ASource: TScriptVariableReference) : NativeInt; static;
  132. class function GetFloatAt(const ASource: TScriptVariableReference; AIndex: NativeInt) : double; static;
  133. class function GetIntegerAt(const ASource: TScriptVariableReference; AIndex: NativeInt) : TScriptInteger; static;
  134. class function GetPoint2DAt(const ASource: TScriptVariableReference; AIndex: NativeInt) : TPointF; static;
  135. class function GetPoint3DAt(const ASource: TScriptVariableReference; AIndex: NativeInt): TPoint3D; static;
  136. class function GetPoint3DAt(const ASource: TScriptVariableReference; AIndex: NativeInt; ADefaultZ: single): TPoint3D; static;
  137. class function GetBooleanAt(const ASource: TScriptVariableReference; AIndex: NativeInt) : boolean; static;
  138. class function GetStringAt(const ASource: TScriptVariableReference; AIndex: NativeInt) : string; static;
  139. class function GetGuidAt(const ASource: TScriptVariableReference; AIndex: NativeInt) : TGuid; static;
  140. class function GetPixelAt(const ASource: TScriptVariableReference; AIndex: NativeInt) : TBGRAPixel; static;
  141. class function RemoveAt(const ASource: TScriptVariableReference; AIndex: NativeInt) : boolean; static;
  142. function Duplicate: TVariableSet;
  143. function CopyValuesTo(ASet: TVariableSet): boolean;
  144. property FunctionName: string read FFunctionName;
  145. property Count: NativeInt read GetCount;
  146. property VariableName[AIndex: integer]: string read GetVarName;
  147. property VariablesAsString: string read GetVariablesAsString;
  148. property Floats[const AName: string]: double read GetFloatByName write SetFloatByName;
  149. property Integers[const AName: string]: TScriptInteger read GetIntegerByName write SetIntegerByName;
  150. property Points2D[const AName: string]: TPointF read GetPoint2DByName write SetPoint2DByName;
  151. property Points3D[const AName: string]: TPoint3D read GetPoint3DByName write SetPoint3DByName;
  152. property Booleans[const AName: string]: boolean read GetBooleanByName write SetBooleanByName;
  153. property Strings[const AName: string]: string read GetStringByName write SetStringByName;
  154. property Pixels[const AName: string]: TBGRAPixel read GetPixelByName write SetPixelByName;
  155. property Subsets[const AName: string]: TVariableSet read GetSubsetByName write SetSubSetByName;
  156. property Lists[const AName: string]: string read GetListByName write SetListByName;
  157. property Guids[const AName: string]: TGuid read GetGuidByName write SetGuidByName;
  158. end;
  159. { TScriptContext }
  160. TScriptContext = class
  161. private
  162. FScriptFunctions: array of record
  163. name: string;
  164. handler: TScriptFunction;
  165. end;
  166. FNbScriptFunctions: NativeInt;
  167. FRecording: boolean;
  168. FRecordingFunctionParameters: TVariableSet;
  169. FRecordedScript: string;
  170. FCallScriptFunctionLevel: NativeInt;
  171. FScriptFunctionExceptionHandler: TScriptFunctionExceptionHandler;
  172. function GetRecordingFunctionParameters: TVariableSet;
  173. procedure SetRecording(AValue: boolean);
  174. procedure ClearRecordedScript;
  175. public
  176. constructor Create;
  177. procedure RegisterScriptFunction(AName: string; AHandler: TScriptFunction; ARegister: boolean=True);
  178. procedure UnregisterScriptFunction(AName: string; AHandler: TScriptFunction);
  179. function GetScriptFunctionHandler(AName: string) : TScriptFunction;
  180. function CallScriptFunction(AName: string; ARedirection: boolean = false; AParameters: TVariableSet = nil) : TScriptResult; overload;
  181. function CallScriptFunction(AParameters: TVariableSet = nil; ARedirection: boolean = false) : TScriptResult; overload;
  182. property RecordingFunctionParameters: TVariableSet read GetRecordingFunctionParameters;
  183. property Recording: boolean read FRecording write SetRecording;
  184. property RecordedScript: string read FRecordedScript;
  185. property OnFunctionException: TScriptFunctionExceptionHandler read FScriptFunctionExceptionHandler write FScriptFunctionExceptionHandler;
  186. end;
  187. implementation
  188. uses Dialogs, UResourceStrings;
  189. function ScriptResultToStr(AResult: TScriptResult; AFunction: string): string;
  190. begin
  191. case AResult of
  192. srOk: result := rsOkay;
  193. srInvalidParameters: result := rsInvalidParameters;
  194. srCancelledByUser: result := rsCancelledByUser;
  195. srException: result := rsException;
  196. srFunctionNotDefined: result := StringReplace(rsFunctionNotDefined,'%1','"'+AFunction+'"',[]);
  197. else result := rsInternalError;
  198. end;
  199. end;
  200. { TScriptContext }
  201. procedure TScriptContext.SetRecording(AValue: boolean);
  202. begin
  203. if FRecording=AValue then Exit;
  204. FRecording:=AValue;
  205. if AValue = true then
  206. ClearRecordedScript;
  207. end;
  208. function TScriptContext.GetRecordingFunctionParameters: TVariableSet;
  209. begin
  210. result := FRecordingFunctionParameters;
  211. end;
  212. procedure TScriptContext.ClearRecordedScript;
  213. begin
  214. FRecordedScript := '';
  215. end;
  216. constructor TScriptContext.Create;
  217. begin
  218. FNbScriptFunctions := 0;
  219. FCallScriptFunctionLevel := 0;
  220. end;
  221. procedure TScriptContext.RegisterScriptFunction(AName: string;
  222. AHandler: TScriptFunction; ARegister: boolean=True);
  223. begin
  224. if not ARegister then
  225. begin
  226. UnregisterScriptFunction(AName, AHandler);
  227. exit;
  228. end;
  229. if length(FScriptFunctions) = FNbScriptFunctions then
  230. begin
  231. if length(FScriptFunctions) = 0 then setlength(FScriptFunctions,4)
  232. else setlength(FScriptFunctions, FNbScriptFunctions*2);
  233. end;
  234. FScriptFunctions[FNbScriptFunctions].name := AName;
  235. FScriptFunctions[FNbScriptFunctions].handler := AHandler;
  236. inc(FNbScriptFunctions);
  237. end;
  238. procedure TScriptContext.UnregisterScriptFunction(AName: string;
  239. AHandler: TScriptFunction);
  240. var i,j: NativeInt;
  241. begin
  242. for i := FNbScriptFunctions-1 downto 0 do
  243. if (CompareText(FScriptFunctions[i].name,AName) = 0) and
  244. (FScriptFunctions[i].handler = AHandler) then
  245. begin
  246. for j := i to FNbScriptFunctions-2 do
  247. FScriptFunctions[j] := FScriptFunctions[j+1];
  248. dec(FNbScriptFunctions);
  249. exit;
  250. end;
  251. end;
  252. function TScriptContext.GetScriptFunctionHandler(AName: string): TScriptFunction;
  253. var i: NativeInt;
  254. begin
  255. for i := FNbScriptFunctions-1 downto 0 do //get latests registered functions first
  256. if CompareText(FScriptFunctions[i].name,AName) = 0 then
  257. begin
  258. result := FScriptFunctions[i].handler;
  259. exit;
  260. end;
  261. result := nil;
  262. end;
  263. function TScriptContext.CallScriptFunction(AName: string; ARedirection: boolean = false; AParameters: TVariableSet = nil): TScriptResult;
  264. var f: TScriptFunction;
  265. v: TVariableSet;
  266. i: NativeInt;
  267. IsRecording: boolean;
  268. previousFunctionParameters, currentFunctionParameters: TVariableSet;
  269. begin
  270. for i := FNbScriptFunctions-1 downto 0 do //get latests registered functions first
  271. if CompareText(FScriptFunctions[i].name,AName) = 0 then
  272. begin
  273. IsRecording := Recording and ((FCallScriptFunctionLevel = 0) or (Assigned(FRecordingFunctionParameters) and ARedirection));
  274. f := FScriptFunctions[i].handler;
  275. if Assigned(AParameters) then v := AParameters else
  276. begin
  277. v := TVariableSet.Create(FScriptFunctions[i].name);
  278. v.IgnoreResult:= true;
  279. end;
  280. previousFunctionParameters := FRecordingFunctionParameters;
  281. if IsRecording then
  282. begin
  283. currentFunctionParameters := v.Duplicate;
  284. if Assigned(FRecordingFunctionParameters) then FRecordingFunctionParameters.FunctionRedirected := true;
  285. FRecordingFunctionParameters := currentFunctionParameters;
  286. end else
  287. FRecordingFunctionParameters := nil;
  288. inc(FCallScriptFunctionLevel);
  289. try
  290. result := f(v);
  291. except
  292. on ex:Exception do
  293. begin
  294. if Assigned(FScriptFunctionExceptionHandler) then FScriptFunctionExceptionHandler(AName, ex);
  295. result := srException;
  296. end;
  297. end;
  298. dec(FCallScriptFunctionLevel);
  299. if not Assigned(AParameters) then v.Free;
  300. FRecordingFunctionParameters := previousFunctionParameters;
  301. if IsRecording then
  302. begin
  303. if Recording and (result = srOk) and not currentFunctionParameters.FunctionRedirected then //if recording has not been interrupted
  304. begin
  305. FRecordedScript := FRecordedScript+FScriptFunctions[i].name;
  306. if currentFunctionParameters.Count <> 0 then
  307. FRecordedScript := FRecordedScript+' '+currentFunctionParameters.VariablesAsString;
  308. FRecordedScript:= FRecordedScript+LineEnding;
  309. end;
  310. currentFunctionParameters.Free;
  311. end;
  312. exit;
  313. end;
  314. result := srFunctionNotDefined
  315. end;
  316. function TScriptContext.CallScriptFunction(AParameters: TVariableSet;
  317. ARedirection: boolean): TScriptResult;
  318. begin
  319. result := CallScriptFunction(AParameters.FunctionName,ARedirection,AParameters);
  320. end;
  321. { TVariableSet }
  322. function TVariableSet.GetCount: NativeInt;
  323. var
  324. i: Integer;
  325. begin
  326. result := 0;
  327. for i := 0 to FNbScalars-1 do if FScalars[i].name <> '' then inc(result);
  328. for i := 0 to FNbStrings-1 do if FStrings[i].name <> '' then inc(result);
  329. for i := 0 to FNbBoolLists-1 do if FBoolLists[i].name <> '' then inc(result);
  330. for i := 0 to FNbScalarLists-1 do if FScalarLists[i].name <> '' then inc(result);
  331. for i := 0 to FNbStrLists-1 do if FStrLists[i].name <> '' then inc(result);
  332. for i := 0 to FNbSubsets-1 do if FSubsets[i].name <> '' then inc(result);
  333. end;
  334. function TVariableSet.GetBooleanByName(const AName: string): boolean;
  335. begin
  336. result := GetBoolean(GetVariable(AName));
  337. end;
  338. function TVariableSet.GetFloatByName(const AName: string): double;
  339. begin
  340. result := GetFloat(GetVariable(AName));
  341. end;
  342. function TVariableSet.GetGuidByName(const AName: string): TGuid;
  343. begin
  344. result := ScriptStrToGuid(Strings[AName]);
  345. end;
  346. function TVariableSet.GetIntegerByName(const AName: string): TScriptInteger;
  347. begin
  348. result := GetInteger(GetVariable(AName));
  349. end;
  350. function TVariableSet.GetPixelByName(const AName: string): TBGRAPixel;
  351. begin
  352. result := GetPixel(GetVariable(AName));
  353. end;
  354. function TVariableSet.GetPoint2DByName(const AName: string): TPointF;
  355. begin
  356. result := GetPoint2D(GetVariable(AName));
  357. end;
  358. function TVariableSet.GetPoint3DByName(const AName: string): TPoint3D;
  359. begin
  360. result := GetPoint3D(GetVariable(AName));
  361. end;
  362. function TVariableSet.GetStringByName(const AName: string): string;
  363. begin
  364. result := GetString(GetVariable(AName));
  365. end;
  366. function TVariableSet.GetSubsetByName(const AName: string): TVariableSet;
  367. begin
  368. result := GetSubset(GetVariable(AName));
  369. end;
  370. function TVariableSet.GetListByName(const AName: string): string;
  371. begin
  372. result := GetList(GetVariable(AName));
  373. end;
  374. function TVariableSet.GetVariablesAsString: string;
  375. var i: NativeInt;
  376. begin
  377. result := '';
  378. for i := 0 to FNbStrings-1 do
  379. begin
  380. if length(result)>0 then result := result+', ';
  381. result := result+FStrings[i].name+VariableDefinitionToken+' '+ScriptQuote(FStrings[i].value);
  382. end;
  383. for i := 0 to FNbScalars-1 do
  384. begin
  385. if length(result)>0 then result := result+', ';
  386. with FScalars[i] do
  387. result := result+name+VariableDefinitionToken+' '+ScalarToStr(varType, valueBytes);
  388. end;
  389. for i := 0 to FNbStrLists-1 do
  390. begin
  391. if length(result)>0 then result := result+', ';
  392. result := result+FStrLists[i].name+VariableDefinitionToken+' '+GetStrListAsString(i);
  393. end;
  394. for i := 0 to FNbScalarLists-1 do
  395. begin
  396. if length(result)>0 then result := result+', ';
  397. result := result+FScalarLists[i].name+VariableDefinitionToken+' '+GetScalarListAsString(i);
  398. end;
  399. for i := 0 to FNbBoolLists-1 do
  400. begin
  401. if length(result)>0 then result := result+', ';
  402. result := result+FBoolLists[i].name+VariableDefinitionToken+' '+GetBoolListAsString(i);
  403. end;
  404. for i := 0 to FNbSubsets-1 do
  405. begin
  406. if length(result)>0 then result := result+', ';
  407. result := result+FSubsets[i].name+VariableDefinitionToken+' { '+FSubsets[i].value.VariablesAsString+ ' }';
  408. end;
  409. end;
  410. function TVariableSet.GetVarName(AIndex: integer): string;
  411. var
  412. i: Integer;
  413. begin
  414. if AIndex < 0 then raise exception.Create('Index out of bounds');
  415. for i := 0 to FNbScalars-1 do
  416. if FScalars[i].name <> '' then
  417. begin
  418. if AIndex = 0 then exit(FScalars[i].name)
  419. else dec(AIndex);
  420. end;
  421. for i := 0 to FNbStrings-1 do
  422. if FStrings[i].name <> '' then
  423. begin
  424. if AIndex = 0 then exit(FStrings[i].name)
  425. else dec(AIndex);
  426. end;
  427. for i := 0 to FNbBoolLists-1 do
  428. if FBoolLists[i].name <> '' then
  429. begin
  430. if AIndex = 0 then exit(FBoolLists[i].name)
  431. else dec(AIndex);
  432. end;
  433. for i := 0 to FNbScalarLists-1 do
  434. if FScalarLists[i].name <> '' then
  435. begin
  436. if AIndex = 0 then exit(FScalarLists[i].name)
  437. else dec(AIndex);
  438. end;
  439. for i := 0 to FNbStrLists-1 do
  440. if FStrLists[i].name <> '' then
  441. begin
  442. if AIndex = 0 then exit(FStrLists[i].name)
  443. else dec(AIndex);
  444. end;
  445. for i := 0 to FNbSubsets-1 do
  446. if FSubsets[i].name <> '' then
  447. begin
  448. if AIndex = 0 then exit(FSubsets[i].name)
  449. else dec(AIndex);
  450. end;
  451. raise exception.Create('Index out of bounds');
  452. end;
  453. function TVariableSet.LoadFromVariablesAsString(AVariablesAsString: string
  454. ): TInterpretationErrors;
  455. var varName: string;
  456. procedure ParseSubset(var cur: integer; expr: string);
  457. var inSubset: integer;
  458. subsetStr: string;
  459. s: TVariableSet;
  460. start: integer;
  461. inQuote: char;
  462. escaping: boolean;
  463. begin
  464. if cur > length(expr) then exit;
  465. start := cur;
  466. inQuote := #0;
  467. inSubset := 0;
  468. escaping := true;
  469. repeat
  470. if inQuote <> #0 then
  471. begin
  472. if not escaping then
  473. begin
  474. if expr[cur] = inQuote then inQuote:= #0 else
  475. if expr[cur] = '\' then escaping := true;
  476. end else
  477. escaping := false;
  478. end else
  479. begin
  480. if expr[cur] = '{' then
  481. begin
  482. inc(inSubset);
  483. if inSubset = 1 then start := cur+1;
  484. end
  485. else if expr[cur] = '}' then
  486. begin
  487. dec(inSubset);
  488. if inSubset = 0 then break;
  489. end
  490. else if expr[cur] in StringDelimiters then inQuote:= expr[cur];
  491. end;
  492. inc(cur);
  493. until cur > length(expr);
  494. if inQuote <> #0 then result += [ieEndingQuoteNotFound];
  495. subsetStr := copy(expr,start,cur-start);
  496. s := TVariableSet.Create('');
  497. result += s.LoadFromVariablesAsString(subsetStr);
  498. AddSubSet(varName, s);
  499. if (cur <= length(expr)) and (expr[cur] = '}') then inc(cur);
  500. end;
  501. procedure ParseList(var cur: integer; expr: string);
  502. var inBracket: integer;
  503. listStr: string;
  504. start: integer;
  505. inQuote: char;
  506. escaping: boolean;
  507. begin
  508. if cur > length(expr) then exit;
  509. start := cur;
  510. inQuote := #0;
  511. inBracket := 0;
  512. escaping := false;
  513. repeat
  514. if inQuote <> #0 then
  515. begin
  516. if not escaping then
  517. begin
  518. if expr[cur] = inQuote then inQuote:= #0 else
  519. if expr[cur] = '\' then escaping := true;
  520. end else
  521. escaping := false;
  522. end else
  523. begin
  524. if expr[cur] in['(','['] then
  525. begin
  526. inc(inBracket);
  527. if inBracket = 1 then
  528. if expr[cur] <> '[' then result += [ieUnexpectedOpeningBracketKind];
  529. end
  530. else if expr[cur] in[']',')'] then
  531. begin
  532. dec(inBracket);
  533. if inBracket = 0 then
  534. begin
  535. if expr[cur] <> ']' then result += [ieUnexpectedClosingBracketKind];
  536. inc(cur);
  537. break;
  538. end;
  539. end
  540. else if expr[cur] in StringDelimiters then inQuote:= expr[cur];
  541. end;
  542. inc(cur);
  543. until cur > length(expr);
  544. if inQuote <> #0 then result += [ieEndingQuoteNotFound];
  545. listStr := copy(expr,start,cur-start);
  546. AddList(varName, listStr);
  547. end;
  548. var
  549. cur: integer;
  550. idxEq: integer;
  551. litteral: TParsedLitteral;
  552. begin
  553. result := [];
  554. idxEq := pos(VariableDefinitionToken,AVariablesAsString);
  555. while idxEq <> 0 do
  556. begin
  557. varName := trim(copy(AVariablesAsString,1,idxEq-1));
  558. if (length(varName)>=2) and (varName[1]='''') and (varName[length(varName)]='''') then
  559. varName := UnescapeString(Copy(varName,2,length(varName)-2));
  560. cur := idxEq+2;
  561. while (cur <= length(AVariablesAsString)) and (AVariablesAsString[cur] in IgnoredWhitespaces) do inc(cur);
  562. if (cur <= length(AVariablesAsString)) and (AVariablesAsString[cur]='{') then
  563. ParseSubset(cur,AVariablesAsString)
  564. else
  565. if (cur <= length(AVariablesAsString)) and (AVariablesAsString[cur]='[') then
  566. ParseList(cur,AVariablesAsString)
  567. else
  568. begin
  569. litteral:= ParseLitteral(cur,AVariablesAsString,result);
  570. case litteral.valueType of
  571. svtInteger: if not AddInteger(varName,litteral.valueInt) then result := result + [ieDuplicateIdentifier];
  572. svtFloat: if not AddFloat(varName,litteral.valueFloat) then result := result + [ieDuplicateIdentifier];
  573. svtPoint: if not AddPoint(varName,litteral.valuePoint) then result := result + [ieDuplicateIdentifier];
  574. svtString: if not AddString(varName, litteral.valueStr) then result := result + [ieDuplicateIdentifier];
  575. svtBoolean: if not AddBoolean(varName,litteral.valueBool) then result := result + [ieDuplicateIdentifier];
  576. svtPixel: if not AddPixel(varName,litteral.valuePixel) then result := result + [ieDuplicateIdentifier];
  577. end;
  578. end;
  579. if (cur < length(AVariablesAsString)) and (AVariablesAsString[cur] = ',') then inc(cur);
  580. delete(AVariablesAsString,1,cur-1);
  581. idxEq := pos(VariableDefinitionToken,AVariablesAsString);
  582. end;
  583. end;
  584. function TVariableSet.Remove(const AName: string): boolean;
  585. var
  586. v: TScriptVariableReference;
  587. begin
  588. v := GetVariable(AName);
  589. if not IsReferenceDefined(v) then result := false
  590. else result := Remove(v);
  591. end;
  592. function TVariableSet.Remove(var ADest: TScriptVariableReference): boolean;
  593. begin
  594. if ADest.variableType in ScriptScalarTypes then
  595. begin
  596. FScalars[ADest.variableIndex].name:= '';
  597. FScalars[ADest.variableIndex].varType:= svtUndefined;
  598. end else
  599. if ADest.variableType in ScriptScalarListTypes then
  600. begin
  601. FScalarLists[ADest.variableIndex].name:= '';
  602. FScalarLists[ADest.variableIndex].varType:= svtUndefined;
  603. FScalarLists[ADest.variableIndex].count := 0;
  604. FScalarLists[ADest.variableIndex].size := 0;
  605. ReallocMem(FScalarLists[ADest.variableIndex].list, 0);
  606. end else
  607. if ADest.variableType = svtString then
  608. begin
  609. FStrings[ADest.variableIndex].name:= '';
  610. FStrings[ADest.variableIndex].value:= '';
  611. end else
  612. if ADest.variableType = svtStrList then
  613. begin
  614. FStrLists[ADest.variableIndex].name:= '';
  615. FStrLists[ADest.variableIndex].list:= nil;
  616. FStrLists[ADest.variableIndex].count:= 0;
  617. end else
  618. if ADest.variableType = svtBoolList then
  619. begin
  620. FBoolLists[ADest.variableIndex].name:= '';
  621. FreeAndNil(FBoolLists[ADest.variableIndex].list);
  622. FBoolLists[ADest.variableIndex].count:= 0;
  623. end else
  624. if IsSubSet(ADest) then
  625. begin
  626. FSubsets[ADest.variableIndex].name:= '';
  627. FreeAndNil(FSubsets[ADest.variableIndex].value);
  628. end else
  629. exit(false);
  630. ADest.variableType:= svtUndefined;
  631. ADest.variableIndex:= -1;
  632. ADest.variableSet := nil;
  633. result := true;
  634. end;
  635. procedure TVariableSet.SetBooleanByName(const AName: string; AValue: boolean);
  636. var v: TScriptVariableReference;
  637. begin
  638. v := GetVariable(AName);
  639. if IsReferenceDefined(v) then AssignBoolean(v,AValue) else AddBoolean(AName,AValue);
  640. end;
  641. procedure TVariableSet.SetFloatByName(const AName: string; AValue: double);
  642. var v: TScriptVariableReference;
  643. begin
  644. v := GetVariable(AName);
  645. if IsReferenceDefined(v) then AssignFloat(v,AValue) else AddFloat(AName,AValue);
  646. end;
  647. procedure TVariableSet.SetGuidByName(const AName: string; const AValue: TGuid);
  648. var
  649. guidStr: String;
  650. begin
  651. guidStr := LowerCase(GUIDToString(AValue));
  652. if (length(guidStr)>0) and (guidStr[1]='{') and (guidStr[length(guidStr)]='}') then
  653. guidStr := copy(guidStr,2,length(guidStr)-2);
  654. Strings[AName] := guidStr;
  655. end;
  656. procedure TVariableSet.SetIntegerByName(const AName: string; AValue: TScriptInteger);
  657. var v: TScriptVariableReference;
  658. begin
  659. v := GetVariable(AName);
  660. if IsReferenceDefined(v) then AssignInteger(v,AValue) else AddInteger(AName,AValue);
  661. end;
  662. procedure TVariableSet.SetListByName(const AName: string; AValue: string);
  663. var v: TScriptVariableReference;
  664. begin
  665. v := GetVariable(AName);
  666. if IsReferenceDefined(v) then AssignList(v,AValue) else AddList(AName,AValue);
  667. end;
  668. procedure TVariableSet.SetPixelByName(const AName: string; AValue: TBGRAPixel);
  669. var v: TScriptVariableReference;
  670. begin
  671. v := GetVariable(AName);
  672. if IsReferenceDefined(v) then AssignPixel(v,AValue) else AddPixel(AName,AValue);
  673. end;
  674. procedure TVariableSet.SetPoint2DByName(const AName: string; AValue: TPointF);
  675. var v: TScriptVariableReference;
  676. begin
  677. v := GetVariable(AName);
  678. if IsReferenceDefined(v) then AssignPoint(v,AValue) else AddPoint(AName,AValue);
  679. end;
  680. procedure TVariableSet.SetPoint3DByName(const AName: string; AValue: TPoint3D);
  681. var v: TScriptVariableReference;
  682. begin
  683. v := GetVariable(AName);
  684. if IsReferenceDefined(v) then AssignPoint(v,AValue) else AddPoint(AName,AValue);
  685. end;
  686. procedure TVariableSet.SetStringByName(const AName: string; AValue: string);
  687. var v: TScriptVariableReference;
  688. begin
  689. v := GetVariable(AName);
  690. if IsReferenceDefined(v) then AssignString(v,AValue) else AddString(AName,AValue);
  691. end;
  692. procedure TVariableSet.SetSubSetByName(const AName: string; AValue: TVariableSet);
  693. var v: TScriptVariableReference;
  694. begin
  695. if not Assigned(AValue) then exit;
  696. v := GetVariable(AName);
  697. if IsReferenceDefined(v) then
  698. begin
  699. if v.variableType <> svtSubset then exit;
  700. AValue.CopyValuesTo(v.variableSet.FSubsets[v.variableIndex].value)
  701. end else AddSubset(AName,AValue.Duplicate);
  702. end;
  703. function TVariableSet.GetStrListAsString(AIndex: NativeInt): string;
  704. var j: NativeInt;
  705. begin
  706. if FStrLists[AIndex].count = 0 then result := EmptyListExpression[svtStrList] else
  707. begin
  708. result := '[';
  709. result := result + ScriptQuote(FStrLists[AIndex].list[0]);
  710. for j := 1 to FStrLists[AIndex].count-1 do
  711. result := result + ', ' + ScriptQuote(FStrLists[AIndex].list[j]);
  712. result := result+']';
  713. end;
  714. end;
  715. function TVariableSet.GetBoolListAsString(AIndex: NativeInt): string;
  716. var j: NativeInt;
  717. begin
  718. if FBoolLists[AIndex].count = 0 then result := EmptyListExpression[svtBoolList] else
  719. begin
  720. result := '[';
  721. result := result + BoolToStr(FBoolLists[AIndex].list[0],TrueToken,FalseToken);
  722. for j := 1 to FBoolLists[AIndex].count-1 do
  723. result := result + ', ' + BoolToStr(FBoolLists[AIndex].list[j],TrueToken,FalseToken);
  724. result := result+']';
  725. end;
  726. end;
  727. function TVariableSet.GetScalarListAsString(AIndex: NativeInt): string;
  728. var j: NativeInt; p: PByte;
  729. listType: TScriptVariableType;
  730. scalarSize: PtrInt;
  731. scalarType: TScriptVariableType;
  732. begin
  733. listType := FScalarLists[AIndex].varType;
  734. if FScalarLists[AIndex].count = 0 then result := EmptyListExpression[listType] else
  735. begin
  736. p := FScalarLists[AIndex].list;
  737. scalarSize := ScalarListElementSize[listType];
  738. scalarType := ListElementType[listType];
  739. result := '['+ScalarToStr(scalarType, p^);
  740. for j := 1 to FScalarLists[AIndex].count-1 do
  741. begin
  742. inc(p, scalarSize);
  743. result := result + ', ' + ScalarToStr(scalarType, p^);
  744. end;
  745. result := result+']';
  746. end;
  747. end;
  748. function TVariableSet.AddScalar(const AName: string; AType: TScriptVariableType
  749. ): boolean;
  750. begin
  751. if IsDefined(AName) or (AName = '') then
  752. begin
  753. result := false;
  754. exit;
  755. end;
  756. if length(FScalars) = FNbScalars then
  757. begin
  758. if length(FScalars) = 0 then setlength(FScalars,4)
  759. else setlength(FScalars, length(FScalars)*2);
  760. end;
  761. FScalars[FNbScalars].name := AName;
  762. FScalars[FNbScalars].varType := AType;
  763. inc(FNbScalars);
  764. result := true;
  765. end;
  766. function TVariableSet.AddScalarList(const AName: string;
  767. AType: TScriptVariableType): TScriptVariableReference;
  768. begin
  769. if IsDefined(AName) or (AName = '') then
  770. begin
  771. result.variableSet := nil;
  772. result.variableType := svtUndefined;
  773. result.variableIndex := -1;
  774. exit;
  775. end;
  776. if length(FScalarLists) = FNbScalarLists then
  777. begin
  778. if length(FScalarLists) = 0 then setlength(FScalarLists,4)
  779. else setlength(FScalarLists, length(FScalarLists)*2);
  780. end;
  781. FScalarLists[FNbScalarLists].name := AName;
  782. FScalarLists[FNbScalarLists].varType := AType;
  783. FScalarLists[FNbScalarLists].count := 0;
  784. FScalarLists[FNbScalarLists].list := nil;
  785. FScalarLists[FNbScalarLists].size := 0;
  786. result.variableSet := self;
  787. result.variableType := AType;
  788. result.variableIndex := FNbScalarLists;
  789. inc(FNbScalarLists);
  790. end;
  791. constructor TVariableSet.Create(AFunctionName: string);
  792. begin
  793. FFunctionName:= AFunctionName;
  794. FunctionRedirected:= false;
  795. end;
  796. constructor TVariableSet.Create(AFunctionName: string;
  797. AVariablesAsString: string);
  798. begin
  799. FFunctionName:= AFunctionName;
  800. FunctionRedirected:= false;
  801. LoadFromVariablesAsString(AVariablesAsString);
  802. end;
  803. destructor TVariableSet.Destroy;
  804. var i: NativeInt;
  805. begin
  806. for i := 0 to FNbSubsets-1 do
  807. FreeAndNil(FSubsets[i].value);
  808. for i := 0 to FNbBoolLists-1 do
  809. FreeAndNil(FBoolLists[i].list);
  810. for i := 0 to FNbScalarLists-1 do
  811. FreeMem(FScalarLists[i].list);
  812. inherited Destroy;
  813. end;
  814. function TVariableSet.AddFloat(const AName: string; AValue: double): boolean;
  815. begin
  816. result := AddScalar(AName, svtFloat);
  817. if result then FScalars[FNbScalars-1].valueFloat := AValue;
  818. end;
  819. function TVariableSet.AddInteger(const AName: string; AValue: TScriptInteger): boolean;
  820. begin
  821. result := AddScalar(AName, svtInteger);
  822. if result then FScalars[FNbScalars-1].valueInt := AValue;
  823. end;
  824. function TVariableSet.AddPoint(const AName: string; AValue: TPoint3D): boolean;
  825. begin
  826. result := AddScalar(AName, svtPoint);
  827. if result then FScalars[FNbScalars-1].valuePoint := AValue;
  828. end;
  829. function TVariableSet.AddPoint(const AName: string; AValue: TPointF): boolean;
  830. begin
  831. result := AddPoint(AName, Point3D(AValue.X, AValue.Y, EmptySingle));
  832. end;
  833. function TVariableSet.AddBoolean(const AName: string; AValue: boolean): boolean;
  834. begin
  835. result := AddScalar(AName, svtBoolean);
  836. if result then FScalars[FNbScalars-1].valueBool := AValue;
  837. end;
  838. function TVariableSet.AddPixel(const AName: string; const AValue: TBGRAPixel): boolean;
  839. begin
  840. result := AddScalar(AName, svtPixel);
  841. if result then FScalars[FNbScalars-1].valuePix := AValue;
  842. end;
  843. function TVariableSet.AddString(const AName: string; AValue: string): boolean;
  844. begin
  845. if IsDefined(AName) or (AName = '') then
  846. begin
  847. result := false;
  848. exit;
  849. end;
  850. if length(FStrings) = FNbStrings then
  851. begin
  852. if length(FStrings) = 0 then setlength(FStrings,4)
  853. else setlength(FStrings, length(FStrings)*2);
  854. end;
  855. FStrings[FNbStrings].name := AName;
  856. FStrings[FNbStrings].value := AValue;
  857. inc(FNbStrings);
  858. result := true;
  859. end;
  860. function TVariableSet.AddGuid(const AName: string; const AValue: TGuid): boolean;
  861. begin
  862. result := AddString(AName, ScriptGuidToStr(AValue));
  863. end;
  864. function TVariableSet.AddSubset(const AName: string; AValue: TVariableSet
  865. ): boolean;
  866. begin
  867. if IsDefined(AName) or (AName = '') then
  868. begin
  869. result := false;
  870. exit;
  871. end;
  872. if length(FSubsets) = FNbSubsets then
  873. begin
  874. if length(FSubsets) = 0 then setlength(FSubsets,4)
  875. else setlength(FSubsets, length(FSubsets)*2);
  876. end;
  877. FSubsets[FNbSubsets].name := AName;
  878. FSubsets[FNbSubsets].value := AValue;
  879. inc(FNbSubsets);
  880. result := true;
  881. end;
  882. function TVariableSet.AddSubset(const AName: string): TVariableSet;
  883. begin
  884. if IsDefined(AName) then
  885. result := nil else
  886. begin
  887. result := TVariableSet.Create('');
  888. AddSubset(AName,result);
  889. end;
  890. end;
  891. function TVariableSet.AddList(const AName: string; AListExpr: string): TInterpretationErrors;
  892. var listType: TScriptVariableType;
  893. ref: TScriptVariableReference;
  894. begin
  895. if IsDefined(AName) or (AName = '') then
  896. begin
  897. result := [ieDuplicateIdentifier];
  898. exit;
  899. end;
  900. listType := ParseListType(AListExpr);
  901. if listType = svtUndefined then
  902. begin
  903. result := [ieUnknownListType];
  904. exit;
  905. end;
  906. if listType in ScriptScalarListTypes then ref := AddScalarList(AName, listType) else
  907. case listType of
  908. svtBoolList: ref := AddBooleanList(AName);
  909. svtStrList: ref := AddStringList(AName);
  910. else
  911. raise exception.Create('Unknown list type');
  912. end;
  913. result := AssignList(ref, AListExpr);
  914. end;
  915. function TVariableSet.AddBooleanList(const AName: string
  916. ): TScriptVariableReference;
  917. begin
  918. if IsDefined(AName) or (AName = '') then
  919. begin
  920. result.variableSet := nil;
  921. result.variableType := svtUndefined;
  922. result.variableIndex := -1;
  923. exit;
  924. end;
  925. if length(FBoolLists) = FNbBoolLists then
  926. begin
  927. if length(FBoolLists) = 0 then setlength(FBoolLists,4)
  928. else setlength(FBoolLists, length(FBoolLists)*2);
  929. end;
  930. FBoolLists[FNbBoolLists].name := AName;
  931. FBoolLists[FNbBoolLists].list := TBits.Create;
  932. FBoolLists[FNbBoolLists].count := 0;
  933. result.variableSet := self;
  934. result.variableType := svtBoolList;
  935. result.variableIndex := FNbBoolLists;
  936. inc(FNbBoolLists);
  937. end;
  938. function TVariableSet.AddIntegerList(const AName: string
  939. ): TScriptVariableReference;
  940. begin
  941. result := AddScalarList(AName, svtIntList);
  942. end;
  943. function TVariableSet.AddFloatList(const AName: string
  944. ): TScriptVariableReference;
  945. begin
  946. result := AddScalarList(AName, svtFloatList);
  947. end;
  948. function TVariableSet.AddPointList(const AName: string
  949. ): TScriptVariableReference;
  950. begin
  951. result := AddScalarList(AName, svtPointList);
  952. end;
  953. function TVariableSet.AddPixelList(const AName: string
  954. ): TScriptVariableReference;
  955. begin
  956. result := AddScalarList(AName, svtPixList);
  957. end;
  958. function TVariableSet.AddStringList(const AName: string
  959. ): TScriptVariableReference;
  960. begin
  961. if IsDefined(AName) or (AName = '') then
  962. begin
  963. result.variableSet := nil;
  964. result.variableType := svtUndefined;
  965. result.variableIndex := -1;
  966. exit;
  967. end;
  968. if length(FStrLists) = FNbStrLists then
  969. begin
  970. if length(FStrLists) = 0 then setlength(FStrLists,4)
  971. else setlength(FStrLists, length(FStrLists)*2);
  972. end;
  973. FStrLists[FNbStrLists].name := AName;
  974. FStrLists[FNbStrLists].count := 0;
  975. result.variableSet := self;
  976. result.variableType := svtStrList;
  977. result.variableIndex := FNbStrLists;
  978. inc(FNbStrLists);
  979. end;
  980. function TVariableSet.AddGuidList(const AName: string
  981. ): TScriptVariableReference;
  982. begin
  983. result := AddStringList(AName);
  984. end;
  985. function TVariableSet.GetVariable(const AName: string): TScriptVariableReference;
  986. var i: NativeInt;
  987. begin
  988. if AName <> '' then
  989. begin
  990. for i := 0 to FNbScalars-1 do
  991. if CompareText(AName, FScalars[i].name)= 0 then
  992. begin
  993. result.variableSet := self;
  994. result.variableType := FScalars[i].varType;
  995. result.variableIndex := i;
  996. exit;
  997. end;
  998. for i := 0 to FNbStrLists-1 do
  999. if CompareText(AName, FStrLists[i].name)= 0 then
  1000. begin
  1001. result.variableSet := self;
  1002. result.variableType := svtStrList;
  1003. result.variableIndex := i;
  1004. exit;
  1005. end;
  1006. for i := 0 to FNbBoolLists-1 do
  1007. if CompareText(AName, FBoolLists[i].name)= 0 then
  1008. begin
  1009. result.variableSet := self;
  1010. result.variableType := svtBoolList;
  1011. result.variableIndex := i;
  1012. exit;
  1013. end;
  1014. for i := 0 to FNbScalarLists-1 do
  1015. if CompareText(AName, FScalarLists[i].name)= 0 then
  1016. begin
  1017. result.variableSet := self;
  1018. result.variableType := FScalarLists[i].varType;
  1019. result.variableIndex := i;
  1020. exit;
  1021. end;
  1022. for i := 0 to FNbStrings-1 do
  1023. if CompareText(AName, FStrings[i].name)= 0 then
  1024. begin
  1025. result.variableSet := self;
  1026. result.variableType := svtString;
  1027. result.variableIndex := i;
  1028. exit;
  1029. end;
  1030. for i := 0 to FNbSubsets-1 do
  1031. if CompareText(AName, FSubsets[i].name)= 0 then
  1032. begin
  1033. result.variableSet := self;
  1034. result.variableType := svtSubset;
  1035. result.variableIndex := i;
  1036. exit;
  1037. end;
  1038. end;
  1039. result.variableSet := nil;
  1040. result.variableType := svtUndefined;
  1041. result.variableIndex := -1;
  1042. end;
  1043. function TVariableSet.IsDefined(const AName: string): boolean;
  1044. begin
  1045. result := IsReferenceDefined(GetVariable(AName));
  1046. end;
  1047. class procedure TVariableSet.ClearList(const ADest: TScriptVariableReference);
  1048. begin
  1049. if ADest.variableSet <> nil then
  1050. begin
  1051. if ADest.variableType in ScriptScalarListTypes then
  1052. with ADest.variableSet.FScalarLists[ADest.variableIndex] do
  1053. begin
  1054. count := 0;
  1055. size := 0;
  1056. freemem(list);
  1057. list := nil;
  1058. end
  1059. else
  1060. case ADest.variableType of
  1061. svtBoolList: with ADest.variableSet.FBoolLists[ADest.variableIndex] do
  1062. begin count := 0; list.Size := 0; end;
  1063. svtStrList: with ADest.variableSet.FStrLists[ADest.variableIndex] do
  1064. begin count := 0; list := nil; end;
  1065. end;
  1066. end;
  1067. end;
  1068. class function TVariableSet.AppendFloat(const ADest: TScriptVariableReference;
  1069. AValue: double): boolean;
  1070. begin
  1071. result := false;
  1072. if ADest.variableSet = nil then exit;
  1073. case ADest.variableType of
  1074. svtFloatList:
  1075. with ADest.variableSet.FScalarLists[ADest.variableIndex] do
  1076. begin
  1077. if count = ListMaxLength then exit;
  1078. if size = count then
  1079. begin
  1080. if count = 0 then size := 4 else size := count*2;
  1081. ReAllocMem(list,size*sizeof(double));
  1082. end;
  1083. (PDouble(list)+count)^ := AValue;
  1084. inc(count);
  1085. result := true;
  1086. end;
  1087. svtStrList: result := AppendString(ADest, FloatToStrUS(AValue));
  1088. svtPixList: result := AppendPixel(ADest, FloatToPixel(AValue));
  1089. end;
  1090. end;
  1091. class function TVariableSet.AssignFloat(const ADest: TScriptVariableReference;
  1092. AValue: double): boolean;
  1093. begin
  1094. if ADest.variableSet = nil then
  1095. begin
  1096. result := false;
  1097. exit;
  1098. end;
  1099. case ADest.variableType of
  1100. svtFloat: ADest.variableSet.FScalars[ADest.variableIndex].valueFloat := AValue;
  1101. svtString: ADest.variableSet.FStrings[ADest.variableIndex].value := FloatToStrUS(AValue);
  1102. svtPixel: ADest.variableSet.FScalars[ADest.variableIndex].valuePix := FloatToPixel(AValue);
  1103. else
  1104. begin
  1105. result := false;
  1106. exit;
  1107. end;
  1108. end;
  1109. result := true;
  1110. end;
  1111. class function TVariableSet.AssignFloatAt(
  1112. const ADest: TScriptVariableReference; AIndex: NativeInt; AValue: double
  1113. ): boolean;
  1114. begin
  1115. result := false;
  1116. if (ADest.variableSet = nil) or (AIndex < 0) then exit;
  1117. if not (Adest.variableType in ScriptVariableListTypes) then exit;
  1118. if AIndex >= GetListCount(ADest) then exit;
  1119. case ADest.variableType of
  1120. svtFloatList: with ADest.variableSet.FScalarLists[ADest.variableIndex] do
  1121. (PDouble(list)+AIndex)^ := AValue;
  1122. svtStrList: with ADest.variableSet.FStrLists[ADest.variableIndex] do
  1123. list[AIndex] := FloatToStrUS(AValue);
  1124. svtPixList: with ADest.variableSet.FScalarLists[ADest.variableIndex] do
  1125. (PBGRAPixel(list)+AIndex)^ := FloatToPixel(AValue);
  1126. else exit;
  1127. end;
  1128. result := true;
  1129. end;
  1130. class function TVariableSet.AppendInteger(
  1131. const ADest: TScriptVariableReference; AValue: TScriptInteger): boolean;
  1132. begin
  1133. result := false;
  1134. if ADest.variableSet = nil then exit;
  1135. case ADest.variableType of
  1136. svtIntList:
  1137. with ADest.variableSet.FScalarLists[ADest.variableIndex] do
  1138. begin
  1139. if count = ListMaxLength then exit;
  1140. if size = count then
  1141. begin
  1142. if count = 0 then size := 4 else size := count*2;
  1143. ReAllocMem(list,size*sizeof(TScriptInteger));
  1144. end;
  1145. (PScriptInteger(list)+count)^ := AValue;
  1146. inc(count);
  1147. result := true;
  1148. end;
  1149. svtFloatList: result := AppendFloat(ADest, AValue);
  1150. svtStrList: result := AppendString(ADest, IntToStr(AValue));
  1151. svtPixList: result := AppendPixel(ADest, IntToPixel(AValue));
  1152. end;
  1153. end;
  1154. class function TVariableSet.AssignInteger(
  1155. const ADest: TScriptVariableReference; AValue: TScriptInteger): boolean;
  1156. begin
  1157. if ADest.variableSet = nil then
  1158. begin
  1159. result := false;
  1160. exit;
  1161. end;
  1162. case ADest.variableType of
  1163. svtInteger: ADest.variableSet.FScalars[ADest.variableIndex].valueInt := AValue;
  1164. svtFloat: ADest.variableSet.FScalars[ADest.variableIndex].valueFloat := AValue;
  1165. svtString: ADest.variableSet.FStrings[ADest.variableIndex].value := IntToStr(AValue);
  1166. svtPixel: ADest.variableSet.FScalars[ADest.variableIndex].valuePix := IntToPixel(AValue);
  1167. else
  1168. begin
  1169. result := false;
  1170. exit;
  1171. end;
  1172. end;
  1173. result := true;
  1174. end;
  1175. class function TVariableSet.AssignIntegerAt(
  1176. const ADest: TScriptVariableReference; AIndex: NativeInt; AValue: TScriptInteger
  1177. ): boolean;
  1178. begin
  1179. result := false;
  1180. if (ADest.variableSet = nil) or (AIndex < 0) then exit;
  1181. if not (Adest.variableType in ScriptVariableListTypes) then exit;
  1182. if AIndex >= GetListCount(ADest) then exit;
  1183. case ADest.variableType of
  1184. svtIntList: with ADest.variableSet.FScalarLists[ADest.variableIndex] do
  1185. (PScriptInteger(list)+AIndex)^ := AValue;
  1186. svtFloatList: with ADest.variableSet.FScalarLists[ADest.variableIndex] do
  1187. (PDouble(list)+AIndex)^ := AValue;
  1188. svtStrList: with ADest.variableSet.FStrLists[ADest.variableIndex] do
  1189. list[AIndex] := IntToStr(AValue);
  1190. svtPixList: with ADest.variableSet.FScalarLists[ADest.variableIndex] do
  1191. (PBGRAPixel(list)+AIndex)^ := IntToPixel(AValue);
  1192. else exit;
  1193. end;
  1194. result := true;
  1195. end;
  1196. class function TVariableSet.AppendPoint(const ADest: TScriptVariableReference;
  1197. const AValue: TPoint3D): boolean;
  1198. begin
  1199. result := false;
  1200. if ADest.variableSet = nil then exit;
  1201. case ADest.variableType of
  1202. svtPointList:
  1203. with ADest.variableSet.FScalarLists[ADest.variableIndex] do
  1204. begin
  1205. if count = ListMaxLength then exit;
  1206. if size = count then
  1207. begin
  1208. if count = 0 then size := 4 else size := count*2;
  1209. ReAllocMem(list,size*sizeof(TPoint3D));
  1210. end;
  1211. (PPoint3D(list)+count)^ := AValue;
  1212. inc(count);
  1213. result := true;
  1214. end;
  1215. svtStrList: result := AppendString(ADest, ScalarToStr(svtPoint, AValue));
  1216. end;
  1217. end;
  1218. class function TVariableSet.AssignPoint(const ADest: TScriptVariableReference;
  1219. const AValue: TPoint3D): boolean;
  1220. begin
  1221. if ADest.variableSet = nil then
  1222. begin
  1223. result := false;
  1224. exit;
  1225. end;
  1226. case ADest.variableType of
  1227. svtPoint: ADest.variableSet.FScalars[ADest.variableIndex].valuePoint := AValue;
  1228. svtString: ADest.variableSet.FStrings[ADest.variableIndex].value := ScalarToStr(svtPoint, AValue);
  1229. else
  1230. begin
  1231. result := false;
  1232. exit;
  1233. end;
  1234. end;
  1235. result := true;
  1236. end;
  1237. class function TVariableSet.AssignPointAt(
  1238. const ADest: TScriptVariableReference; AIndex: NativeInt;
  1239. const AValue: TPoint3D): boolean;
  1240. begin
  1241. result := false;
  1242. if (ADest.variableSet = nil) or (AIndex < 0) then exit;
  1243. if not (Adest.variableType in ScriptVariableListTypes) then exit;
  1244. if AIndex >= GetListCount(ADest) then exit;
  1245. case ADest.variableType of
  1246. svtPointList: with ADest.variableSet.FScalarLists[ADest.variableIndex] do
  1247. (PPoint3D(list)+AIndex)^ := AValue;
  1248. svtStrList: with ADest.variableSet.FStrLists[ADest.variableIndex] do
  1249. list[AIndex] := ScalarToStr(svtPoint, AValue);
  1250. else exit;
  1251. end;
  1252. result := true;
  1253. end;
  1254. class function TVariableSet.AppendPoint(const ADest: TScriptVariableReference;
  1255. const AValue: TPointF): boolean;
  1256. begin
  1257. result := AppendPoint(ADest, Point3D(AValue.X, AValue.y, EmptySingle));
  1258. end;
  1259. class function TVariableSet.AssignPoint(const ADest: TScriptVariableReference;
  1260. const AValue: TPointF): boolean;
  1261. begin
  1262. result := AssignPoint(ADest, Point3D(AValue.X, AValue.y, EmptySingle));
  1263. end;
  1264. class function TVariableSet.AssignPointAt(
  1265. const ADest: TScriptVariableReference; AIndex: NativeInt;
  1266. const AValue: TPointF): boolean;
  1267. begin
  1268. result := AssignPointAt(ADest, AIndex, Point3D(AValue.X, AValue.y, EmptySingle));
  1269. end;
  1270. class function TVariableSet.AppendBoolean(
  1271. const ADest: TScriptVariableReference; AValue: boolean): boolean;
  1272. begin
  1273. result := false;
  1274. if ADest.variableSet = nil then exit;
  1275. case ADest.variableType of
  1276. svtBoolList:
  1277. with ADest.variableSet.FBoolLists[ADest.variableIndex] do
  1278. begin
  1279. if count = ListMaxLength*8 then exit;
  1280. if list.Size = count then
  1281. begin
  1282. if count = 0 then list.Size := 4*8 else
  1283. list.Size := count*2;
  1284. end;
  1285. list.Bits[count] := AValue;
  1286. inc(count);
  1287. end;
  1288. svtPixList: if AValue then AppendPixel(ADest, BGRAWhite) else
  1289. AppendPixel(ADest, BGRABlack);
  1290. end;
  1291. result := true;
  1292. end;
  1293. class function TVariableSet.AssignBoolean(
  1294. const ADest: TScriptVariableReference; AValue: boolean): boolean;
  1295. begin
  1296. if ADest.variableSet = nil then
  1297. begin
  1298. result := false;
  1299. exit;
  1300. end;
  1301. case ADest.variableType of
  1302. svtBoolean: ADest.variableSet.FScalars[ADest.variableIndex].valueBool := AValue;
  1303. svtPixel:
  1304. begin
  1305. if AValue then ADest.variableSet.FScalars[ADest.variableIndex].valuePix := BGRAWhite else
  1306. ADest.variableSet.FScalars[ADest.variableIndex].valuePix := BGRABlack;
  1307. end;
  1308. else
  1309. begin
  1310. result := false;
  1311. exit;
  1312. end;
  1313. end;
  1314. result := true;
  1315. end;
  1316. class function TVariableSet.AppendString(const ADest: TScriptVariableReference;
  1317. AValue: string): boolean;
  1318. var
  1319. errPos: integer;
  1320. missing,error: boolean;
  1321. parsedInt: NativeInt;
  1322. parsedFloat: double;
  1323. parsedColor: TBGRAPixel;
  1324. begin
  1325. result := false;
  1326. if ADest.variableSet = nil then exit;
  1327. case ADest.variableType of
  1328. svtStrList:
  1329. with ADest.variableSet.FStrLists[ADest.variableIndex] do
  1330. begin
  1331. if count = ListMaxLength then exit;
  1332. if length(list) = count then
  1333. begin
  1334. if count = 0 then setlength(list,4) else
  1335. setlength(list,count*2);
  1336. end;
  1337. list[count] := AValue;
  1338. inc(count);
  1339. result := true;
  1340. end;
  1341. svtIntList:
  1342. begin
  1343. val(AValue, parsedInt, errPos);
  1344. if errPos <> 0 then exit;
  1345. result := AppendInteger(ADest, parsedInt);
  1346. end;
  1347. svtFloatList:
  1348. begin
  1349. val(AValue, parsedFloat, errPos);
  1350. if errPos <> 0 then exit;
  1351. result := AppendFloat(ADest, parsedFloat);
  1352. end;
  1353. svtPixList:
  1354. begin
  1355. parsedColor := BGRABlack;
  1356. TryStrToBGRA(AValue, parsedColor, missing, error);
  1357. if missing or error then exit;
  1358. result := AppendPixel(ADest, parsedColor);
  1359. end;
  1360. end;
  1361. end;
  1362. class function TVariableSet.AssignString(
  1363. const ADest: TScriptVariableReference; AValue: string): boolean;
  1364. var
  1365. errPos: integer;
  1366. error: boolean;
  1367. parsedInt: NativeInt;
  1368. parsedFloat: double;
  1369. parsedColor: TBGRAPixel;
  1370. begin
  1371. if ADest.variableSet = nil then
  1372. begin
  1373. result := false;
  1374. exit;
  1375. end;
  1376. case ADest.variableType of
  1377. svtString: ADest.variableSet.FStrings[ADest.variableIndex].value := AValue;
  1378. svtInteger:
  1379. begin
  1380. val(AValue, parsedInt, errPos);
  1381. if errPos = 0 then
  1382. ADest.variableSet.FScalars[ADest.variableIndex].valueInt := parsedInt
  1383. else
  1384. begin
  1385. result := false;
  1386. exit;
  1387. end;
  1388. end;
  1389. svtFloat:
  1390. begin
  1391. val(AValue, parsedFloat, errPos);
  1392. if errPos = 0 then
  1393. ADest.variableSet.FScalars[ADest.variableIndex].valueFloat := parsedFloat
  1394. else
  1395. begin
  1396. result := false;
  1397. exit;
  1398. end;
  1399. end;
  1400. svtPixel:
  1401. begin
  1402. parsedColor := PartialStrToBGRA(AValue, ADest.variableSet.FScalars[ADest.variableIndex].valuePix, error);
  1403. if error then
  1404. begin
  1405. result := false;
  1406. exit;
  1407. end;
  1408. ADest.variableSet.FScalars[ADest.variableIndex].valuePix := parsedColor;
  1409. end;
  1410. else
  1411. begin
  1412. result := false;
  1413. exit;
  1414. end;
  1415. end;
  1416. result := true;
  1417. end;
  1418. class function TVariableSet.AppendGuid(const ADest: TScriptVariableReference;
  1419. const AValue: TGuid): boolean;
  1420. begin
  1421. result := AppendString(ADest, ScriptGuidToStr(AValue));
  1422. end;
  1423. class function TVariableSet.AssignGuid(const ADest: TScriptVariableReference;
  1424. const AValue: TGuid): boolean;
  1425. begin
  1426. result := AssignString(ADest, ScriptGuidToStr(AValue));
  1427. end;
  1428. class function TVariableSet.AppendPixel(const ADest: TScriptVariableReference;
  1429. const AValue: TBGRAPixel): boolean;
  1430. begin
  1431. result := false;
  1432. if ADest.variableSet = nil then exit;
  1433. case ADest.variableType of
  1434. svtPixList:
  1435. with ADest.variableSet.FScalarLists[ADest.variableIndex] do
  1436. begin
  1437. if count = ListMaxLength then exit;
  1438. if size = count then
  1439. begin
  1440. if count = 0 then size := 4 else size := count*2;
  1441. ReAllocMem(list,size*sizeof(TBGRAPixel));
  1442. end;
  1443. (PBGRAPixel(list)+count)^ := AValue;
  1444. inc(count);
  1445. result := true;
  1446. end;
  1447. svtStrList: result := AppendString(ADest, BGRAToStr(AValue));
  1448. end;
  1449. end;
  1450. class function TVariableSet.AssignPixel(
  1451. const ADest: TScriptVariableReference; const AValue: TBGRAPixel
  1452. ): boolean;
  1453. begin
  1454. if ADest.variableSet = nil then
  1455. begin
  1456. result := false;
  1457. exit;
  1458. end;
  1459. case ADest.variableType of
  1460. svtPixel: ADest.variableSet.FScalars[ADest.variableIndex].valuePix := AValue;
  1461. svtString: ADest.variableSet.FStrings[ADest.variableIndex].value := BGRAToStr(AValue);
  1462. else
  1463. begin
  1464. result := false;
  1465. exit;
  1466. end;
  1467. end;
  1468. result := true;
  1469. end;
  1470. class function TVariableSet.AssignList(const ADest: TScriptVariableReference;
  1471. AListExpr: string): TInterpretationErrors;
  1472. var
  1473. tilde,expectingValue: boolean;
  1474. inQuote: char;
  1475. inPar: integer;
  1476. escaping: boolean;
  1477. start,cur: integer;
  1478. procedure AppendValue(AValue: string);
  1479. var cur: integer;
  1480. litteral: TParsedLitteral;
  1481. begin
  1482. if tilde then exit;
  1483. cur := 1;
  1484. litteral := ParseLitteral(cur,AValue, result);
  1485. case litteral.valueType of
  1486. svtBoolean: AppendBoolean(ADest, litteral.valueBool);
  1487. svtInteger: AppendInteger(ADest, litteral.valueInt);
  1488. svtFloat: AppendFloat(ADest, litteral.valueFloat);
  1489. svtPoint: AppendPoint(ADest, litteral.valuePoint);
  1490. svtString: AppendString(ADest, litteral.valueStr);
  1491. svtPixel: AppendPixel(ADest, litteral.valuePixel);
  1492. end;
  1493. end;
  1494. begin
  1495. ClearList(ADest);
  1496. result := [];
  1497. AListExpr:= trim(AListExpr);
  1498. if (length(AListExpr)>0) and (AListExpr[1]='[') then
  1499. begin
  1500. if not (AListExpr[length(AListExpr)] = ']') then
  1501. begin
  1502. result += [ieClosingBracketNotFound];
  1503. cur := 2;
  1504. end else
  1505. begin
  1506. AListExpr := copy(AListExpr,2,length(AListExpr)-2);
  1507. cur := 1;
  1508. end;
  1509. end else
  1510. cur := 1;
  1511. tilde := false;
  1512. inQuote:= #0;
  1513. inPar := 0;
  1514. escaping := false;
  1515. start := 0;
  1516. expectingValue := false;
  1517. while cur <= length(AListExpr) do
  1518. begin
  1519. if inQuote <> #0 then
  1520. begin
  1521. if not escaping then
  1522. begin
  1523. if AListExpr[cur]=inQuote then inQuote:= #0 else
  1524. if AListExpr[cur]='\' then escaping := true;
  1525. end else
  1526. escaping := false;
  1527. end else
  1528. if (start = 0) and (AListExpr[cur]='~') then tilde := true else
  1529. begin
  1530. if (start = 0) and not (AListExpr[cur] in IgnoredWhitespaces) then start := cur;
  1531. if AListExpr[cur] in StringDelimiters then inQuote:= AListExpr[cur] else
  1532. if AListExpr[cur] = '(' then inc(inPar) else
  1533. if AListExpr[cur] = ')' then
  1534. begin
  1535. if inPar > 0 then dec(inPar)
  1536. else include(result, ieTooManyClosingBrackets);
  1537. end else
  1538. if (AListExpr[cur]=',') and (inPar = 0) then
  1539. begin
  1540. if start = 0 then result += [ieMissingValue]
  1541. else
  1542. begin
  1543. AppendValue(copy(AListExpr,start,cur-start));
  1544. start := 0;
  1545. end;
  1546. tilde := false;
  1547. expectingValue := true;
  1548. end;
  1549. end;
  1550. inc(cur);
  1551. end;
  1552. if start <> 0 then AppendValue(copy(AListExpr,start,cur-start)) else
  1553. if expectingValue then result += [ieMissingValue]
  1554. end;
  1555. class function TVariableSet.AssignVariable(const ADest,
  1556. ASource: TScriptVariableReference): boolean;
  1557. var i,sourceCount: NativeInt;
  1558. begin
  1559. if ASource.variableSet = nil then
  1560. begin
  1561. result := false;
  1562. exit;
  1563. end;
  1564. if ADest.variableType in ScriptVariableListTypes then
  1565. begin
  1566. if not (ASource.variableType in ScriptVariableListTypes) then
  1567. begin
  1568. result := false;
  1569. exit;
  1570. end;
  1571. result := true;
  1572. ClearList(ADest);
  1573. sourceCount := GetListCount(ASource);
  1574. case ASource.variableType of
  1575. svtBoolList: for i := 0 to sourceCount-1 do AppendBoolean(ADest, GetBooleanAt(ASource,i));
  1576. svtIntList: for i := 0 to sourceCount-1 do AppendInteger(ADest, GetIntegerAt(ASource,i));
  1577. svtFloatList: for i := 0 to sourceCount-1 do AppendFloat(ADest, GetFloatAt(ASource,i));
  1578. svtPointList: for i := 0 to sourceCount-1 do AppendPoint(ADest, GetPoint3DAt(ASource,i));
  1579. svtPixList: for i := 0 to sourceCount-1 do AppendPixel(ADest, GetPixelAt(ASource,i));
  1580. svtStrList: for i := 0 to sourceCount-1 do AppendString(ADest, GetStringAt(ASource,i));
  1581. end;
  1582. end;
  1583. if ADest.variableType = ASource.variableType then //no conversion
  1584. begin
  1585. case ASource.variableType of
  1586. svtBoolean, svtFloat, svtInteger, svtPixel, svtPoint:
  1587. ADest.variableSet.FScalars[ADest.variableIndex].valueBytes := ASource.variableSet.FScalars[ASource.variableIndex].valueBytes;
  1588. svtString: ADest.variableSet.FStrings[ADest.variableIndex].value := ASource.variableSet.FStrings[ASource.variableIndex].value;
  1589. svtSubset: ADest.variableSet.FSubsets[ASource.variableIndex].value.CopyValuesTo(ASource.variableSet.FSubsets[ASource.variableIndex].value);
  1590. else
  1591. begin
  1592. result := false;
  1593. exit;
  1594. end;
  1595. end;
  1596. result := true;
  1597. exit;
  1598. end;
  1599. case ASource.variableType of
  1600. svtBoolean: AssignBoolean(ADest, ASource.variableSet.FScalars[ASource.variableIndex].valueBool);
  1601. svtFloat: AssignFloat(ADest, ASource.variableSet.FScalars[ASource.variableIndex].valueFloat);
  1602. svtInteger: AssignInteger(ADest, ASource.variableSet.FScalars[ASource.variableIndex].valueInt);
  1603. svtPoint: AssignPoint(ADest, ASource.variableSet.FScalars[ASource.variableIndex].valuePoint);
  1604. svtPixel: AssignPixel(ADest, ASource.variableSet.FScalars[ASource.variableIndex].valuePix);
  1605. svtString: AssignString(ADest, ASource.variableSet.FStrings[ASource.variableIndex].value);
  1606. else
  1607. begin
  1608. result := false;
  1609. exit;
  1610. end;
  1611. end;
  1612. result := true;
  1613. end;
  1614. class function TVariableSet.IsReferenceDefined(
  1615. const AReference: TScriptVariableReference): boolean;
  1616. begin
  1617. result := AReference.variableIndex <> -1;
  1618. end;
  1619. class function TVariableSet.IsList(const AReference: TScriptVariableReference
  1620. ): boolean;
  1621. begin
  1622. result := AReference.variableType in ScriptVariableListTypes;
  1623. end;
  1624. class function TVariableSet.IsSubSet(const AReference: TScriptVariableReference
  1625. ): boolean;
  1626. begin
  1627. result := AReference.variableType = svtSubset;
  1628. end;
  1629. class function TVariableSet.GetFloat(const ASource: TScriptVariableReference
  1630. ): double;
  1631. var {%H-}errPos: integer;
  1632. begin
  1633. if ASource.variableSet <> nil then
  1634. begin
  1635. case ASource.variableType of
  1636. svtFloat: begin
  1637. result := ASource.variableSet.FScalars[ASource.variableIndex].valueFloat;
  1638. exit;
  1639. end;
  1640. svtInteger: begin
  1641. result := ASource.variableSet.FScalars[ASource.variableIndex].valueInt;
  1642. exit;
  1643. end;
  1644. svtPixel: begin
  1645. result := PixelToInt(ASource.variableSet.FScalars[ASource.variableIndex].valuePix);
  1646. exit;
  1647. end;
  1648. svtBoolean: begin
  1649. result := integer(ASource.variableSet.FScalars[ASource.variableIndex].valueBool);
  1650. exit;
  1651. end;
  1652. svtString: begin
  1653. val(ASource.variableSet.FStrings[ASource.variableIndex].value, result, errPos);
  1654. exit;
  1655. end;
  1656. end;
  1657. end;
  1658. result := 0;
  1659. end;
  1660. class function TVariableSet.GetInteger(const ASource: TScriptVariableReference
  1661. ): TScriptInteger;
  1662. var {%H-}errPos: integer;
  1663. begin
  1664. if ASource.variableSet <> nil then
  1665. begin
  1666. case ASource.variableType of
  1667. svtInteger: begin
  1668. result := ASource.variableSet.FScalars[ASource.variableIndex].valueInt;
  1669. exit;
  1670. end;
  1671. svtFloat: begin
  1672. result := round(ASource.variableSet.FScalars[ASource.variableIndex].valueFloat);
  1673. exit;
  1674. end;
  1675. svtBoolean: begin
  1676. result := integer(ASource.variableSet.FScalars[ASource.variableIndex].valueBool);
  1677. exit;
  1678. end;
  1679. svtPixel: begin
  1680. result := PixelToInt(ASource.variableSet.FScalars[ASource.variableIndex].valuePix);
  1681. exit;
  1682. end;
  1683. svtString: begin
  1684. val(ASource.variableSet.FStrings[ASource.variableIndex].value, result, errPos);
  1685. exit;
  1686. end;
  1687. end;
  1688. end;
  1689. result := 0;
  1690. end;
  1691. class function TVariableSet.GetPoint2D(const ASource: TScriptVariableReference
  1692. ): TPointF;
  1693. begin
  1694. with GetPoint3D(ASource) do
  1695. result := PointF(x,y);
  1696. end;
  1697. class function TVariableSet.GetPoint3D(const ASource: TScriptVariableReference
  1698. ): TPoint3D;
  1699. begin
  1700. if ASource.variableSet <> nil then
  1701. begin
  1702. case ASource.variableType of
  1703. svtPoint: begin
  1704. result := ASource.variableSet.FScalars[ASource.variableIndex].valuePoint;
  1705. exit;
  1706. end;
  1707. end;
  1708. end;
  1709. result := Point3D(0,0,EmptySingle);
  1710. end;
  1711. class function TVariableSet.GetBoolean(const ASource: TScriptVariableReference
  1712. ): boolean;
  1713. begin
  1714. if ASource.variableSet <> nil then
  1715. begin
  1716. case ASource.variableType of
  1717. svtInteger: begin
  1718. result := ASource.variableSet.FScalars[ASource.variableIndex].valueInt<>0;
  1719. exit;
  1720. end;
  1721. svtBoolean: begin
  1722. result := ASource.variableSet.FScalars[ASource.variableIndex].valueBool;
  1723. exit;
  1724. end;
  1725. end;
  1726. end;
  1727. result := false;
  1728. end;
  1729. class function TVariableSet.GetString(const ASource: TScriptVariableReference): string;
  1730. begin
  1731. result := '';
  1732. if ASource.variableSet <> nil then
  1733. begin
  1734. if ASource.variableType in ScriptScalarTypes then
  1735. result := ScalarToStr(ASource.variableType, ASource.variableSet.FScalars[ASource.variableIndex].valueBytes)
  1736. else if ASource.variableType in ScriptScalarListTypes then
  1737. result := ASource.variableSet.GetScalarListAsString(ASource.variableIndex)
  1738. else
  1739. case ASource.variableType of
  1740. svtString: result := ASource.variableSet.FStrings[ASource.variableIndex].value;
  1741. svtBoolList: result := ASource.variableSet.GetBoolListAsString(ASource.variableIndex);
  1742. svtStrList: result := ASource.variableSet.GetStrListAsString(ASource.variableIndex);
  1743. end;
  1744. end;
  1745. end;
  1746. class function TVariableSet.GetGuid(const ASource: TScriptVariableReference
  1747. ): TGuid;
  1748. begin
  1749. result := ScriptStrToGuid(GetString(ASource));
  1750. end;
  1751. class function TVariableSet.GetPixel(const ASource: TScriptVariableReference): TBGRAPixel;
  1752. begin
  1753. if ASource.variableSet <> nil then
  1754. begin
  1755. case ASource.variableType of
  1756. svtPixel: begin
  1757. result := ASource.variableSet.FScalars[ASource.variableIndex].valuePix;
  1758. exit;
  1759. end;
  1760. svtInteger: begin
  1761. result := IntToPixel(ASource.variableSet.FScalars[ASource.variableIndex].valueInt);
  1762. exit;
  1763. end;
  1764. svtFloat: begin
  1765. result := FloatToPixel(ASource.variableSet.FScalars[ASource.variableIndex].valueFloat);
  1766. exit;
  1767. end;
  1768. svtBoolean: begin
  1769. if ASource.variableSet.FScalars[ASource.variableIndex].valueBool then
  1770. result := BGRAWhite else result := BGRABlack;
  1771. exit;
  1772. end;
  1773. svtString: begin
  1774. result := StrToBGRA(ASource.variableSet.FStrings[ASource.variableIndex].value);
  1775. exit;
  1776. end;
  1777. end;
  1778. end;
  1779. result := BGRAPixelTransparent;
  1780. end;
  1781. class function TVariableSet.GetSubset(const ASource: TScriptVariableReference
  1782. ): TVariableSet;
  1783. begin
  1784. if ASource.variableSet <> nil then
  1785. begin
  1786. if ASource.variableType = svtSubset then
  1787. begin
  1788. result := asource.variableSet.FSubsets[ASource.variableIndex].value;
  1789. exit;
  1790. end;
  1791. end;
  1792. result := nil;
  1793. end;
  1794. class function TVariableSet.GetList(const ASource: TScriptVariableReference
  1795. ): string;
  1796. begin
  1797. if ASource.variableSet <> nil then
  1798. begin
  1799. if ASource.variableType in ScriptScalarListTypes then
  1800. result := ASource.variableSet.GetScalarListAsString(ASource.variableIndex)
  1801. else
  1802. case ASource.variableType of
  1803. svtBoolList: result := ASource.variableSet.GetBoolListAsString(ASource.variableIndex);
  1804. svtStrList: result := ASource.variableSet.GetStrListAsString(ASource.variableIndex);
  1805. else
  1806. result := '';
  1807. end;
  1808. end;
  1809. end;
  1810. class function TVariableSet.GetListCount(const ASource: TScriptVariableReference
  1811. ): NativeInt;
  1812. begin
  1813. if ASource.variableSet <> nil then
  1814. begin
  1815. if ASource.variableType in ScriptScalarListTypes then
  1816. result := ASource.variableSet.FScalarLists[ASource.variableIndex].count
  1817. else
  1818. case ASource.variableType of
  1819. svtBoolList: result := ASource.variableSet.FBoolLists[ASource.variableIndex].count;
  1820. svtStrList: result := ASource.variableSet.FStrLists[ASource.variableIndex].count;
  1821. else
  1822. result := 0;
  1823. end;
  1824. end
  1825. else result := 0;
  1826. end;
  1827. class function TVariableSet.GetFloatAt(const ASource: TScriptVariableReference;
  1828. AIndex: NativeInt): double;
  1829. var {%H-}errPos: integer;
  1830. begin
  1831. result := 0;
  1832. if (ASource.variableSet = nil) or (AIndex < 0) then exit;
  1833. if not (ASource.variableType in ScriptVariableListTypes) then exit;
  1834. if ASource.variableType in ScriptScalarListTypes then
  1835. with ASource.variableSet.FScalarLists[ASource.variableIndex] do
  1836. begin
  1837. if AIndex >= count then exit;
  1838. case ASource.variableType of
  1839. svtFloatList: result := (PDouble(list)+AIndex)^;
  1840. svtIntList: result := (PScriptInteger(list)+AIndex)^;
  1841. end;
  1842. end else
  1843. if ASource.variableType = svtStrList then
  1844. with asource.variableSet.FStrLists[ASource.variableIndex] do
  1845. begin
  1846. if AIndex >= count then exit;
  1847. val(list[AIndex],result,errPos)
  1848. end;
  1849. end;
  1850. class function TVariableSet.GetIntegerAt(
  1851. const ASource: TScriptVariableReference; AIndex: NativeInt): TScriptInteger;
  1852. var {%H-}errPos: integer;
  1853. begin
  1854. result := 0;
  1855. if (ASource.variableSet = nil) or (AIndex < 0) then exit;
  1856. if not (ASource.variableType in ScriptVariableListTypes) then exit;
  1857. if ASource.variableType in ScriptScalarListTypes then
  1858. with ASource.variableSet.FScalarLists[ASource.variableIndex] do
  1859. begin
  1860. if AIndex >= count then exit;
  1861. case ASource.variableType of
  1862. svtIntList: result := (PScriptInteger(list)+AIndex)^;
  1863. svtFloatList: result := round((PDouble(list)+AIndex)^);
  1864. end;
  1865. end else
  1866. if ASource.variableType = svtStrList then
  1867. with asource.variableSet.FStrLists[ASource.variableIndex] do
  1868. begin
  1869. if AIndex >= count then exit;
  1870. val(list[AIndex],result,errPos)
  1871. end;
  1872. end;
  1873. class function TVariableSet.GetPoint2DAt(
  1874. const ASource: TScriptVariableReference; AIndex: NativeInt): TPointF;
  1875. var
  1876. result3D: TPoint3D;
  1877. begin
  1878. result3D := GetPoint3DAt(ASource, AIndex);
  1879. result := PointF(result3D.x, result3D.y);
  1880. end;
  1881. class function TVariableSet.GetPoint3DAt(
  1882. const ASource: TScriptVariableReference; AIndex: NativeInt): TPoint3D;
  1883. begin
  1884. result := GetPoint3DAt(ASource, AIndex, EmptySingle);
  1885. end;
  1886. class function TVariableSet.GetPoint3DAt(
  1887. const ASource: TScriptVariableReference; AIndex: NativeInt; ADefaultZ: single
  1888. ): TPoint3D;
  1889. begin
  1890. result := Point3D(0,0, ADefaultZ);
  1891. if (ASource.variableSet = nil) or (AIndex < 0) then exit;
  1892. if not (ASource.variableType in ScriptVariableListTypes) then exit;
  1893. if ASource.variableType in ScriptScalarListTypes then
  1894. with ASource.variableSet.FScalarLists[ASource.variableIndex] do
  1895. begin
  1896. if AIndex >= count then exit;
  1897. case ASource.variableType of
  1898. svtPointList: begin
  1899. result := (PPoint3D(list)+AIndex)^;
  1900. if result.z = EmptySingle then result.z := ADefaultZ;
  1901. end;
  1902. end;
  1903. end;
  1904. end;
  1905. class function TVariableSet.GetBooleanAt(
  1906. const ASource: TScriptVariableReference; AIndex: NativeInt): boolean;
  1907. begin
  1908. result := false;
  1909. if (ASource.variableSet = nil) or (AIndex < 0) then exit;
  1910. if not (ASource.variableType in ScriptVariableListTypes) then exit;
  1911. if ASource.variableType in ScriptScalarListTypes then
  1912. with ASource.variableSet.FScalarLists[ASource.variableIndex] do
  1913. begin
  1914. if AIndex >= count then exit;
  1915. case ASource.variableType of
  1916. svtIntList: result := (PScriptInteger(list)+AIndex)^ <> 0;
  1917. end;
  1918. end else
  1919. if ASource.variableType = svtBoolList then
  1920. with asource.variableSet.FBoolLists[ASource.variableIndex] do
  1921. begin
  1922. if AIndex >= count then exit;
  1923. result := list.Bits[AIndex];
  1924. end;
  1925. end;
  1926. class function TVariableSet.GetStringAt(
  1927. const ASource: TScriptVariableReference; AIndex: NativeInt): string;
  1928. begin
  1929. result := '';
  1930. if (ASource.variableSet = nil) or (AIndex < 0) then exit;
  1931. if not (ASource.variableType in ScriptVariableListTypes) then exit;
  1932. if ASource.variableType in ScriptScalarListTypes then
  1933. with ASource.variableSet.FScalarLists[ASource.variableIndex] do
  1934. begin
  1935. if AIndex >= count then exit;
  1936. case ASource.variableType of
  1937. svtPixList: result := BGRAToStr((PBGRAPixel(list)+AIndex)^);
  1938. svtIntList: result := IntToStr((PScriptInteger(list)+AIndex)^);
  1939. end;
  1940. end else
  1941. if ASource.variableType = svtStrList then
  1942. with asource.variableSet.FStrLists[ASource.variableIndex] do
  1943. begin
  1944. if AIndex >= count then exit;
  1945. result := list[AIndex];
  1946. end;
  1947. end;
  1948. class function TVariableSet.GetGuidAt(const ASource: TScriptVariableReference;
  1949. AIndex: NativeInt): TGuid;
  1950. begin
  1951. result := ScriptStrToGuid(GetStringAt(ASource, AIndex));
  1952. end;
  1953. class function TVariableSet.GetPixelAt(const ASource: TScriptVariableReference;
  1954. AIndex: NativeInt): TBGRAPixel;
  1955. begin
  1956. result := BGRAPixelTransparent;
  1957. if (ASource.variableSet = nil) or (AIndex < 0) then exit;
  1958. if not (ASource.variableType in ScriptVariableListTypes) then exit;
  1959. if ASource.variableType in ScriptScalarListTypes then
  1960. with ASource.variableSet.FScalarLists[ASource.variableIndex] do
  1961. begin
  1962. if AIndex >= count then exit;
  1963. case ASource.variableType of
  1964. svtPixList: result := (PBGRAPixel(list)+AIndex)^;
  1965. svtIntList: result := IntToPixel((PScriptInteger(list)+AIndex)^);
  1966. svtFloatList: result := FloatToPixel((PDouble(list)+AIndex)^);
  1967. end;
  1968. end else
  1969. if ASource.variableType = svtStrList then
  1970. with asource.variableSet.FStrLists[ASource.variableIndex] do
  1971. begin
  1972. if AIndex >= count then exit;
  1973. result := StrToBGRA(list[AIndex]);
  1974. end;
  1975. if ASource.variableType = svtBoolList then
  1976. with asource.variableSet.FBoolLists[ASource.variableIndex] do
  1977. begin
  1978. if AIndex >= count then exit;
  1979. if list.Bits[AIndex] then result := BGRAWhite else result := BGRABlack;
  1980. end;
  1981. end;
  1982. class function TVariableSet.RemoveAt(const ASource: TScriptVariableReference;
  1983. AIndex: NativeInt): boolean;
  1984. var i,listCount,elementSize: NativeInt;
  1985. begin
  1986. result := false;
  1987. if (ASource.variableSet = nil) or (AIndex < 0) then exit;
  1988. if not (ASource.variableType in ScriptVariableListTypes) then exit;
  1989. listCount := GetListCount(ASource);
  1990. if AIndex >= listCount then exit;
  1991. if ASource.variableType in ScriptScalarListTypes then
  1992. with ASource.variableSet.FScalarLists[ASource.variableIndex] do
  1993. begin
  1994. elementSize:= ScalarListElementSize[varType];
  1995. Move((pbyte(list)+(AIndex+1)*elementSize)^,(pbyte(list)+AIndex*elementSize)^,(listCount-AIndex-1)*elementSize);
  1996. dec(count);
  1997. result := true;
  1998. end else
  1999. case ASource.variableType of
  2000. svtBoolList: with ASource.variableSet.FBoolLists[ASource.variableIndex] do
  2001. begin
  2002. for i := AIndex to listCount-2 do
  2003. list.Bits[i] := list.Bits[i+1];
  2004. dec(count);
  2005. result := true;
  2006. end;
  2007. svtStrList: with ASource.variableSet.FStrLists[ASource.variableIndex] do
  2008. begin
  2009. for i := AIndex to listCount-2 do
  2010. list[i] := list[i+1];
  2011. list[listCount-1] := '';
  2012. dec(count);
  2013. result := true;
  2014. end;
  2015. end;
  2016. end;
  2017. function TVariableSet.Duplicate: TVariableSet;
  2018. var i: NativeInt;
  2019. v,w: TScriptVariableReference;
  2020. begin
  2021. result := TVariableSet.Create(FunctionName);
  2022. setlength(result.FScalars, FNbScalars);
  2023. result.FNbScalars := FNbScalars;
  2024. for i := 0 to FNbScalars-1 do result.FScalars[i] := FScalars[i];
  2025. setlength(result.FStrings, length(FStrings));
  2026. result.FNbStrings := FNbStrings;
  2027. for i := 0 to FNbStrings-1 do result.FStrings[i] := FStrings[i];
  2028. w.variableSet := self;
  2029. for i := 0 to FNbStrLists-1 do
  2030. begin
  2031. v := result.AddStringList(FStrLists[i].name);
  2032. w.variableIndex := i;
  2033. w.variableType := svtStrList;
  2034. AssignVariable(v,w);
  2035. end;
  2036. for i := 0 to FNbBoolLists-1 do
  2037. begin
  2038. v := result.AddBooleanList(FBoolLists[i].name);
  2039. w.variableIndex := i;
  2040. w.variableType := svtBoolList;
  2041. AssignVariable(v,w);
  2042. end;
  2043. for i := 0 to FNbScalarLists-1 do
  2044. begin
  2045. v := result.AddScalarList(FScalarLists[i].name,FScalarLists[i].varType);
  2046. w.variableIndex := i;
  2047. w.variableType := FScalarLists[i].varType;
  2048. AssignVariable(v,w);
  2049. end;
  2050. setlength(result.FSubsets, length(FSubsets));
  2051. result.FNbSubsets := FNbSubsets;
  2052. for i := 0 to FNbSubsets-1 do
  2053. begin
  2054. result.FSubsets[i].name := FSubsets[i].name;
  2055. result.FSubsets[i].value := FSubsets[i].value.Duplicate;
  2056. end;
  2057. end;
  2058. function TVariableSet.CopyValuesTo(ASet: TVariableSet): boolean;
  2059. var i: NativeInt;
  2060. v,w: TScriptVariableReference;
  2061. begin
  2062. result := true;
  2063. if not Assigned(ASet) then exit;
  2064. w.variableSet := self;
  2065. for i := 0 to FNbScalars-1 do
  2066. begin
  2067. v := ASet.GetVariable(FScalars[i].name);
  2068. if not IsReferenceDefined(v) then
  2069. begin
  2070. if length(ASet.FScalars) = ASet.FNbScalars then
  2071. begin
  2072. if length(ASet.FScalars) = 0 then
  2073. setlength(ASet.FScalars,4)
  2074. else
  2075. setlength(ASet.FScalars, length(ASet.FScalars)*2);
  2076. end;
  2077. ASet.FScalars[ASet.FNbScalars] := FScalars[i];
  2078. inc(ASet.FNbScalars);
  2079. end else
  2080. begin
  2081. w.variableIndex := i;
  2082. w.variableType := FScalars[i].varType;
  2083. if not AssignVariable(v,w) then result := false;
  2084. end;
  2085. end;
  2086. for i := 0 to FNbStrings-1 do ASet.Strings[FStrings[i].name] := FStrings[i].value;
  2087. for i := 0 to FNbSubsets-1 do ASet.Subsets[FSubsets[i].name] := FSubsets[i].value;
  2088. for i := 0 to FNbStrLists-1 do
  2089. begin
  2090. v := ASet.GetVariable(FStrLists[i].name);
  2091. if not IsReferenceDefined(v) then v := ASet.AddStringList(FStrLists[i].name);
  2092. w.variableIndex := i;
  2093. w.variableType := svtStrList;
  2094. if not AssignVariable(v,w) then result := false;
  2095. end;
  2096. for i := 0 to FNbBoolLists-1 do
  2097. begin
  2098. v := ASet.GetVariable(FBoolLists[i].name);
  2099. if not IsReferenceDefined(v) then v := ASet.AddBooleanList(FBoolLists[i].name);
  2100. w.variableIndex := i;
  2101. w.variableType := svtBoolList;
  2102. if not AssignVariable(v,w) then result := false;
  2103. end;
  2104. for i := 0 to FNbScalarLists-1 do
  2105. begin
  2106. v := ASet.GetVariable(FScalarLists[i].name);
  2107. if not IsReferenceDefined(v) then v := ASet.AddScalarList(FScalarLists[i].name,FScalarLists[i].varType);
  2108. w.variableIndex := i;
  2109. w.variableType := FScalarLists[i].varType;
  2110. if not AssignVariable(v,w) then result := false;
  2111. end;
  2112. end;
  2113. (* var s: TVariableSet;
  2114. initialization
  2115. s:=TVariableSet.Create('','a: 1, b: {c: "Hello", d: 35.00, L1: [1,4,9]}, b2: {c: "World", d: 0, d2: 12, L1: [0.0], L2: [~""]}, e: #ff00ff');
  2116. ShowMessage(s.VariablesAsString);
  2117. s.AddList('L0','["alpha","beta","gamma"]');
  2118. ShowMessage('add L0: ' + s.VariablesAsString);
  2119. s.Subsets['b2'] := s.Subsets['b'];
  2120. s.Subsets['b3'] := s.Subsets['b'];
  2121. ShowMessage('set b2 and b3: ' + s.VariablesAsString);
  2122. s.AssignList(s.GetVariable('L0'),'[1,2,3,4]');
  2123. ShowMessage('set L0: ' + s.VariablesAsString);
  2124. s.free; *)
  2125. end.