GXS.VectorLists.pas 85 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366
  1. //
  2. // The graphics engine GXScene https://github.com/glscene
  3. //
  4. unit GXS.VectorLists;
  5. (* Misc. lists of vectors and entities *)
  6. interface
  7. {$I GLScene.Defines.inc}
  8. uses
  9. System.Classes,
  10. System.SysUtils,
  11. GLScene.VectorTypes,
  12. GLScene.VectorGeometry,
  13. GXS.PersistentClasses;
  14. type
  15. TBaseListOption = (bloExternalMemory, bloSetCountResetsMemory);
  16. TBaseListOptions = set of TBaseListOption;
  17. // Base class for lists, introduces common behaviours.
  18. TgxBaseList = class(TgxPersistentObject)
  19. private
  20. FCount: Integer;
  21. FCapacity: Integer;
  22. FGrowthDelta: Integer;
  23. FBufferItem: PByteArray;
  24. FOptions: TBaseListOptions;
  25. FRevision: LongWord;
  26. FTagString: string;
  27. protected
  28. // The base list pointer (untyped)
  29. FBaseList: PByteArray;
  30. // Must be defined by all subclasses in their constructor(s)
  31. FItemSize: Integer;
  32. procedure SetCount(Val: Integer);
  33. (*Only function where list may be alloc'ed & freed.
  34. Resizes the array pointed by FBaseList, adjust the subclass's
  35. typed pointer accordingly if any. *)
  36. procedure SetCapacity(NewCapacity: Integer); virtual;
  37. function BufferItem: PByteArray;
  38. function GetSetCountResetsMemory: Boolean;
  39. procedure SetSetCountResetsMemory(const Val: Boolean);
  40. // Borland-style persistency support.
  41. procedure ReadItemsData(AReader : TReader); virtual;
  42. procedure WriteItemsData(AWriter : TWriter); virtual;
  43. procedure DefineProperties(AFiler: TFiler); override;
  44. public
  45. constructor Create; override;
  46. destructor Destroy; override;
  47. procedure Assign(Src: TPersistent); override;
  48. procedure WriteToFiler(writer: TgxVirtualWriter); override;
  49. procedure ReadFromFiler(reader: TgxVirtualReader); override;
  50. procedure AddNulls(nbVals: Cardinal);
  51. procedure InsertNulls(Index: Integer; nbVals: Cardinal);
  52. procedure AdjustCapacityToAtLeast(const size: Integer);
  53. function DataSize: Integer;
  54. (* Tell the list to use the specified range instead of its own.
  55. rangeCapacity should be expressed in bytes.
  56. The allocated memory is NOT managed by the list, current content
  57. if copied to the location, if the capacity is later changed, regular
  58. memory will be allocated, and the specified range no longer used. *)
  59. procedure UseMemory(rangeStart: Pointer; rangeCapacity: Integer);
  60. // Empties the list without altering capacity.
  61. procedure Flush;
  62. // Empties the list and release.
  63. procedure Clear;
  64. procedure Delete(Index: Integer);
  65. procedure DeleteItems(Index: Integer; nbVals: Cardinal);
  66. procedure Exchange(index1, index2: Integer);
  67. procedure Move(curIndex, newIndex: Integer);
  68. procedure Reverse;
  69. // Nb of items in the list. When assigning a Count, added items are reset to zero.
  70. property Count: Integer read FCount write SetCount;
  71. // Current list capacity. Not persistent.
  72. property Capacity: Integer read FCapacity write SetCapacity;
  73. // List growth granularity. Not persistent.
  74. property GrowthDelta: Integer read FGrowthDelta write FGrowthDelta;
  75. (* If true (default value) adjusting count will reset added values.
  76. Switching this option to true will turn off this memory reset,
  77. which can improve performance is that having empty values isn't required. *)
  78. property SetCountResetsMemory: Boolean read GetSetCountResetsMemory write SetSetCountResetsMemory;
  79. property TagString: string read FTagString write FTagString;
  80. // Increase by one after every content changes.
  81. property Revision: LongWord read FRevision write FRevision;
  82. end;
  83. // Base class for vector lists, introduces common behaviours.
  84. TgxBaseVectorList = class(TgxBaseList)
  85. protected
  86. function GetItemAddress(Index: Integer): PFloatArray;
  87. public
  88. procedure WriteToFiler(writer: TgxVirtualWriter); override;
  89. procedure ReadFromFiler(reader: TgxVirtualReader); override;
  90. procedure GetExtents(out min, max: TAffineVector); virtual;
  91. function Sum: TAffineVector; virtual;
  92. procedure Normalize; virtual;
  93. function MaxSpacing(list2: TgxBaseVectorList): Single; virtual;
  94. procedure Translate(const delta: TAffineVector); overload; virtual;
  95. procedure Translate(const delta: TgxBaseVectorList); overload; virtual;
  96. procedure TranslateInv(const delta: TgxBaseVectorList); overload; virtual;
  97. (* Replace content of the list with lerp results between the two given lists.
  98. Note: you can't Lerp with Self!!! *)
  99. procedure Lerp(const list1, list2: TgxBaseVectorList; lerpFactor: Single); virtual; abstract;
  100. (* Replace content of the list with angle lerp between the two given lists.
  101. Note: you can't Lerp with Self!!! *)
  102. procedure AngleLerp(const list1, list2: TgxBaseVectorList; lerpFactor: Single);
  103. procedure AngleCombine(const list1: TgxBaseVectorList; intensity: Single);
  104. (* Linear combination of Self with another list.
  105. Self[i]:=Self[i]+list2[i]*factor *)
  106. procedure Combine(const list2: TgxBaseVectorList; factor: Single); virtual;
  107. property ItemAddress[Index: Integer]: PFloatArray read GetItemAddress;
  108. end;
  109. (* A list of TAffineVector.
  110. Similar to TList, but using TAffineVector as items.
  111. The list has stack-like push/pop methods. *)
  112. TgxAffineVectorList = class(TgxBaseVectorList)
  113. private
  114. FList: PAffineVectorArray;
  115. protected
  116. function Get(Index: Integer): TAffineVector;
  117. procedure Put(Index: Integer; const item: TAffineVector);
  118. procedure SetCapacity(NewCapacity: Integer); override;
  119. public
  120. constructor Create; override;
  121. procedure Assign(Src: TPersistent); override;
  122. function Add(const item: TAffineVector): Integer; overload;
  123. function Add(const item: TVector4f): Integer; overload;
  124. procedure Add(const i1, i2: TAffineVector); overload;
  125. procedure Add(const i1, i2, i3: TAffineVector); overload;
  126. function Add(const item: TVector2f): Integer; overload;
  127. function Add(const item: TTexPoint): Integer; overload;
  128. function Add(const X, Y: Single): Integer; overload;
  129. function Add(const X, Y, Z: Single): Integer; overload;
  130. function Add(const X, Y, Z: Integer): Integer; overload;
  131. // Add (3 ints, no capacity check)
  132. function AddNC(const X, Y, Z: Integer): Integer; overload;
  133. // Add (2 ints in array + 1)
  134. function Add(const xy: PIntegerArray; const Z: Integer): Integer; overload;
  135. // AddNC (2 ints in array + 1, no capacity check)
  136. function AddNC(const xy: PIntegerArray; const Z: Integer): Integer; overload;
  137. procedure Add(const list: TgxAffineVectorList); overload;
  138. procedure Push(const Val: TAffineVector);
  139. function Pop: TAffineVector;
  140. procedure Insert(Index: Integer; const item: TAffineVector);
  141. function IndexOf(const item: TAffineVector): Integer;
  142. function FindOrAdd(const item: TAffineVector): Integer;
  143. property Items[Index: Integer]: TAffineVector read Get write Put; default;
  144. property List: PAffineVectorArray read FList;
  145. procedure Translate(const delta: TAffineVector); overload; override;
  146. procedure Translate(const delta: TAffineVector; base, nb: Integer); overload;
  147. // Translates the given item
  148. procedure TranslateItem(Index: Integer; const delta: TAffineVector);
  149. // Translates given items
  150. procedure TranslateItems(Index: Integer; const delta: TAffineVector; nb: Integer);
  151. // Combines the given item
  152. procedure CombineItem(Index: Integer; const vector: TAffineVector; const f: Single);
  153. {Transforms all items by the matrix as if they were points.
  154. ie. the translation component of the matrix is honoured. }
  155. procedure TransformAsPoints(const matrix: TMatrix4f);
  156. {Transforms all items by the matrix as if they were vectors.
  157. ie. the translation component of the matrix is not honoured. }
  158. procedure TransformAsVectors(const matrix: TMatrix4f); overload;
  159. procedure TransformAsVectors(const matrix: TAffineMatrix); overload;
  160. procedure Normalize; override;
  161. procedure Lerp(const list1, list2: TgxBaseVectorList; lerpFactor: Single); override;
  162. procedure Scale(factor: Single); overload;
  163. procedure Scale(const factors: TAffineVector); overload;
  164. end;
  165. (* A list of TVector4f.
  166. Similar to TList, but using TVector4f as items.
  167. The list has stack-like push/pop methods. *)
  168. TgxVectorList = class(TgxBaseVectorList)
  169. private
  170. FList: PVectorArray;
  171. protected
  172. function Get(Index: Integer): TVector4f;
  173. procedure Put(Index: Integer; const item: TVector4f);
  174. procedure SetCapacity(NewCapacity: Integer); override;
  175. public
  176. constructor Create; override;
  177. procedure Assign(Src: TPersistent); override;
  178. function Add(const item: TVector4f): Integer; overload;
  179. function Add(const item: TAffineVector; w: Single): Integer; overload;
  180. function Add(const X, Y, Z, w: Single): Integer; overload;
  181. procedure Add(const i1, i2, i3: TAffineVector; w: Single); overload;
  182. function AddVector(const item: TAffineVector): Integer; overload;
  183. function AddPoint(const item: TAffineVector): Integer; overload;
  184. function AddPoint(const X, Y: Single; const Z: Single = 0): Integer; overload;
  185. procedure Push(const Val: TVector4f);
  186. function Pop: TVector4f;
  187. function IndexOf(const item: TVector4f): Integer;
  188. function FindOrAdd(const item: TVector4f): Integer;
  189. function FindOrAddPoint(const item: TAffineVector): Integer;
  190. procedure Insert(Index: Integer; const item: TVector4f);
  191. property Items[Index: Integer]: TVector4f read Get write Put; default;
  192. property List: PVectorArray read FList;
  193. procedure Lerp(const list1, list2: TgxBaseVectorList; lerpFactor: Single); override;
  194. end;
  195. (* A list of TTexPoint.
  196. Similar to TList, but using TTexPoint as items.
  197. The list has stack-like push/pop methods. *)
  198. TgxTexPointList = class(TgxBaseVectorList)
  199. private
  200. FList: PTexPointArray;
  201. protected
  202. function Get(Index: Integer): TTexPoint;
  203. procedure Put(Index: Integer; const item: TTexPoint);
  204. procedure SetCapacity(NewCapacity: Integer); override;
  205. public
  206. constructor Create; override;
  207. procedure Assign(Src: TPersistent); override;
  208. function IndexOf(const item: TTexpoint): Integer;
  209. function FindOrAdd(const item: TTexpoint): Integer;
  210. function Add(const item: TTexPoint): Integer; overload;
  211. function Add(const item: TVector2f): Integer; overload;
  212. function Add(const texS, Text: Single): Integer; overload;
  213. function Add(const texS, Text: Integer): Integer; overload;
  214. function AddNC(const texS, Text: Integer): Integer; overload;
  215. function Add(const texST: PIntegerArray): Integer; overload;
  216. function AddNC(const texST: PIntegerArray): Integer; overload;
  217. procedure Push(const Val: TTexPoint);
  218. function Pop: TTexPoint;
  219. procedure Insert(Index: Integer; const item: TTexPoint);
  220. property Items[Index: Integer]: TTexPoint read Get write Put; default;
  221. property List: PTexPointArray read FList;
  222. procedure Translate(const delta: TTexPoint);
  223. procedure ScaleAndTranslate(const scale, delta: TTexPoint); overload;
  224. procedure ScaleAndTranslate(const scale, delta: TTexPoint; base, nb: Integer); overload;
  225. procedure Lerp(const list1, list2: TgxBaseVectorList; lerpFactor: Single); override;
  226. end;
  227. (* A list of Integers.
  228. Similar to TList, but using TTexPoint as items.
  229. The list has stack-like push/pop methods. *)
  230. TgxIntegerList = class(TgxBaseList)
  231. private
  232. FList: PIntegerArray;
  233. protected
  234. function Get(Index: Integer): Integer;
  235. procedure Put(Index: Integer; const item: Integer);
  236. procedure SetCapacity(newCapacity: Integer); override;
  237. public
  238. constructor Create; override;
  239. procedure Assign(src: TPersistent); override;
  240. function Add(const item: Integer): Integer; overload;
  241. function AddNC(const item: Integer): Integer; overload;
  242. procedure Add(const i1, i2: Integer); overload;
  243. procedure Add(const i1, i2, i3: Integer); overload;
  244. procedure Add(const AList: TgxIntegerList); overload;
  245. procedure Push(const Val: Integer);
  246. function Pop: Integer;
  247. procedure Insert(Index: Integer; const item: Integer);
  248. procedure Remove(const item: Integer);
  249. function IndexOf(item: Integer): Integer;
  250. property Items[Index: Integer]: Integer read Get write Put; default;
  251. property List: PIntegerArray read FList;
  252. (* Adds count items in an arithmetic serie.
  253. Items are (aBase), (aBase+aDelta) ... (aBase+(aCount-1)*aDelta) *)
  254. procedure AddSerie(aBase, aDelta, aCount: Integer);
  255. // Add n integers at the address starting at (and including) first.
  256. procedure AddIntegers(const First: PInteger; n: Integer); overload;
  257. // Add all integers from aList into the list.
  258. procedure AddIntegers(const aList: TgxIntegerList); overload;
  259. // Add all integers from anArray into the list.
  260. procedure AddIntegers(const anArray: array of Integer); overload;
  261. // Returns the minimum integer item, zero if list is empty.
  262. function MinInteger: Integer;
  263. // Returns the maximum integer item, zero if list is empty.
  264. function MaxInteger: Integer;
  265. // Sort items in ascending order.
  266. procedure Sort;
  267. // Sort items in ascending order and remove duplicated integers.
  268. procedure SortAndRemoveDuplicates;
  269. // Locate a value in a sorted list.
  270. function BinarySearch(const Value: Integer): Integer; overload;
  271. (* Locate a value in a sorted list.
  272. If ReturnBestFit is set to true, the routine will return the position
  273. of the largest value that's smaller than the sought value. Found will
  274. be set to True if the exact value was found, False if a "BestFit" was found. *)
  275. function BinarySearch(const Value: Integer; returnBestFit: Boolean; var found: Boolean): Integer; overload;
  276. (* Add integer to a sorted list.
  277. Maintains the list sorted. If you have to add "a lot" of integers
  278. at once, use the Add method then Sort the list for better performance. *)
  279. function AddSorted(const Value: Integer; const ignoreDuplicates: Boolean = False): Integer;
  280. // Removes an integer from a sorted list.
  281. procedure RemoveSorted(const Value: Integer);
  282. // Adds delta to all items in the list.
  283. procedure Offset(delta: Integer); overload;
  284. procedure Offset(delta: Integer; const base, nb: Integer); overload;
  285. end;
  286. TSingleArrayList = array[0..MaxInt shr 4] of Single;
  287. PSingleArrayList = ^TSingleArrayList;
  288. (* A list of Single.
  289. Similar to TList, but using Single as items.
  290. The list has stack-like push/pop methods. *)
  291. TgxSingleList = class(TgxBaseList)
  292. private
  293. FList: PSingleArrayList;
  294. protected
  295. function Get(Index: Integer): Single;
  296. procedure Put(Index: Integer; const item: Single);
  297. procedure SetCapacity(NewCapacity: Integer); override;
  298. public
  299. constructor Create; override;
  300. procedure Assign(Src: TPersistent); override;
  301. function Add(const item: Single): Integer; overload;
  302. procedure Add(const i1, i2: Single); overload;
  303. procedure AddSingles(const First: PSingle; n: Integer); overload;
  304. procedure AddSingles(const anArray: array of Single); overload;
  305. procedure Push(const Val: Single);
  306. function Pop: Single;
  307. procedure Insert(Index: Integer; const item: Single);
  308. property Items[Index: Integer]: Single read Get write Put; default;
  309. property List: PSingleArrayList read FList;
  310. procedure AddSerie(aBase, aDelta: Single; aCount: Integer);
  311. // Adds delta to all items in the list.
  312. procedure Offset(delta: Single); overload;
  313. (* Adds to each item the corresponding item in the delta list.
  314. Performs 'Items[i]:=Items[i]+delta[i]'.
  315. If both lists don't have the same item count, an exception is raised. *)
  316. procedure Offset(const delta: TgxSingleList); overload;
  317. // Multiplies all items by factor.
  318. procedure Scale(factor: Single);
  319. // Square all items.
  320. procedure Sqr;
  321. // SquareRoot all items.
  322. procedure Sqrt;
  323. // Computes the sum of all elements.
  324. function Sum: Single;
  325. function Min: Single;
  326. function Max: Single;
  327. end;
  328. TDoubleArrayList = array[0..MaxInt shr 4] of Double;
  329. PDoubleArrayList = ^TDoubleArrayList;
  330. (* A list of Double.
  331. Similar to TList, but using Double as items.
  332. The list has stack-like push/pop methods. *)
  333. TgxDoubleList = class(TgxBaseList)
  334. private
  335. FList: PDoubleArrayList;
  336. protected
  337. function Get(Index: Integer): Double;
  338. procedure Put(Index: Integer; const item: Double);
  339. procedure SetCapacity(NewCapacity: Integer); override;
  340. public
  341. constructor Create; override;
  342. procedure Assign(Src: TPersistent); override;
  343. function Add(const item: Double): Integer;
  344. procedure Push(const Val: Double);
  345. function Pop: Double;
  346. procedure Insert(Index: Integer; const item: Double);
  347. property Items[Index: Integer]: Double read Get write Put; default;
  348. property List: PDoubleArrayList read FList;
  349. procedure AddSerie(aBase, aDelta: Double; aCount: Integer);
  350. // Adds delta to all items in the list.
  351. procedure Offset(delta: Double); overload;
  352. (* Adds to each item the corresponding item in the delta list.
  353. Performs 'Items[i]:=Items[i]+delta[i]'.
  354. If both lists don't have the same item count, an exception is raised. *)
  355. procedure Offset(const delta: TgxDoubleList); overload;
  356. // Multiplies all items by factor.
  357. procedure Scale(factor: Double);
  358. // Square all items.
  359. procedure Sqr;
  360. // SquareRoot all items.
  361. procedure Sqrt;
  362. // Computes the sum of all elements.
  363. function Sum: Double;
  364. function Min: Single;
  365. function Max: Single;
  366. end;
  367. // A list of bytes. Similar to TList, but using Byte as items.
  368. TByteList = class(TgxBaseList)
  369. private
  370. FList: PByteArray;
  371. protected
  372. function Get(Index: Integer): Byte;
  373. procedure Put(Index: Integer; const item: Byte);
  374. procedure SetCapacity(NewCapacity: Integer); override;
  375. public
  376. constructor Create; override;
  377. procedure Assign(Src: TPersistent); override;
  378. function Add(const item: Byte): Integer;
  379. procedure Insert(Index: Integer; const item: Byte);
  380. property Items[Index: Integer]: Byte read Get write Put; default;
  381. property List: PByteArray read FList;
  382. end;
  383. (* A list of TQuaternion.
  384. Similar to TList, but using TQuaternion as items.
  385. The list has stack-like push/pop methods. *)
  386. TQuaternionList = class(TgxBaseVectorList)
  387. private
  388. FList: PQuaternionArray;
  389. protected
  390. function Get(Index: Integer): TQuaternion;
  391. procedure Put(Index: Integer; const item: TQuaternion);
  392. procedure SetCapacity(NewCapacity: Integer); override;
  393. public
  394. constructor Create; override;
  395. procedure Assign(Src: TPersistent); override;
  396. function Add(const item: TQuaternion): Integer; overload;
  397. function Add(const item: TAffineVector; w: Single): Integer; overload;
  398. function Add(const X, Y, Z, W: Single): Integer; overload;
  399. procedure Push(const Val: TQuaternion);
  400. function Pop: TQuaternion;
  401. function IndexOf(const item: TQuaternion): Integer;
  402. function FindOrAdd(const item: TQuaternion): Integer;
  403. procedure Insert(Index: Integer; const item: TQuaternion);
  404. property Items[Index: Integer]: TQuaternion read Get write Put; default;
  405. property List: PQuaternionArray read FList;
  406. // Lerps corresponding quaternions from both lists using QuaternionSlerp.
  407. procedure Lerp(const list1, list2: TgxBaseVectorList; lerpFactor: Single); override;
  408. (* Multiplies corresponding quaternions after the second quaternion is
  409. slerped with the IdentityQuaternion using factor. This allows for weighted
  410. combining of rotation transforms using quaternions. *)
  411. procedure Combine(const list2: TgxBaseVectorList; factor: Single); override;
  412. end;
  413. // 4 byte union contain access like Integer, Single and four Byte
  414. T4ByteData = packed record
  415. case Byte of
  416. 0 : (Bytes : record Value : array[0..3] of Byte; end);
  417. 1 : (Int : record Value : Integer; end);
  418. 2 : (UInt : record Value : Cardinal; end);
  419. 3 : (Float : record Value : Single; end);
  420. 4 : (Word : record Value : array[0..1] of Word; end);
  421. end;
  422. T4ByteArrayList = array[0..MaxInt shr 4] of T4ByteData;
  423. P4ByteArrayList = ^T4ByteArrayList;
  424. // A list of T4ByteData.
  425. Tgx4ByteList = class(TgxBaseList)
  426. private
  427. FList: P4ByteArrayList;
  428. protected
  429. function Get(Index: Integer): T4ByteData;
  430. procedure Put(Index: Integer; const item: T4ByteData);
  431. procedure SetCapacity(NewCapacity: Integer); override;
  432. public
  433. constructor Create; override;
  434. procedure Assign(Src: TPersistent); override;
  435. function Add(const item: T4ByteData): Integer; overload;
  436. procedure Add(const i1: Single); overload;
  437. procedure Add(const i1, i2: Single); overload;
  438. procedure Add(const i1, i2, i3: Single); overload;
  439. procedure Add(const i1, i2, i3, i4: Single); overload;
  440. procedure Add(const i1: Integer); overload;
  441. procedure Add(const i1, i2: Integer); overload;
  442. procedure Add(const i1, i2, i3: Integer); overload;
  443. procedure Add(const i1, i2, i3, i4: Integer); overload;
  444. procedure Add(const i1: Cardinal); overload;
  445. procedure Add(const i1, i2: Cardinal); overload;
  446. procedure Add(const i1, i2, i3: Cardinal); overload;
  447. procedure Add(const i1, i2, i3, i4: Cardinal); overload;
  448. procedure Add(const AList: Tgx4ByteList); overload;
  449. procedure Push(const Val: T4ByteData);
  450. function Pop: T4ByteData;
  451. procedure Insert(Index: Integer; const item: T4ByteData);
  452. property Items[Index: Integer]: T4ByteData read Get write Put; default;
  453. property List: P4ByteArrayList read FList;
  454. end;
  455. TgxLongWordList = class(TgxBaseList)
  456. private
  457. FList: PLongWordArray;
  458. protected
  459. function Get(Index: Integer): LongWord;
  460. procedure Put(Index: Integer; const item: LongWord);
  461. procedure SetCapacity(newCapacity: Integer); override;
  462. public
  463. constructor Create; override;
  464. procedure Assign(src: TPersistent); override;
  465. function Add(const item: LongWord): Integer; overload;
  466. function AddNC(const item: LongWord): Integer; overload;
  467. procedure Add(const i1, i2: LongWord); overload;
  468. procedure Add(const i1, i2, i3: LongWord); overload;
  469. procedure Add(const AList: TgxLongWordList); overload;
  470. procedure Push(const Val: LongWord);
  471. function Pop: LongWord;
  472. procedure Insert(Index: Integer; const item: LongWord);
  473. procedure Remove(const item: LongWord);
  474. function IndexOf(item: Integer): LongWord;
  475. property Items[Index: Integer]: LongWord read Get write Put; default;
  476. property List: PLongWordArray read FList;
  477. // Add n integers at the address starting at (and including) first.
  478. procedure AddLongWords(const First: PLongWord; n: Integer); overload;
  479. // Add all integers from aList into the list.
  480. procedure AddLongWords(const aList: TgxLongWordList); overload;
  481. // Add all integers from anArray into the list.
  482. procedure AddLongWords(const anArray: array of LongWord); overload;
  483. end;
  484. // Sort the refList in ascending order, ordering objList (TList) on the way.
  485. procedure QuickSortLists(startIndex, endIndex: Integer; refList: TgxSingleList; objList: TList); overload;
  486. // Sort the refList in ascending order, ordering objList (TgxBaseList) on the way.
  487. procedure QuickSortLists(startIndex, endIndex: Integer; refList: TgxSingleList; objList: TgxBaseList); overload;
  488. (* Sort the refList in ascending order, ordering objList on the way.
  489. Use if, and *ONLY* if refList contains only values superior or equal to 1. *)
  490. procedure FastQuickSortLists(startIndex, endIndex: Integer; const refList: TgxSingleList; const objList: TgxPersistentObjectList);
  491. // ------------------------------------------------------------------
  492. implementation
  493. // ------------------------------------------------------------------
  494. const
  495. cDefaultListGrowthDelta = 16;
  496. procedure QuickSortLists(startIndex, endIndex: Integer; refList: TgxSingleList; objList: TList);
  497. var
  498. I, J: Integer;
  499. P: Single;
  500. begin
  501. if endIndex - startIndex > 1 then
  502. begin
  503. repeat
  504. I := startIndex;
  505. J := endIndex;
  506. P := refList.List^[(I + J) shr 1];
  507. repeat
  508. while Single(refList.List^[I]) < P do
  509. Inc(I);
  510. while Single(refList.List^[J]) > P do
  511. Dec(J);
  512. if I <= J then
  513. begin
  514. refList.Exchange(I, J);
  515. objList.Exchange(I, J);
  516. Inc(I);
  517. Dec(J);
  518. end;
  519. until I > J;
  520. if startIndex < J then
  521. QuickSortLists(startIndex, J, refList, objList);
  522. startIndex := I;
  523. until I >= endIndex;
  524. end
  525. else
  526. if endIndex - startIndex > 0 then
  527. begin
  528. p := refList.List^[startIndex];
  529. if refList.List^[endIndex] < p then
  530. begin
  531. refList.Exchange(startIndex, endIndex);
  532. objList.Exchange(startIndex, endIndex);
  533. end;
  534. end;
  535. end;
  536. procedure QuickSortLists(startIndex, endIndex: Integer; refList: TgxSingleList; objList: TgxBaseList);
  537. var
  538. I, J: Integer;
  539. P: Single;
  540. begin
  541. if endIndex - startIndex > 1 then
  542. begin
  543. repeat
  544. I := startIndex;
  545. J := endIndex;
  546. P := refList.List^[(I + J) shr 1];
  547. repeat
  548. while Single(refList.List^[I]) < P do
  549. Inc(I);
  550. while Single(refList.List^[J]) > P do
  551. Dec(J);
  552. if I <= J then
  553. begin
  554. refList.Exchange(I, J);
  555. objList.Exchange(I, J);
  556. Inc(I);
  557. Dec(J);
  558. end;
  559. until I > J;
  560. if startIndex < J then
  561. QuickSortLists(startIndex, J, refList, objList);
  562. startIndex := I;
  563. until I >= endIndex;
  564. end
  565. else
  566. if endIndex - startIndex > 0 then
  567. begin
  568. p := refList.List^[startIndex];
  569. if refList.List^[endIndex] < p then
  570. begin
  571. refList.Exchange(startIndex, endIndex);
  572. objList.Exchange(startIndex, endIndex);
  573. end;
  574. end;
  575. end;
  576. procedure FastQuickSortLists(startIndex, endIndex: Integer; const refList: TgxSingleList; const objList: TgxPersistentObjectList);
  577. var
  578. I, J: Integer;
  579. p, Temp: Integer;
  580. ppl: PIntegerArray;
  581. oTemp : Pointer;
  582. oppl : PPointerArray;
  583. begin
  584. // All singles are >=1, so IEEE format allows comparing them as if they were integers
  585. ppl := PIntegerArray(@refList.List[0]);
  586. oppl := PPointerArray(objList.List);
  587. if endIndex > startIndex + 1 then
  588. begin
  589. repeat
  590. I := startIndex;
  591. J := endIndex;
  592. p := PInteger(@refList.List[(I + J) shr 1])^;
  593. repeat
  594. while ppl^[I] < p do
  595. Inc(I);
  596. while ppl^[J] > p do
  597. Dec(J);
  598. if I <= J then
  599. begin
  600. // swap integers
  601. Temp := ppl^[I];
  602. ppl^[I] := ppl^[J];
  603. ppl^[J] := Temp;
  604. // swap pointers
  605. oTemp := oppl^[I];
  606. oppl^[I] := oppl^[J];
  607. oppl^[J] := oTemp;
  608. Inc(I);
  609. Dec(J);
  610. end;
  611. until I > J;
  612. if startIndex < J then
  613. FastQuickSortLists(startIndex, J, refList, objList);
  614. startIndex := I;
  615. until I >= endIndex;
  616. end
  617. else
  618. if endIndex > startIndex then
  619. begin
  620. if ppl^[endIndex] < ppl^[startIndex] then
  621. begin
  622. I := endIndex;
  623. J := startIndex;
  624. // swap integers
  625. Temp := ppl^[I];
  626. ppl^[I] := ppl^[J];
  627. ppl^[J] := Temp;
  628. // swap pointers
  629. oTemp := oppl^[I];
  630. oppl^[I] := oppl^[J];
  631. oppl^[J] := oTemp;
  632. end;
  633. end;
  634. end;
  635. // ------------------
  636. // ------------------ TgxBaseList ------------------
  637. // ------------------
  638. constructor TgxBaseList.Create;
  639. begin
  640. inherited Create;
  641. FOptions := [bloSetCountResetsMemory];
  642. end;
  643. destructor TgxBaseList.Destroy;
  644. begin
  645. Clear;
  646. if Assigned(FBufferItem) then
  647. FreeMem(FBufferItem);
  648. inherited;
  649. end;
  650. procedure TgxBaseList.Assign(Src: TPersistent);
  651. begin
  652. if (Src is TgxBaseList) then
  653. begin
  654. SetCapacity(TgxBaseList(Src).Count);
  655. FGrowthDelta := TgxBaseList(Src).FGrowthDelta;
  656. FCount := FCapacity;
  657. FTagString := TgxBaseList(Src).FTagString;
  658. Inc(FRevision);
  659. end
  660. else
  661. inherited;
  662. end;
  663. procedure TgxBaseList.DefineProperties(AFiler: TFiler);
  664. begin
  665. inherited DefineProperties(AFiler);
  666. AFiler.DefineProperty('Items', ReadItemsData, WriteItemsData, True);
  667. end;
  668. procedure TgxBaseList.ReadItemsData(AReader: TReader);
  669. var
  670. lData: String;
  671. lOutputText: string;
  672. begin
  673. lOutputText := AReader.ReadString;
  674. SetLength(lData, Length(lOutputText) div 2 + 1);
  675. HexToBin(PChar(lOutputText), PAnsiChar(lData), Length(lData));
  676. LoadFromString(string(lData));
  677. end;
  678. procedure TgxBaseList.WriteItemsData(AWriter: TWriter);
  679. var
  680. lData: String;
  681. lOutputText: String;
  682. begin
  683. lData := SaveToString;
  684. SetLength(lOutputText, Length(lData) * 2);
  685. BinToHex(PAnsiChar(lData), PChar(lOutputText), Length(lData));
  686. AWriter.WriteString(lOutputText);
  687. end;
  688. procedure TgxBaseList.WriteToFiler(writer: TgxVirtualWriter);
  689. begin
  690. inherited;
  691. with writer do
  692. begin
  693. WriteInteger(0); // Archive Version 0
  694. WriteInteger(Count);
  695. WriteInteger(FItemSize);
  696. if Count > 0 then
  697. write(FBaseList[0], Count * FItemSize);
  698. end;
  699. end;
  700. procedure TgxBaseList.ReadFromFiler(reader: TgxVirtualReader);
  701. var
  702. archiveVersion: Integer;
  703. begin
  704. inherited;
  705. archiveVersion := reader.ReadInteger;
  706. if archiveVersion = 0 then
  707. with reader do
  708. begin
  709. FCount := ReadInteger;
  710. FItemSize := ReadInteger;
  711. SetCapacity(Count);
  712. if Count > 0 then
  713. read(FBaseList[0], Count * FItemSize);
  714. end
  715. else
  716. RaiseFilerException(archiveVersion);
  717. Inc(FRevision);
  718. end;
  719. procedure TgxBaseList.SetCount(Val: Integer);
  720. begin
  721. Assert(Val >= 0);
  722. if Val > FCapacity then
  723. SetCapacity(Val);
  724. if (Val > FCount) and (bloSetCountResetsMemory in FOptions) then
  725. FillChar(FBaseList[FItemSize * FCount], (Val - FCount) * FItemSize, 0);
  726. FCount := Val;
  727. Inc(FRevision);
  728. end;
  729. procedure TgxBaseList.SetCapacity(newCapacity: Integer);
  730. begin
  731. if newCapacity <> FCapacity then
  732. begin
  733. if bloExternalMemory in FOptions then
  734. begin
  735. Exclude(FOptions, bloExternalMemory);
  736. FBaseList := nil;
  737. end;
  738. ReallocMem(FBaseList, newCapacity * FItemSize);
  739. FCapacity := newCapacity;
  740. Inc(FRevision);
  741. end;
  742. end;
  743. procedure TgxBaseList.AddNulls(nbVals: Cardinal);
  744. begin
  745. if Integer(nbVals) + Count > Capacity then
  746. SetCapacity(Integer(nbVals) + Count);
  747. FillChar(FBaseList[FCount * FItemSize], Integer(nbVals) * FItemSize, 0);
  748. FCount := FCount + Integer(nbVals);
  749. Inc(FRevision);
  750. end;
  751. procedure TgxBaseList.InsertNulls(Index: Integer; nbVals: Cardinal);
  752. var
  753. nc: Integer;
  754. begin
  755. {$IFOPT R+}
  756. Assert(Cardinal(Index) < Cardinal(FCount));
  757. {$ENDIF}
  758. if nbVals > 0 then
  759. begin
  760. nc := FCount + Integer(nbVals);
  761. if nc > FCapacity then
  762. SetCapacity(nc);
  763. if Index < FCount then
  764. System.Move(FBaseList[Index * FItemSize],
  765. FBaseList[(Index + Integer(nbVals)) * FItemSize],
  766. (FCount - Index) * FItemSize);
  767. FillChar(FBaseList[Index * FItemSize], Integer(nbVals) * FItemSize, 0);
  768. FCount := nc;
  769. Inc(FRevision);
  770. end;
  771. end;
  772. procedure TgxBaseList.AdjustCapacityToAtLeast(const size: Integer);
  773. begin
  774. if Capacity < size then
  775. Capacity := size;
  776. end;
  777. function TgxBaseList.DataSize: Integer;
  778. begin
  779. Result := FItemSize * FCount;
  780. end;
  781. function TgxBaseList.BufferItem: PByteArray;
  782. begin
  783. if not Assigned(FBufferItem) then
  784. GetMem(FBufferItem, FItemSize);
  785. Result := FBufferItem;
  786. end;
  787. function TgxBaseList.GetSetCountResetsMemory: Boolean;
  788. begin
  789. Result := (bloSetCountResetsMemory in FOptions);
  790. end;
  791. procedure TgxBaseList.SetSetCountResetsMemory(const Val: Boolean);
  792. begin
  793. if Val then
  794. Include(FOptions, bloSetCountResetsMemory)
  795. else
  796. Exclude(FOptions, bloSetCountResetsMemory);
  797. end;
  798. procedure TgxBaseList.UseMemory(rangeStart: Pointer; rangeCapacity: Integer);
  799. begin
  800. rangeCapacity := rangeCapacity div FItemSize;
  801. if rangeCapacity < FCount then
  802. Exit;
  803. // transfer data
  804. System.Move(FBaseList^, rangeStart^, FCount * FItemSize);
  805. if not (bloExternalMemory in FOptions) then
  806. begin
  807. FreeMem(FBaseList);
  808. Include(FOptions, bloExternalMemory);
  809. end;
  810. FBaseList := rangeStart;
  811. FCapacity := rangeCapacity;
  812. SetCapacity(FCapacity); // notify subclasses
  813. end;
  814. procedure TgxBaseList.Flush;
  815. begin
  816. if Assigned(Self) then
  817. begin
  818. SetCount(0);
  819. end;
  820. end;
  821. procedure TgxBaseList.Clear;
  822. begin
  823. if Assigned(Self) then
  824. begin
  825. SetCount(0);
  826. SetCapacity(0);
  827. end;
  828. end;
  829. procedure TgxBaseList.Delete(Index: Integer);
  830. begin
  831. {$IFOPT R+}
  832. Assert(Cardinal(index) < Cardinal(FCount));
  833. {$ENDIF}
  834. Dec(FCount);
  835. if Index < FCount then
  836. System.Move(FBaseList[(Index + 1) * FItemSize],
  837. FBaseList[Index * FItemSize],
  838. (FCount - Index) * FItemSize);
  839. Inc(FRevision);
  840. end;
  841. procedure TgxBaseList.DeleteItems(Index: Integer; nbVals: Cardinal);
  842. begin
  843. {$IFOPT R+}
  844. Assert(Cardinal(index) < Cardinal(FCount));
  845. {$ENDIF}
  846. if nbVals > 0 then
  847. begin
  848. if Index + Integer(nbVals) < FCount then
  849. begin
  850. System.Move(FBaseList[(Index + Integer(nbVals)) * FItemSize],
  851. FBaseList[Index * FItemSize],
  852. (FCount - Index - Integer(nbVals)) * FItemSize);
  853. end;
  854. Dec(FCount, nbVals);
  855. Inc(FRevision);
  856. end;
  857. end;
  858. procedure TgxBaseList.Exchange(index1, index2: Integer);
  859. var
  860. buf: Integer;
  861. p: PIntegerArray;
  862. begin
  863. {$IFOPT R+}
  864. Assert((Cardinal(index1) < Cardinal(FCount)) and (Cardinal(index2) < Cardinal(FCount)));
  865. {$ENDIF}
  866. if FItemSize = 4 then
  867. begin
  868. p := PIntegerArray(FBaseList);
  869. buf := p^[index1];
  870. p^[index1] := p^[index2];
  871. p^[index2] := buf;
  872. end
  873. else
  874. begin
  875. System.Move(FBaseList[index1 * FItemSize], BufferItem[0], FItemSize);
  876. System.Move(FBaseList[index2 * FItemSize], FBaseList[index1 * FItemSize], FItemSize);
  877. System.Move(BufferItem[0], FBaseList[index2 * FItemSize], FItemSize);
  878. end;
  879. Inc(FRevision);
  880. end;
  881. procedure TgxBaseList.Move(curIndex, newIndex: Integer);
  882. begin
  883. if curIndex <> newIndex then
  884. begin
  885. {$IFOPT R+}
  886. Assert(Cardinal(newIndex) < Cardinal(Count));
  887. Assert(Cardinal(curIndex) < Cardinal(Count));
  888. {$ENDIF}
  889. if FItemSize = 4 then
  890. PInteger(BufferItem)^ := PInteger(@FBaseList[curIndex * FItemSize])^
  891. else
  892. System.Move(FBaseList[curIndex * FItemSize], BufferItem[0], FItemSize);
  893. if curIndex < newIndex then
  894. begin
  895. // curIndex+1 necessarily exists since curIndex<newIndex and newIndex<Count
  896. System.Move(FBaseList[(curIndex + 1) * FItemSize], FBaseList[curIndex * FItemSize],
  897. (newIndex - curIndex) * FItemSize);
  898. end
  899. else
  900. begin
  901. // newIndex+1 necessarily exists since newIndex<curIndex and curIndex<Count
  902. System.Move(FBaseList[newIndex * FItemSize], FBaseList[(newIndex + 1) * FItemSize],
  903. (curIndex - newIndex) * FItemSize);
  904. end;
  905. if FItemSize = 4 then
  906. PInteger(@FBaseList[newIndex * FItemSize])^ := PInteger(BufferItem)^
  907. else
  908. System.Move(BufferItem[0], FBaseList[newIndex * FItemSize], FItemSize);
  909. Inc(FRevision);
  910. end;
  911. end;
  912. procedure TgxBaseList.Reverse;
  913. var
  914. s, e: Integer;
  915. begin
  916. s := 0;
  917. e := Count - 1;
  918. while s < e do
  919. begin
  920. Exchange(s, e);
  921. Inc(s);
  922. Dec(e);
  923. end;
  924. Inc(FRevision);
  925. end;
  926. // ------------------
  927. // ------------------ TgxBaseVectorList ------------------
  928. // ------------------
  929. procedure TgxBaseVectorList.WriteToFiler(writer: TgxVirtualWriter);
  930. begin
  931. inherited;
  932. if Self is TgxTexPointList then
  933. exit;
  934. with writer do
  935. begin
  936. WriteInteger(0); // Archive Version 0
  937. // nothing
  938. end;
  939. end;
  940. procedure TgxBaseVectorList.ReadFromFiler(reader: TgxVirtualReader);
  941. var
  942. archiveVersion: Integer;
  943. begin
  944. inherited;
  945. if Self is TgxTexPointList then
  946. exit;
  947. archiveVersion := reader.ReadInteger;
  948. if archiveVersion = 0 then
  949. with reader do
  950. begin
  951. // nothing
  952. end
  953. else
  954. RaiseFilerException(archiveVersion);
  955. end;
  956. procedure TgxBaseVectorList.GetExtents(out min, max: TAffineVector);
  957. var
  958. I, K: Integer;
  959. f: Single;
  960. ref: PFloatArray;
  961. const
  962. cBigValue: Single = 1E50;
  963. cSmallValue: Single = -1E50;
  964. begin
  965. SetVector(min, cBigValue, cBigValue, cBigValue);
  966. SetVector(max, cSmallValue, cSmallValue, cSmallValue);
  967. for I := 0 to Count - 1 do
  968. begin
  969. ref := ItemAddress[I];
  970. for K := 0 to 2 do
  971. begin
  972. f := ref^[K];
  973. if f < min.V[K] then
  974. min.V[K] := f;
  975. if f > max.V[K] then
  976. max.V[K] := f;
  977. end;
  978. end;
  979. end;
  980. function TgxBaseVectorList.Sum: TAffineVector;
  981. var
  982. I: Integer;
  983. begin
  984. Result := NullVector;
  985. for I := 0 to Count - 1 do
  986. AddVector(Result, PAffineVector(ItemAddress[I])^);
  987. end;
  988. procedure TgxBaseVectorList.Normalize;
  989. var
  990. I: Integer;
  991. begin
  992. for I := 0 to Count - 1 do
  993. NormalizeVector(PAffineVector(ItemAddress[I])^);
  994. Inc(FRevision);
  995. end;
  996. function TgxBaseVectorList.MaxSpacing(list2: TgxBaseVectorList): Single;
  997. var
  998. I: Integer;
  999. s: Single;
  1000. begin
  1001. Assert(list2.Count = Count);
  1002. Result := 0;
  1003. for I := 0 to Count - 1 do
  1004. begin
  1005. s := VectorSpacing(PAffineVector(ItemAddress[I])^,
  1006. PAffineVector(list2.ItemAddress[I])^);
  1007. if s > Result then
  1008. Result := s;
  1009. end;
  1010. end;
  1011. procedure TgxBaseVectorList.Translate(const delta: TAffineVector);
  1012. var
  1013. I: Integer;
  1014. begin
  1015. for I := 0 to Count - 1 do
  1016. AddVector(PAffineVector(ItemAddress[I])^, delta);
  1017. Inc(FRevision);
  1018. end;
  1019. procedure TgxBaseVectorList.Translate(const delta: TgxBaseVectorList);
  1020. var
  1021. I: Integer;
  1022. begin
  1023. Assert(Count <= delta.Count);
  1024. for I := 0 to Count - 1 do
  1025. AddVector(PAffineVector(ItemAddress[I])^, PAffineVector(delta.ItemAddress[I])^);
  1026. Inc(FRevision);
  1027. end;
  1028. procedure TgxBaseVectorList.TranslateInv(const delta: TgxBaseVectorList);
  1029. var
  1030. I: Integer;
  1031. begin
  1032. Assert(Count <= delta.Count);
  1033. for I := 0 to Count - 1 do
  1034. SubtractVector(PAffineVector(ItemAddress[I])^, PAffineVector(delta.ItemAddress[I])^);
  1035. Inc(FRevision);
  1036. end;
  1037. procedure TgxBaseVectorList.AngleLerp(const list1, list2: TgxBaseVectorList; lerpFactor: Single);
  1038. var
  1039. I: Integer;
  1040. begin
  1041. Assert(list1.Count = list2.Count);
  1042. if list1 <> list2 then
  1043. begin
  1044. if lerpFactor = 0 then
  1045. Assign(list1)
  1046. else
  1047. if lerpFactor = 1 then
  1048. Assign(list2)
  1049. else
  1050. begin
  1051. Capacity := list1.Count;
  1052. FCount := list1.Count;
  1053. for I := 0 to list1.Count - 1 do
  1054. PAffineVector(ItemAddress[I])^ := VectorAngleLerp(PAffineVector(list1.ItemAddress[I])^,
  1055. PAffineVector(list2.ItemAddress[I])^,
  1056. lerpFactor);
  1057. end;
  1058. end
  1059. else
  1060. Assign(list1);
  1061. Inc(FRevision);
  1062. end;
  1063. procedure TgxBaseVectorList.AngleCombine(const list1: TgxBaseVectorList; intensity: Single);
  1064. var
  1065. I: Integer;
  1066. begin
  1067. Assert(list1.Count = Count);
  1068. for I := 0 to Count - 1 do
  1069. PAffineVector(ItemAddress[I])^ := VectorAngleCombine(PAffineVector(ItemAddress[I])^,
  1070. PAffineVector(list1.ItemAddress[I])^,
  1071. intensity);
  1072. Inc(FRevision);
  1073. end;
  1074. procedure TgxBaseVectorList.Combine(const list2: TgxBaseVectorList; factor: Single);
  1075. var
  1076. I: Integer;
  1077. begin
  1078. Assert(list2.Count >= Count);
  1079. for I := 0 to Count - 1 do
  1080. CombineVector(PAffineVector(ItemAddress[I])^,
  1081. PAffineVector(list2.ItemAddress[I])^,
  1082. factor);
  1083. Inc(FRevision);
  1084. end;
  1085. function TgxBaseVectorList.GetItemAddress(Index: Integer): PFloatArray;
  1086. begin
  1087. {$IFOPT R+}
  1088. Assert(Cardinal(Index) < Cardinal(FCount));
  1089. {$ENDIF}
  1090. Result := PFloatArray(@FBaseList[Index * FItemSize]);
  1091. end;
  1092. // ------------------
  1093. // ------------------ TgxAffineVectorList ------------------
  1094. // ------------------
  1095. constructor TgxAffineVectorList.Create;
  1096. begin
  1097. FItemSize := SizeOf(TAffineVector);
  1098. inherited Create;
  1099. FGrowthDelta := cDefaultListGrowthDelta;
  1100. end;
  1101. procedure TgxAffineVectorList.Assign(Src: TPersistent);
  1102. begin
  1103. if Assigned(Src) then
  1104. begin
  1105. inherited;
  1106. if (Src is TgxAffineVectorList) then
  1107. System.Move(TgxAffineVectorList(Src).FList^, FList^, FCount * SizeOf(TAffineVector));
  1108. end
  1109. else
  1110. Clear;
  1111. end;
  1112. function TgxAffineVectorList.Add(const item: TAffineVector): Integer;
  1113. begin
  1114. Result := FCount;
  1115. if Result = FCapacity then
  1116. SetCapacity(FCapacity + FGrowthDelta);
  1117. FList^[Result] := Item;
  1118. Inc(FCount);
  1119. Inc(FRevision);
  1120. end;
  1121. function TgxAffineVectorList.Add(const item: TVector4f): Integer;
  1122. begin
  1123. Result := Add(PAffineVector(@item)^);
  1124. end;
  1125. procedure TgxAffineVectorList.Add(const i1, i2: TAffineVector);
  1126. begin
  1127. Inc(FCount, 2);
  1128. while FCount > FCapacity do
  1129. SetCapacity(FCapacity + FGrowthDelta);
  1130. FList^[FCount - 2] := i1;
  1131. FList^[FCount - 1] := i2;
  1132. Inc(FRevision);
  1133. end;
  1134. procedure TgxAffineVectorList.Add(const i1, i2, i3: TAffineVector);
  1135. begin
  1136. Inc(FCount, 3);
  1137. while FCount > FCapacity do
  1138. SetCapacity(FCapacity + FGrowthDelta);
  1139. FList^[FCount - 3] := i1;
  1140. FList^[FCount - 2] := i2;
  1141. FList^[FCount - 1] := i3;
  1142. Inc(FRevision);
  1143. end;
  1144. function TgxAffineVectorList.Add(const item: TVector2f): Integer;
  1145. begin
  1146. Result := Add(AffineVectorMake(item.X, item.Y, 0));
  1147. end;
  1148. function TgxAffineVectorList.Add(const item: TTexPoint): Integer;
  1149. begin
  1150. Result := Add(AffineVectorMake(item.S, item.T, 0));
  1151. end;
  1152. function TgxAffineVectorList.Add(const X, Y: Single): Integer;
  1153. var
  1154. v: PAffineVector;
  1155. begin
  1156. Result := FCount;
  1157. Inc(FCount);
  1158. while FCount > FCapacity do
  1159. SetCapacity(FCapacity + FGrowthDelta);
  1160. v := @List[Result];
  1161. v^.X := X;
  1162. v^.Y := Y;
  1163. v^.Z := 0;
  1164. Inc(FRevision);
  1165. end;
  1166. function TgxAffineVectorList.Add(const X, Y, Z: Single): Integer;
  1167. var
  1168. v: PAffineVector;
  1169. begin
  1170. Result := FCount;
  1171. Inc(FCount);
  1172. while FCount > FCapacity do
  1173. SetCapacity(FCapacity + FGrowthDelta);
  1174. v := @List[Result];
  1175. v^.X := X;
  1176. v^.Y := Y;
  1177. v^.Z := Z;
  1178. Inc(FRevision);
  1179. end;
  1180. function TgxAffineVectorList.Add(const X, Y, Z: Integer): Integer;
  1181. var
  1182. v: PAffineVector;
  1183. begin
  1184. Result := FCount;
  1185. if Result = FCapacity then
  1186. SetCapacity(FCapacity + FGrowthDelta);
  1187. v := @List[Result];
  1188. v^.X := X;
  1189. v^.Y := Y;
  1190. v^.Z := Z;
  1191. Inc(FCount);
  1192. Inc(FRevision);
  1193. end;
  1194. function TgxAffineVectorList.AddNC(const X, Y, Z: Integer): Integer;
  1195. var
  1196. v: PAffineVector;
  1197. begin
  1198. Result := FCount;
  1199. v := @List[Result];
  1200. v^.X := X;
  1201. v^.Y := Y;
  1202. v^.Z := Z;
  1203. Inc(FCount);
  1204. Inc(FRevision);
  1205. end;
  1206. function TgxAffineVectorList.Add(const xy: PIntegerArray; const Z: Integer): Integer;
  1207. var
  1208. v: PAffineVector;
  1209. begin
  1210. Result := FCount;
  1211. if Result = FCapacity then
  1212. SetCapacity(FCapacity + FGrowthDelta);
  1213. v := @List[Result];
  1214. v^.X := xy^[0];
  1215. v^.Y := xy^[1];
  1216. v^.Z := Z;
  1217. Inc(FCount);
  1218. Inc(FRevision);
  1219. end;
  1220. function TgxAffineVectorList.AddNC(const xy: PIntegerArray; const Z: Integer): Integer;
  1221. var
  1222. v: PAffineVector;
  1223. begin
  1224. Result := FCount;
  1225. v := @List[Result];
  1226. v^.X := xy^[0];
  1227. v^.Y := xy^[1];
  1228. v^.Z := Z;
  1229. Inc(FCount);
  1230. Inc(FRevision);
  1231. end;
  1232. procedure TgxAffineVectorList.Add(const list: TgxAffineVectorList);
  1233. begin
  1234. if Assigned(list) and (list.Count > 0) then
  1235. begin
  1236. if Count + list.Count > Capacity then
  1237. Capacity := Count + list.Count;
  1238. System.Move(list.FList[0], FList[Count], list.Count * SizeOf(TAffineVector));
  1239. Inc(FCount, list.Count);
  1240. end;
  1241. Inc(FRevision);
  1242. end;
  1243. function TgxAffineVectorList.Get(Index: Integer): TAffineVector;
  1244. begin
  1245. {$IFOPT R+}
  1246. Assert(Cardinal(Index) < Cardinal(FCount));
  1247. {$ENDIF}
  1248. Result := FList^[Index];
  1249. end;
  1250. procedure TgxAffineVectorList.Insert(Index: Integer; const Item: TAffineVector);
  1251. begin
  1252. {$IFOPT R+}
  1253. Assert(Cardinal(Index) < Cardinal(FCount));
  1254. {$ENDIF}
  1255. if FCount = FCapacity then
  1256. SetCapacity(FCapacity + FGrowthDelta);
  1257. if Index < FCount then
  1258. System.Move(FList[Index], FList[Index + 1],
  1259. (FCount - Index) * SizeOf(TAffineVector));
  1260. FList^[Index] := Item;
  1261. Inc(FCount);
  1262. Inc(FRevision);
  1263. end;
  1264. function TgxAffineVectorList.IndexOf(const item: TAffineVector): Integer;
  1265. var
  1266. I: Integer;
  1267. begin
  1268. Result := -1;
  1269. for I := 0 to Count - 1 do
  1270. if VectorEquals(item, FList^[I]) then
  1271. begin
  1272. Result := I;
  1273. Break;
  1274. end;
  1275. end;
  1276. function TgxAffineVectorList.FindOrAdd(const item: TAffineVector): Integer;
  1277. begin
  1278. Result := IndexOf(item);
  1279. if Result < 0 then
  1280. begin
  1281. Result := Add(item);
  1282. Inc(FRevision);
  1283. end;
  1284. end;
  1285. procedure TgxAffineVectorList.Put(Index: Integer; const Item: TAffineVector);
  1286. begin
  1287. {$IFOPT R+}
  1288. Assert(Cardinal(Index) < Cardinal(FCount));
  1289. {$ENDIF}
  1290. FList^[Index] := Item;
  1291. Inc(FRevision);
  1292. end;
  1293. procedure TgxAffineVectorList.SetCapacity(NewCapacity: Integer);
  1294. begin
  1295. inherited;
  1296. FList := PAffineVectorArray(FBaseList);
  1297. end;
  1298. procedure TgxAffineVectorList.Push(const Val: TAffineVector);
  1299. begin
  1300. Add(Val);
  1301. end;
  1302. function TgxAffineVectorList.Pop: TAffineVector;
  1303. begin
  1304. if FCount > 0 then
  1305. begin
  1306. Result := Get(FCount - 1);
  1307. Delete(FCount - 1);
  1308. Inc(FRevision);
  1309. end
  1310. else
  1311. Result := NullVector;
  1312. end;
  1313. procedure TgxAffineVectorList.Translate(const delta: TAffineVector);
  1314. begin
  1315. VectorArrayAdd(FList, delta, Count, FList);
  1316. Inc(FRevision);
  1317. end;
  1318. procedure TgxAffineVectorList.Translate(const delta: TAffineVector; base, nb: Integer);
  1319. begin
  1320. VectorArrayAdd(@FList[base], delta, nb, @FList[base]);
  1321. Inc(FRevision);
  1322. end;
  1323. procedure TgxAffineVectorList.TranslateItem(Index: Integer; const delta: TAffineVector);
  1324. begin
  1325. {$IFOPT R+}
  1326. Assert(Cardinal(Index) < Cardinal(FCount));
  1327. {$ENDIF}
  1328. AddVector(FList^[Index], delta);
  1329. Inc(FRevision);
  1330. end;
  1331. procedure TgxAffineVectorList.TranslateItems(Index: Integer; const delta: TAffineVector; nb: Integer);
  1332. begin
  1333. nb := Index + nb;
  1334. {$IFOPT R+}
  1335. Assert(Cardinal(index) < Cardinal(FCount));
  1336. if nb > FCount then
  1337. nb := FCount;
  1338. {$ENDIF}
  1339. VectorArrayAdd(@FList[Index], delta, nb - Index, @FList[Index]);
  1340. Inc(FRevision);
  1341. end;
  1342. procedure TgxAffineVectorList.CombineItem(Index: Integer; const vector: TAffineVector; const f: Single);
  1343. begin
  1344. {$IFOPT R+}
  1345. Assert(Cardinal(Index) < Cardinal(FCount));
  1346. {$ENDIF}
  1347. CombineVector(FList^[Index], vector, @f);
  1348. Inc(FRevision);
  1349. end;
  1350. procedure TgxAffineVectorList.TransformAsPoints(const matrix: TMatrix4f);
  1351. var
  1352. I: Integer;
  1353. begin
  1354. for I := 0 to FCount - 1 do
  1355. FList^[I] := VectorTransform(FList^[I], matrix);
  1356. Inc(FRevision);
  1357. end;
  1358. procedure TgxAffineVectorList.TransformAsVectors(const matrix: TMatrix4f);
  1359. var
  1360. m: TAffineMatrix;
  1361. begin
  1362. if FCount > 0 then
  1363. begin
  1364. SetMatrix(m, matrix);
  1365. TransformAsVectors(m);
  1366. end;
  1367. end;
  1368. procedure TgxAffineVectorList.TransformAsVectors(const matrix: TAffineMatrix);
  1369. var
  1370. I: Integer;
  1371. begin
  1372. for I := 0 to FCount - 1 do
  1373. FList^[I] := VectorTransform(FList^[I], matrix);
  1374. Inc(FRevision);
  1375. end;
  1376. procedure TgxAffineVectorList.Normalize;
  1377. begin
  1378. NormalizeVectorArray(List, Count);
  1379. Inc(FRevision);
  1380. end;
  1381. procedure TgxAffineVectorList.Lerp(const list1, list2: TgxBaseVectorList; lerpFactor: Single);
  1382. begin
  1383. if (list1 is TgxAffineVectorList) and (list2 is TgxAffineVectorList) then
  1384. begin
  1385. Assert(list1.Count = list2.Count);
  1386. Capacity := list1.Count;
  1387. FCount := list1.Count;
  1388. VectorArrayLerp(TgxAffineVectorList(list1).List, TgxAffineVectorList(list2).List,
  1389. lerpFactor, FCount, List);
  1390. Inc(FRevision);
  1391. end;
  1392. end;
  1393. procedure TgxAffineVectorList.Scale(factor: Single);
  1394. begin
  1395. if (Count > 0) and (factor <> 1) then
  1396. begin
  1397. ScaleFloatArray(@FList[0].X, Count * 3, factor);
  1398. Inc(FRevision);
  1399. end;
  1400. end;
  1401. procedure TgxAffineVectorList.Scale(const factors: TAffineVector);
  1402. var
  1403. I: Integer;
  1404. begin
  1405. for I := 0 to Count - 1 do
  1406. ScaleVector(FList^[I], factors);
  1407. Inc(FRevision);
  1408. end;
  1409. // ------------------
  1410. // ------------------ TgxVectorList ------------------
  1411. // ------------------
  1412. constructor TgxVectorList.Create;
  1413. begin
  1414. FItemSize := SizeOf(TVector4f);
  1415. inherited Create;
  1416. FGrowthDelta := cDefaultListGrowthDelta;
  1417. end;
  1418. procedure TgxVectorList.Assign(Src: TPersistent);
  1419. begin
  1420. if Assigned(Src) then
  1421. begin
  1422. inherited;
  1423. if (Src is TgxVectorList) then
  1424. System.Move(TgxVectorList(Src).FList^, FList^, FCount * SizeOf(TVector4f));
  1425. end
  1426. else
  1427. Clear;
  1428. end;
  1429. function TgxVectorList.Add(const item: TVector4f): Integer;
  1430. begin
  1431. Result := FCount;
  1432. if Result = FCapacity then
  1433. SetCapacity(FCapacity + FGrowthDelta);
  1434. FList^[Result] := Item;
  1435. Inc(FCount);
  1436. end;
  1437. function TgxVectorList.Add(const item: TAffineVector; w: Single): Integer;
  1438. begin
  1439. Result := Add(VectorMake(item, w));
  1440. end;
  1441. function TgxVectorList.Add(const X, Y, Z, w: Single): Integer;
  1442. begin
  1443. Result := Add(VectorMake(X, Y, Z, w));
  1444. end;
  1445. procedure TgxVectorList.Add(const i1, i2, i3: TAffineVector; w: Single);
  1446. begin
  1447. Inc(FCount, 3);
  1448. while FCount > FCapacity do
  1449. SetCapacity(FCapacity + FGrowthDelta);
  1450. PAffineVector(@FList[FCount - 3])^ := i1;
  1451. FList^[FCount - 3].W := w;
  1452. PAffineVector(@FList[FCount - 2])^ := i2;
  1453. FList^[FCount - 2].W := w;
  1454. PAffineVector(@FList[FCount - 1])^ := i3;
  1455. FList^[FCount - 1].W := w;
  1456. end;
  1457. function TgxVectorList.AddVector(const item: TAffineVector): Integer;
  1458. begin
  1459. Result := Add(VectorMake(item));
  1460. end;
  1461. function TgxVectorList.AddPoint(const item: TAffineVector): Integer;
  1462. begin
  1463. Result := Add(PointMake(item));
  1464. end;
  1465. function TgxVectorList.AddPoint(const X, Y: Single; const Z: Single = 0): Integer;
  1466. begin
  1467. Result := Add(PointMake(X, Y, Z));
  1468. end;
  1469. function TgxVectorList.Get(Index: Integer): TVector4f;
  1470. begin
  1471. {$IFOPT R+}
  1472. Assert(Cardinal(Index) < Cardinal(FCount));
  1473. {$ENDIF}
  1474. Result := FList^[Index];
  1475. end;
  1476. procedure TgxVectorList.Insert(Index: Integer; const Item: TVector4f);
  1477. begin
  1478. {$IFOPT R+}
  1479. Assert(Cardinal(Index) < Cardinal(FCount));
  1480. {$ENDIF}
  1481. if FCount = FCapacity then
  1482. SetCapacity(FCapacity + FGrowthDelta);
  1483. if Index < FCount then
  1484. System.Move(FList[Index], FList[Index + 1],
  1485. (FCount - Index) * SizeOf(TVector4f));
  1486. FList^[Index] := Item;
  1487. Inc(FCount);
  1488. end;
  1489. procedure TgxVectorList.Put(Index: Integer; const Item: TVector4f);
  1490. begin
  1491. {$IFOPT R+}
  1492. Assert(Cardinal(Index) < Cardinal(FCount));
  1493. {$ENDIF}
  1494. FList^[Index] := Item;
  1495. end;
  1496. procedure TgxVectorList.SetCapacity(NewCapacity: Integer);
  1497. begin
  1498. inherited;
  1499. FList := PVectorArray(FBaseList);
  1500. end;
  1501. procedure TgxVectorList.Push(const Val: TVector4f);
  1502. begin
  1503. Add(Val);
  1504. end;
  1505. function TgxVectorList.Pop: TVector4f;
  1506. begin
  1507. if FCount > 0 then
  1508. begin
  1509. Result := Get(FCount - 1);
  1510. Delete(FCount - 1);
  1511. end
  1512. else
  1513. Result := NullHmgVector;
  1514. end;
  1515. function TgxVectorList.IndexOf(const item: TVector4f): Integer;
  1516. var
  1517. I: Integer;
  1518. begin
  1519. Result := -1;
  1520. for I := 0 to Count - 1 do
  1521. if VectorEquals(item, FList^[I]) then
  1522. begin
  1523. Result := I;
  1524. Break;
  1525. end;
  1526. end;
  1527. function TgxVectorList.FindOrAdd(const item: TVector4f): Integer;
  1528. begin
  1529. Result := IndexOf(item);
  1530. if Result < 0 then
  1531. Result := Add(item);
  1532. end;
  1533. function TgxVectorList.FindOrAddPoint(const item: TAffineVector): Integer;
  1534. var
  1535. ptItem: TVector4f;
  1536. begin
  1537. MakePoint(ptItem, item);
  1538. Result := IndexOf(ptItem);
  1539. if Result < 0 then
  1540. Result := Add(ptItem);
  1541. end;
  1542. procedure TgxVectorList.Lerp(const list1, list2: TgxBaseVectorList; lerpFactor: Single);
  1543. begin
  1544. if (list1 is TgxVectorList) and (list2 is TgxVectorList) then
  1545. begin
  1546. Assert(list1.Count = list2.Count);
  1547. Capacity := list1.Count;
  1548. FCount := list1.Count;
  1549. VectorArrayLerp(TgxVectorList(list1).List, TgxVectorList(list2).List,
  1550. lerpFactor, FCount, List);
  1551. end;
  1552. end;
  1553. // ------------------
  1554. // ------------------ TgxTexPointList ------------------
  1555. // ------------------
  1556. constructor TgxTexPointList.Create;
  1557. begin
  1558. FItemSize := SizeOf(TTexPoint);
  1559. inherited Create;
  1560. FGrowthDelta := cDefaultListGrowthDelta;
  1561. end;
  1562. procedure TgxTexPointList.Assign(Src: TPersistent);
  1563. begin
  1564. if Assigned(Src) then
  1565. begin
  1566. inherited;
  1567. if (Src is TgxTexPointList) then
  1568. System.Move(TgxTexPointList(Src).FList^, FList^, FCount * SizeOf(TTexPoint));
  1569. end
  1570. else
  1571. Clear;
  1572. end;
  1573. function TgxTexPointList.IndexOf(const item: TTexpoint): Integer;
  1574. var
  1575. I: Integer;
  1576. begin
  1577. Result := -1;
  1578. for I := 0 to Count - 1 do
  1579. if TexpointEquals(FList^[I], item) then
  1580. begin
  1581. Result := I;
  1582. Break;
  1583. end;
  1584. end;
  1585. function TgxTexPointList.FindOrAdd(const item: TTexPoint): Integer;
  1586. begin
  1587. Result := IndexOf(item);
  1588. if Result < 0 then
  1589. Result := Add(item);
  1590. end;
  1591. function TgxTexPointList.Add(const item: TTexPoint): Integer;
  1592. begin
  1593. Result := FCount;
  1594. if Result = FCapacity then
  1595. SetCapacity(FCapacity + FGrowthDelta);
  1596. FList^[Result] := Item;
  1597. Inc(FCount);
  1598. end;
  1599. function TgxTexPointList.Add(const item: TVector2f): Integer;
  1600. begin
  1601. Result := FCount;
  1602. if Result = FCapacity then
  1603. SetCapacity(FCapacity + FGrowthDelta);
  1604. FList^[Result] := PTexPoint(@Item)^;
  1605. Inc(FCount);
  1606. end;
  1607. function TgxTexPointList.Add(const texS, Text: Single): Integer;
  1608. begin
  1609. Result := FCount;
  1610. if Result = FCapacity then
  1611. SetCapacity(FCapacity + FGrowthDelta);
  1612. with FList^[Result] do
  1613. begin
  1614. s := texS;
  1615. t := Text;
  1616. end;
  1617. Inc(FCount);
  1618. end;
  1619. function TgxTexPointList.Add(const texS, Text: Integer): Integer;
  1620. begin
  1621. Result := FCount;
  1622. if Result = FCapacity then
  1623. SetCapacity(FCapacity + FGrowthDelta);
  1624. with FList^[Result] do
  1625. begin
  1626. s := texS;
  1627. t := Text;
  1628. end;
  1629. Inc(FCount);
  1630. end;
  1631. function TgxTexPointList.AddNC(const texS, Text: Integer): Integer;
  1632. begin
  1633. Result := FCount;
  1634. with FList^[Result] do
  1635. begin
  1636. s := texS;
  1637. t := Text;
  1638. end;
  1639. Inc(FCount);
  1640. end;
  1641. function TgxTexPointList.Add(const texST: PIntegerArray): Integer;
  1642. begin
  1643. Result := FCount;
  1644. if Result = FCapacity then
  1645. SetCapacity(FCapacity + FGrowthDelta);
  1646. with FList^[Result] do
  1647. begin
  1648. s := texST^[0];
  1649. t := texST^[1];
  1650. end;
  1651. Inc(FCount);
  1652. end;
  1653. function TgxTexPointList.AddNC(const texST: PIntegerArray): Integer;
  1654. begin
  1655. Result := FCount;
  1656. with FList^[Result] do
  1657. begin
  1658. s := texST^[0];
  1659. t := texST^[1];
  1660. end;
  1661. Inc(FCount);
  1662. end;
  1663. function TgxTexPointList.Get(Index: Integer): TTexPoint;
  1664. begin
  1665. {$IFOPT R+}
  1666. Assert(Cardinal(Index) < Cardinal(FCount));
  1667. {$ENDIF}
  1668. Result := FList^[Index];
  1669. end;
  1670. procedure TgxTexPointList.Insert(Index: Integer; const Item: TTexPoint);
  1671. begin
  1672. {$IFOPT R+}
  1673. Assert(Cardinal(Index) < Cardinal(FCount));
  1674. {$ENDIF}
  1675. if FCount = FCapacity then
  1676. SetCapacity(FCapacity + FGrowthDelta);
  1677. if Index < FCount then
  1678. System.Move(FList[Index], FList[Index + 1],
  1679. (FCount - Index) * SizeOf(TTexPoint));
  1680. FList^[Index] := Item;
  1681. Inc(FCount);
  1682. end;
  1683. procedure TgxTexPointList.Put(Index: Integer; const Item: TTexPoint);
  1684. begin
  1685. {$IFOPT R+}
  1686. Assert(Cardinal(Index) < Cardinal(FCount));
  1687. {$ENDIF}
  1688. FList^[Index] := Item;
  1689. end;
  1690. procedure TgxTexPointList.SetCapacity(NewCapacity: Integer);
  1691. begin
  1692. inherited;
  1693. FList := PTexPointArray(FBaseList);
  1694. end;
  1695. procedure TgxTexPointList.Push(const Val: TTexPoint);
  1696. begin
  1697. Add(Val);
  1698. end;
  1699. function TgxTexPointList.Pop: TTexPoint;
  1700. begin
  1701. if FCount > 0 then
  1702. begin
  1703. Result := Get(FCount - 1);
  1704. Delete(FCount - 1);
  1705. end
  1706. else
  1707. Result := NullTexPoint;
  1708. end;
  1709. procedure TgxTexPointList.Translate(const delta: TTexPoint);
  1710. begin
  1711. TexPointArrayAdd(List, delta, FCount, FList);
  1712. end;
  1713. procedure TgxTexPointList.ScaleAndTranslate(const scale, delta: TTexPoint);
  1714. begin
  1715. TexPointArrayScaleAndAdd(FList, delta, FCount, scale, FList);
  1716. end;
  1717. procedure TgxTexPointList.ScaleAndTranslate(const scale, delta: TTexPoint; base, nb: Integer);
  1718. var
  1719. p: PTexPointArray;
  1720. begin
  1721. p := @FList[base];
  1722. TexPointArrayScaleAndAdd(p, delta, nb, scale, p);
  1723. end;
  1724. procedure TgxTexPointList.Lerp(const list1, list2: TgxBaseVectorList; lerpFactor: Single);
  1725. begin
  1726. if (list1 is TgxTexPointList) and (list2 is TgxTexPointList) then
  1727. begin
  1728. Assert(list1.Count = list2.Count);
  1729. Capacity := list1.Count;
  1730. FCount := list1.Count;
  1731. VectorArrayLerp(TgxTexPointList(list1).List, TgxTexPointList(list2).List,
  1732. lerpFactor, FCount, List);
  1733. end;
  1734. end;
  1735. // ------------------
  1736. // ------------------ TgxIntegerList ------------------
  1737. // ------------------
  1738. constructor TgxIntegerList.Create;
  1739. begin
  1740. FItemSize := SizeOf(Integer);
  1741. inherited Create;
  1742. FGrowthDelta := cDefaultListGrowthDelta;
  1743. end;
  1744. procedure TgxIntegerList.Assign(Src: TPersistent);
  1745. begin
  1746. if Assigned(Src) then
  1747. begin
  1748. inherited;
  1749. if (Src is TgxIntegerList) then
  1750. System.Move(TgxIntegerList(Src).FList^, FList^, FCount * SizeOf(Integer));
  1751. end
  1752. else
  1753. Clear;
  1754. end;
  1755. function TgxIntegerList.Add(const item: Integer): Integer;
  1756. begin
  1757. Result := FCount;
  1758. if Result = FCapacity then
  1759. SetCapacity(FCapacity + FGrowthDelta);
  1760. FList^[Result] := Item;
  1761. Inc(FCount);
  1762. end;
  1763. function TgxIntegerList.AddNC(const item: Integer): Integer;
  1764. begin
  1765. Result := FCount;
  1766. FList^[Result] := Item;
  1767. Inc(FCount);
  1768. end;
  1769. procedure TgxIntegerList.Add(const i1, i2: Integer);
  1770. var
  1771. tmpList : PIntegerArray;
  1772. begin
  1773. Inc(FCount, 2);
  1774. while FCount > FCapacity do
  1775. SetCapacity(FCapacity + FGrowthDelta);
  1776. tmpList := @FList[FCount - 2];
  1777. tmpList^[0] := i1;
  1778. tmpList^[1] := i2;
  1779. end;
  1780. procedure TgxIntegerList.Add(const i1, i2, i3: Integer);
  1781. var
  1782. tmpList : PIntegerArray;
  1783. begin
  1784. Inc(FCount, 3);
  1785. while FCount > FCapacity do
  1786. SetCapacity(FCapacity + FGrowthDelta);
  1787. tmpList := @FList[FCount - 3];
  1788. tmpList^[0] := i1;
  1789. tmpList^[1] := i2;
  1790. tmpList^[2] := i3;
  1791. end;
  1792. procedure TgxIntegerList.Add(const AList: TgxIntegerList);
  1793. begin
  1794. if Assigned(AList) and (AList.Count > 0) then
  1795. begin
  1796. if Count + AList.Count > Capacity then
  1797. Capacity := Count + AList.Count;
  1798. System.Move(AList.FList[0], FList[Count], AList.Count * SizeOf(Integer));
  1799. Inc(FCount, AList.Count);
  1800. end;
  1801. end;
  1802. function TgxIntegerList.Get(Index: Integer): Integer;
  1803. begin
  1804. {$IFOPT R+}
  1805. Assert(Cardinal(Index) < Cardinal(FCount));
  1806. {$ENDIF}
  1807. Result := FList^[Index];
  1808. end;
  1809. procedure TgxIntegerList.Insert(Index: Integer; const Item: Integer);
  1810. begin
  1811. {$IFOPT R+}
  1812. Assert(Cardinal(Index) < Cardinal(FCount));
  1813. {$ENDIF}
  1814. if FCount = FCapacity then
  1815. SetCapacity(FCapacity + FGrowthDelta);
  1816. if Index < FCount then
  1817. System.Move(FList[Index], FList[Index + 1], (FCount - Index) * SizeOf(Integer));
  1818. FList^[Index] := Item;
  1819. Inc(FCount);
  1820. end;
  1821. procedure TgxIntegerList.Remove(const item: Integer);
  1822. var
  1823. I: Integer;
  1824. begin
  1825. for I := 0 to Count - 1 do
  1826. begin
  1827. if FList^[I] = item then
  1828. begin
  1829. System.Move(FList[I + 1], FList[I], (FCount - 1 - I) * SizeOf(Integer));
  1830. Dec(FCount);
  1831. Break;
  1832. end;
  1833. end;
  1834. end;
  1835. procedure TgxIntegerList.Put(Index: Integer; const Item: Integer);
  1836. begin
  1837. {$IFOPT R+}
  1838. Assert(Cardinal(Index) < Cardinal(FCount));
  1839. {$ENDIF}
  1840. FList^[Index] := Item;
  1841. end;
  1842. procedure TgxIntegerList.SetCapacity(NewCapacity: Integer);
  1843. begin
  1844. inherited;
  1845. FList := PIntegerArray(FBaseList);
  1846. end;
  1847. procedure TgxIntegerList.Push(const Val: Integer);
  1848. begin
  1849. Add(Val);
  1850. end;
  1851. function TgxIntegerList.Pop: Integer;
  1852. begin
  1853. if FCount > 0 then
  1854. begin
  1855. Result := FList^[FCount - 1];
  1856. Delete(FCount - 1);
  1857. end
  1858. else
  1859. Result := 0;
  1860. end;
  1861. procedure TgxIntegerList.AddSerie(aBase, aDelta, aCount: Integer);
  1862. var
  1863. tmpList : PInteger;
  1864. I: Integer;
  1865. begin
  1866. if aCount <= 0 then
  1867. Exit;
  1868. AdjustCapacityToAtLeast(Count + aCount);
  1869. tmpList := @FList[Count];
  1870. for I := Count to Count + aCount - 1 do
  1871. begin
  1872. tmpList^ := aBase;
  1873. Inc(tmpList);
  1874. aBase := aBase + aDelta;
  1875. end;
  1876. FCount := Count + aCount;
  1877. end;
  1878. procedure TgxIntegerList.AddIntegers(const First: PInteger; n: Integer);
  1879. begin
  1880. if n < 1 then
  1881. Exit;
  1882. AdjustCapacityToAtLeast(Count + n);
  1883. System.Move(First^, FList[FCount], n * SizeOf(Integer));
  1884. FCount := FCount + n;
  1885. end;
  1886. procedure TgxIntegerList.AddIntegers(const aList: TgxIntegerList);
  1887. begin
  1888. if not Assigned(aList) then
  1889. Exit;
  1890. AddIntegers(@aList.List[0], aList.Count);
  1891. end;
  1892. procedure TgxIntegerList.AddIntegers(const anArray: array of Integer);
  1893. var
  1894. n: Integer;
  1895. begin
  1896. n := Length(anArray);
  1897. if n > 0 then
  1898. AddIntegers(@anArray[0], n);
  1899. end;
  1900. function IntegerSearch(item: Integer; list: PIntegerVector; Count: Integer): Integer; register;
  1901. var i : integer;
  1902. begin
  1903. result:=-1;
  1904. for i := 0 to Count-1 do begin
  1905. if list^[i]=item then begin
  1906. result:=i;
  1907. break;
  1908. end;
  1909. end;
  1910. end;
  1911. function TgxIntegerList.IndexOf(item: Integer): Integer; register;
  1912. begin
  1913. Result := IntegerSearch(item, FList, FCount);
  1914. end;
  1915. function TgxIntegerList.MinInteger: Integer;
  1916. var
  1917. I: Integer;
  1918. locList: PIntegerVector;
  1919. begin
  1920. if FCount > 0 then
  1921. begin
  1922. locList := FList;
  1923. Result := locList^[0];
  1924. for I := 1 to FCount - 1 do
  1925. if locList^[I] < Result then
  1926. Result := locList^[I];
  1927. end
  1928. else
  1929. Result := 0;
  1930. end;
  1931. function TgxIntegerList.MaxInteger: Integer;
  1932. var
  1933. I: Integer;
  1934. locList: PIntegerVector;
  1935. begin
  1936. if FCount > 0 then
  1937. begin
  1938. locList := FList;
  1939. Result := locList^[0];
  1940. for I := 1 to FCount - 1 do
  1941. if locList^[I] > Result then
  1942. Result := locList^[I];
  1943. end
  1944. else
  1945. Result := 0;
  1946. end;
  1947. procedure IntegerQuickSort(sortList: PIntegerArray; left, right: Integer);
  1948. var
  1949. I, J: Integer;
  1950. p, t: Integer;
  1951. begin
  1952. repeat
  1953. I := left;
  1954. J := right;
  1955. p := sortList^[(left + right) shr 1];
  1956. repeat
  1957. while sortList^[I] < p do
  1958. Inc(I);
  1959. while sortList^[J] > p do
  1960. Dec(J);
  1961. if I <= J then
  1962. begin
  1963. t := sortList^[I];
  1964. sortList^[I] := sortList^[J];
  1965. sortList^[J] := t;
  1966. Inc(I);
  1967. Dec(J);
  1968. end;
  1969. until I > J;
  1970. if left < J then
  1971. IntegerQuickSort(sortList, left, J);
  1972. left := I;
  1973. until I >= right;
  1974. end;
  1975. procedure TgxIntegerList.Sort;
  1976. begin
  1977. if (FList <> nil) and (Count > 1) then
  1978. IntegerQuickSort(FList, 0, Count - 1);
  1979. end;
  1980. procedure TgxIntegerList.SortAndRemoveDuplicates;
  1981. var
  1982. I, J, lastVal: Integer;
  1983. localList: PIntegerArray;
  1984. begin
  1985. if (FList <> nil) and (Count > 1) then
  1986. begin
  1987. IntegerQuickSort(FList, 0, Count - 1);
  1988. J := 0;
  1989. localList := FList;
  1990. lastVal := localList^[J];
  1991. for I := 1 to Count - 1 do
  1992. begin
  1993. if localList^[I] <> lastVal then
  1994. begin
  1995. lastVal := localList^[I];
  1996. Inc(J);
  1997. localList^[J] := lastVal;
  1998. end;
  1999. end;
  2000. FCount := J + 1;
  2001. end;
  2002. end;
  2003. function TgxIntegerList.BinarySearch(const Value: Integer): Integer;
  2004. var
  2005. found: Boolean;
  2006. begin
  2007. Result := BinarySearch(Value, False, found);
  2008. end;
  2009. function TgxIntegerList.BinarySearch(const Value: Integer; returnBestFit: Boolean; var found: Boolean): Integer;
  2010. var
  2011. Index: Integer;
  2012. min, max, mid: Integer;
  2013. intList: PIntegerArray;
  2014. begin
  2015. // Assume we won't find it
  2016. found := False;
  2017. // If the list is empty, we won't find the sought value!
  2018. if Count = 0 then
  2019. begin
  2020. Result := -1;
  2021. Exit;
  2022. end;
  2023. min := -1; // ONE OFF!
  2024. max := Count; // ONE OFF!
  2025. // We now know that Min and Max AREN'T the values!
  2026. Index := -1;
  2027. intList := List;
  2028. repeat
  2029. // Find the middle of the current scope
  2030. mid := (min + max) shr 1;
  2031. // Reduce the search scope by half
  2032. if intList^[mid] <= Value then
  2033. begin
  2034. // Is this the one?
  2035. if intList^[mid] = Value then
  2036. begin
  2037. Index := mid;
  2038. found := True;
  2039. Break;
  2040. end
  2041. else
  2042. min := mid;
  2043. end
  2044. else
  2045. max := mid;
  2046. until min + 1 = max;
  2047. if returnBestFit then
  2048. begin
  2049. if Index >= 0 then
  2050. Result := Index
  2051. else
  2052. Result := min;
  2053. end
  2054. else
  2055. Result := Index;
  2056. end;
  2057. function TgxIntegerList.AddSorted(const Value: Integer; const ignoreDuplicates: Boolean = False): Integer;
  2058. var
  2059. Index: Integer;
  2060. found: Boolean;
  2061. begin
  2062. Index := BinarySearch(Value, True, found);
  2063. if ignoreDuplicates and Found then
  2064. Result := -1
  2065. else
  2066. begin
  2067. Insert(Index + 1, Value);
  2068. Result := Index + 1;
  2069. end;
  2070. end;
  2071. procedure TgxIntegerList.RemoveSorted(const Value: Integer);
  2072. var
  2073. Index: Integer;
  2074. begin
  2075. Index := BinarySearch(Value);
  2076. if Index >= 0 then
  2077. Delete(Index);
  2078. end;
  2079. procedure TgxIntegerList.Offset(delta: Integer);
  2080. var
  2081. I: Integer;
  2082. locList: PIntegerArray;
  2083. begin
  2084. locList := FList;
  2085. for I := 0 to FCount - 1 do
  2086. locList^[I] := locList^[I] + delta;
  2087. end;
  2088. procedure TgxIntegerList.Offset(delta: Integer; const base, nb: Integer);
  2089. var
  2090. I: Integer;
  2091. locList: PIntegerArray;
  2092. begin
  2093. locList := FList;
  2094. for I := base to base + nb - 1 do
  2095. locList^[I] := locList^[I] + delta;
  2096. end;
  2097. // ------------------
  2098. // ------------------ TgxSingleList ------------------
  2099. // ------------------
  2100. constructor TgxSingleList.Create;
  2101. begin
  2102. FItemSize := SizeOf(Single);
  2103. inherited Create;
  2104. FGrowthDelta := cDefaultListGrowthDelta;
  2105. end;
  2106. procedure TgxSingleList.Assign(Src: TPersistent);
  2107. begin
  2108. if Assigned(Src) then
  2109. begin
  2110. inherited;
  2111. if (Src is TgxSingleList) then
  2112. System.Move(TgxSingleList(Src).FList^, FList^, FCount * SizeOf(Single));
  2113. end
  2114. else
  2115. Clear;
  2116. end;
  2117. function TgxSingleList.Add(const item: Single): Integer;
  2118. begin
  2119. Result := FCount;
  2120. if Result = FCapacity then
  2121. SetCapacity(FCapacity + FGrowthDelta);
  2122. FList^[Result] := Item;
  2123. Inc(FCount);
  2124. end;
  2125. procedure TgxSingleList.Add(const i1, i2: Single);
  2126. var
  2127. tmpList : PSingleArray;
  2128. begin
  2129. Inc(FCount, 2);
  2130. while FCount > FCapacity do
  2131. SetCapacity(FCapacity + FGrowthDelta);
  2132. tmpList := @FList[FCount - 2];
  2133. tmpList^[0] := i1;
  2134. tmpList^[1] := i2;
  2135. end;
  2136. procedure TgxSingleList.AddSingles(const First: PSingle; n: Integer);
  2137. begin
  2138. if n < 1 then
  2139. Exit;
  2140. AdjustCapacityToAtLeast(Count + n);
  2141. System.Move(First^, FList[FCount], n * SizeOf(Single));
  2142. FCount := FCount + n;
  2143. end;
  2144. procedure TgxSingleList.AddSingles(const anArray: array of Single);
  2145. var
  2146. n: Integer;
  2147. begin
  2148. n := Length(anArray);
  2149. if n > 0 then
  2150. AddSingles(@anArray[0], n);
  2151. end;
  2152. function TgxSingleList.Get(Index: Integer): Single;
  2153. begin
  2154. {$IFOPT R+}
  2155. Assert(Cardinal(Index) < Cardinal(FCount));
  2156. {$ENDIF}
  2157. Result := FList^[Index];
  2158. end;
  2159. procedure TgxSingleList.Insert(Index: Integer; const Item: Single);
  2160. begin
  2161. {$IFOPT R+}
  2162. Assert(Cardinal(Index) < Cardinal(FCount));
  2163. {$ENDIF}
  2164. if FCount = FCapacity then
  2165. SetCapacity(FCapacity + FGrowthDelta);
  2166. if Index < FCount then
  2167. System.Move(FList[Index], FList[Index + 1],
  2168. (FCount - Index) * SizeOf(Single));
  2169. FList^[Index] := Item;
  2170. Inc(FCount);
  2171. end;
  2172. procedure TgxSingleList.Put(Index: Integer; const Item: Single);
  2173. begin
  2174. {$IFOPT R+}
  2175. Assert(Cardinal(Index) < Cardinal(FCount));
  2176. {$ENDIF}
  2177. FList^[Index] := Item;
  2178. end;
  2179. procedure TgxSingleList.SetCapacity(NewCapacity: Integer);
  2180. begin
  2181. inherited;
  2182. FList := PSingleArrayList(FBaseList);
  2183. end;
  2184. procedure TgxSingleList.Push(const Val: Single);
  2185. begin
  2186. Add(Val);
  2187. end;
  2188. function TgxSingleList.Pop: Single;
  2189. begin
  2190. if FCount > 0 then
  2191. begin
  2192. Result := Get(FCount - 1);
  2193. Delete(FCount - 1);
  2194. end
  2195. else
  2196. Result := 0;
  2197. end;
  2198. procedure TgxSingleList.AddSerie(aBase, aDelta: Single; aCount: Integer);
  2199. var
  2200. tmpList : PSingle;
  2201. I: Integer;
  2202. begin
  2203. if aCount <= 0 then
  2204. Exit;
  2205. AdjustCapacityToAtLeast(Count + aCount);
  2206. tmpList := @FList[Count];
  2207. for I := Count to Count + aCount - 1 do
  2208. begin
  2209. tmpList^ := aBase;
  2210. Inc(tmpList);
  2211. aBase := aBase + aDelta;
  2212. end;
  2213. FCount := Count + aCount;
  2214. end;
  2215. procedure TgxSingleList.Offset(delta: Single);
  2216. begin
  2217. OffsetFloatArray(PFloatVector(FList), FCount, delta);
  2218. end;
  2219. procedure TgxSingleList.Offset(const delta: TgxSingleList);
  2220. begin
  2221. if FCount = delta.FCount then
  2222. OffsetFloatArray(PFloatVector(FList), PFloatVector(delta.FList), FCount)
  2223. else
  2224. raise Exception.Create('SingleList count do not match');
  2225. end;
  2226. procedure TgxSingleList.Scale(factor: Single);
  2227. begin
  2228. ScaleFloatArray(PFloatVector(FList), FCount, factor);
  2229. end;
  2230. procedure TgxSingleList.Sqr;
  2231. var
  2232. I: Integer;
  2233. locList: PSingleArrayList;
  2234. begin
  2235. locList := FList;
  2236. for I := 0 to Count - 1 do
  2237. locList^[I] := locList^[I] * locList^[I];
  2238. end;
  2239. procedure TgxSingleList.Sqrt;
  2240. var
  2241. I: Integer;
  2242. locList: PSingleArrayList;
  2243. begin
  2244. locList := FList;
  2245. for I := 0 to Count - 1 do
  2246. locList^[I] := System.Sqrt(locList^[I]);
  2247. end;
  2248. function TgxSingleList.Sum: Single;
  2249. var
  2250. i: Integer;
  2251. begin
  2252. Result := 0;
  2253. for i := 0 to FCount-1 do
  2254. Result := Result + FList^[i];
  2255. end;
  2256. function TgxSingleList.Min: Single;
  2257. var
  2258. I: Integer;
  2259. locList: PSingleArrayList;
  2260. begin
  2261. if FCount > 0 then
  2262. begin
  2263. locList := FList;
  2264. Result := locList^[0];
  2265. for I := 1 to FCount - 1 do
  2266. if locList^[I] < Result then
  2267. Result := locList^[I];
  2268. end
  2269. else
  2270. Result := 0;
  2271. end;
  2272. function TgxSingleList.Max: Single;
  2273. var
  2274. I: Integer;
  2275. locList: PSingleArrayList;
  2276. begin
  2277. if FCount > 0 then
  2278. begin
  2279. locList := FList;
  2280. Result := locList^[0];
  2281. for I := 1 to FCount - 1 do
  2282. if locList^[I] > Result then
  2283. Result := locList^[I];
  2284. end
  2285. else
  2286. Result := 0;
  2287. end;
  2288. // ------------------
  2289. // ------------------ TByteList ------------------
  2290. // ------------------
  2291. constructor TByteList.Create;
  2292. begin
  2293. FItemSize := SizeOf(Byte);
  2294. inherited Create;
  2295. FGrowthDelta := cDefaultListGrowthDelta;
  2296. end;
  2297. procedure TByteList.Assign(Src: TPersistent);
  2298. begin
  2299. if Assigned(Src) then
  2300. begin
  2301. inherited;
  2302. if (Src is TByteList) then
  2303. System.Move(TByteList(Src).FList^, FList^, FCount * SizeOf(Byte));
  2304. end
  2305. else
  2306. Clear;
  2307. end;
  2308. function TByteList.Add(const item: Byte): Integer;
  2309. begin
  2310. Result := FCount;
  2311. if Result = FCapacity then
  2312. SetCapacity(FCapacity + FGrowthDelta);
  2313. FList^[Result] := Item;
  2314. Inc(FCount);
  2315. end;
  2316. function TByteList.Get(Index: Integer): Byte;
  2317. begin
  2318. {$IFOPT R+}
  2319. Assert(Cardinal(Index) < Cardinal(FCount));
  2320. {$ENDIF}
  2321. Result := FList^[Index];
  2322. end;
  2323. procedure TByteList.Insert(Index: Integer; const Item: Byte);
  2324. begin
  2325. {$IFOPT R+}
  2326. Assert(Cardinal(Index) < Cardinal(FCount));
  2327. {$ENDIF}
  2328. if FCount = FCapacity then
  2329. SetCapacity(FCapacity + FGrowthDelta);
  2330. if Index < FCount then
  2331. System.Move(FList[Index], FList[Index + 1],
  2332. (FCount - Index) * SizeOf(Byte));
  2333. FList^[Index] := Item;
  2334. Inc(FCount);
  2335. end;
  2336. procedure TByteList.Put(Index: Integer; const Item: Byte);
  2337. begin
  2338. {$IFOPT R+}
  2339. Assert(Cardinal(Index) < Cardinal(FCount));
  2340. {$ENDIF}
  2341. FList^[Index] := Item;
  2342. end;
  2343. procedure TByteList.SetCapacity(NewCapacity: Integer);
  2344. begin
  2345. inherited;
  2346. FList := PByteArray(FBaseList);
  2347. end;
  2348. // ------------------
  2349. // ------------------ TgxDoubleList ------------------
  2350. // ------------------
  2351. constructor TgxDoubleList.Create;
  2352. begin
  2353. FItemSize := SizeOf(Double);
  2354. inherited Create;
  2355. FGrowthDelta := cDefaultListGrowthDelta;
  2356. end;
  2357. procedure TgxDoubleList.Assign(Src: TPersistent);
  2358. begin
  2359. if Assigned(Src) then
  2360. begin
  2361. inherited;
  2362. if (Src is TgxDoubleList) then
  2363. System.Move(TgxDoubleList(Src).FList^, FList^, FCount * SizeOf(Double));
  2364. end
  2365. else
  2366. Clear;
  2367. end;
  2368. function TgxDoubleList.Add(const item: Double): Integer;
  2369. begin
  2370. Result := FCount;
  2371. if Result = FCapacity then
  2372. SetCapacity(FCapacity + FGrowthDelta);
  2373. FList^[Result] := Item;
  2374. Inc(FCount);
  2375. end;
  2376. function TgxDoubleList.Get(Index: Integer): Double;
  2377. begin
  2378. {$IFOPT R+}
  2379. Assert(Cardinal(Index) < Cardinal(FCount));
  2380. {$ENDIF}
  2381. Result := FList^[Index];
  2382. end;
  2383. procedure TgxDoubleList.Insert(Index: Integer; const Item: Double);
  2384. begin
  2385. {$IFOPT R+}
  2386. Assert(Cardinal(Index) < Cardinal(FCount));
  2387. {$ENDIF}
  2388. if FCount = FCapacity then
  2389. SetCapacity(FCapacity + FGrowthDelta);
  2390. if Index < FCount then
  2391. System.Move(FList[Index], FList[Index + 1],
  2392. (FCount - Index) * SizeOf(Double));
  2393. FList^[Index] := Item;
  2394. Inc(FCount);
  2395. end;
  2396. procedure TgxDoubleList.Put(Index: Integer; const Item: Double);
  2397. begin
  2398. {$IFOPT R+}
  2399. Assert(Cardinal(Index) < Cardinal(FCount));
  2400. {$ENDIF}
  2401. FList^[Index] := Item;
  2402. end;
  2403. procedure TgxDoubleList.SetCapacity(NewCapacity: Integer);
  2404. begin
  2405. inherited;
  2406. FList := PDoubleArrayList(FBaseList);
  2407. end;
  2408. procedure TgxDoubleList.Push(const Val: Double);
  2409. begin
  2410. Add(Val);
  2411. end;
  2412. function TgxDoubleList.Pop: Double;
  2413. begin
  2414. if FCount > 0 then
  2415. begin
  2416. Result := Get(FCount - 1);
  2417. Delete(FCount - 1);
  2418. end
  2419. else
  2420. Result := 0;
  2421. end;
  2422. procedure TgxDoubleList.AddSerie(aBase, aDelta: Double; aCount: Integer);
  2423. var
  2424. tmpList: PDouble;
  2425. I: Integer;
  2426. begin
  2427. if aCount <= 0 then
  2428. Exit;
  2429. AdjustCapacityToAtLeast(Count + aCount);
  2430. tmpList := @FList[Count];
  2431. for I := Count to Count + aCount - 1 do
  2432. begin
  2433. tmpList^ := aBase;
  2434. Inc(tmpList);
  2435. aBase := aBase + aDelta;
  2436. end;
  2437. FCount := Count + aCount;
  2438. end;
  2439. procedure TgxDoubleList.Offset(delta: Double);
  2440. var
  2441. I: Integer;
  2442. begin
  2443. for I := 0 to Count - 1 do
  2444. FList^[I] := FList^[I] + delta;
  2445. end;
  2446. procedure TgxDoubleList.Offset(const delta: TgxDoubleList);
  2447. var
  2448. I: Integer;
  2449. begin
  2450. if FCount = delta.FCount then
  2451. for I := 0 to Count - 1 do
  2452. FList^[I] := FList^[I] + delta[I]
  2453. else
  2454. raise Exception.Create('DoubleList count do not match');
  2455. end;
  2456. procedure TgxDoubleList.Scale(factor: Double);
  2457. var
  2458. I: Integer;
  2459. begin
  2460. for I := 0 to Count - 1 do
  2461. FList^[I] := FList^[I] * factor;
  2462. end;
  2463. procedure TgxDoubleList.Sqr;
  2464. var
  2465. I: Integer;
  2466. locList: PDoubleArrayList;
  2467. begin
  2468. locList := FList;
  2469. for I := 0 to Count - 1 do
  2470. locList^[I] := locList^[I] * locList^[I];
  2471. end;
  2472. procedure TgxDoubleList.Sqrt;
  2473. var
  2474. I: Integer;
  2475. locList: PDoubleArrayList;
  2476. begin
  2477. locList := FList;
  2478. for I := 0 to Count - 1 do
  2479. locList^[I] := System.Sqrt(locList^[I]);
  2480. end;
  2481. function TgxDoubleList.Sum: Double;
  2482. var
  2483. i: Integer;
  2484. begin
  2485. Result := 0;
  2486. for i := 0 to FCount-1 do
  2487. Result := Result + FList^[i];
  2488. end;
  2489. function TgxDoubleList.Min: Single;
  2490. var
  2491. I: Integer;
  2492. locList: PDoubleArrayList;
  2493. begin
  2494. if FCount > 0 then
  2495. begin
  2496. locList := FList;
  2497. Result := locList^[0];
  2498. for I := 1 to FCount - 1 do
  2499. if locList^[I] < Result then
  2500. Result := locList^[I];
  2501. end
  2502. else
  2503. Result := 0;
  2504. end;
  2505. function TgxDoubleList.Max: Single;
  2506. var
  2507. I: Integer;
  2508. locList: PDoubleArrayList;
  2509. begin
  2510. if FCount > 0 then
  2511. begin
  2512. locList := FList;
  2513. Result := locList^[0];
  2514. for I := 1 to FCount - 1 do
  2515. if locList^[I] > Result then
  2516. Result := locList^[I];
  2517. end
  2518. else
  2519. Result := 0;
  2520. end;
  2521. // ------------------
  2522. // ------------------ TQuaternionList ------------------
  2523. // ------------------
  2524. constructor TQuaternionList.Create;
  2525. begin
  2526. FItemSize := SizeOf(TQuaternion);
  2527. inherited Create;
  2528. FGrowthDelta := cDefaultListGrowthDelta;
  2529. end;
  2530. procedure TQuaternionList.Assign(Src: TPersistent);
  2531. begin
  2532. if Assigned(Src) then
  2533. begin
  2534. inherited;
  2535. if (Src is TQuaternionList) then
  2536. System.Move(TQuaternionList(Src).FList^, FList^, FCount * SizeOf(TQuaternion));
  2537. end
  2538. else
  2539. Clear;
  2540. end;
  2541. function TQuaternionList.Add(const item: TQuaternion): Integer;
  2542. begin
  2543. Result := FCount;
  2544. if Result = FCapacity then
  2545. SetCapacity(FCapacity + FGrowthDelta);
  2546. FList^[Result] := Item;
  2547. Inc(FCount);
  2548. end;
  2549. function TQuaternionList.Add(const item: TAffineVector; w: Single): Integer;
  2550. begin
  2551. Result := Add(QuaternionMake(item.V, w));
  2552. end;
  2553. function TQuaternionList.Add(const X, Y, Z, w: Single): Integer;
  2554. begin
  2555. Result := Add(QuaternionMake([X, Y, Z], w));
  2556. end;
  2557. function TQuaternionList.Get(Index: Integer): TQuaternion;
  2558. begin
  2559. {$IFOPT R+}
  2560. Assert(Cardinal(Index) < Cardinal(FCount));
  2561. {$ENDIF}
  2562. Result := FList^[Index];
  2563. end;
  2564. procedure TQuaternionList.Insert(Index: Integer; const Item: TQuaternion);
  2565. begin
  2566. {$IFOPT R+}
  2567. Assert(Cardinal(Index) < Cardinal(FCount));
  2568. {$ENDIF}
  2569. if FCount = FCapacity then
  2570. SetCapacity(FCapacity + FGrowthDelta);
  2571. if Index < FCount then
  2572. System.Move(FList[Index], FList[Index + 1],
  2573. (FCount - Index) * SizeOf(TQuaternion));
  2574. FList^[Index] := Item;
  2575. Inc(FCount);
  2576. end;
  2577. procedure TQuaternionList.Put(Index: Integer; const Item: TQuaternion);
  2578. begin
  2579. {$IFOPT R+}
  2580. Assert(Cardinal(Index) < Cardinal(FCount));
  2581. {$ENDIF}
  2582. FList^[Index] := Item;
  2583. end;
  2584. procedure TQuaternionList.SetCapacity(NewCapacity: Integer);
  2585. begin
  2586. inherited;
  2587. FList := PQuaternionArray(FBaseList);
  2588. end;
  2589. procedure TQuaternionList.Push(const Val: TQuaternion);
  2590. begin
  2591. Add(Val);
  2592. end;
  2593. function TQuaternionList.Pop: TQuaternion;
  2594. begin
  2595. if FCount > 0 then
  2596. begin
  2597. Result := Get(FCount - 1);
  2598. Delete(FCount - 1);
  2599. end
  2600. else
  2601. Result := IdentityQuaternion;
  2602. end;
  2603. function TQuaternionList.IndexOf(const item: TQuaternion): Integer;
  2604. var
  2605. I: Integer;
  2606. curItem: PQuaternion;
  2607. begin
  2608. for I := 0 to Count - 1 do
  2609. begin
  2610. curItem := @FList[I];
  2611. if (item.RealPart = curItem^.RealPart) and VectorEquals(item.ImagPart, curItem^.ImagPart) then
  2612. begin
  2613. Result := I;
  2614. Exit;
  2615. end;
  2616. end;
  2617. Result := -1;
  2618. end;
  2619. function TQuaternionList.FindOrAdd(const item: TQuaternion): Integer;
  2620. begin
  2621. Result := IndexOf(item);
  2622. if Result < 0 then
  2623. Result := Add(item);
  2624. end;
  2625. procedure TQuaternionList.Lerp(const list1, list2: TgxBaseVectorList; lerpFactor: Single);
  2626. var
  2627. I: Integer;
  2628. begin
  2629. if (list1 is TQuaternionList) and (list2 is TQuaternionList) then
  2630. begin
  2631. Assert(list1.Count = list2.Count);
  2632. Capacity := list1.Count;
  2633. FCount := list1.Count;
  2634. for I := 0 to FCount - 1 do
  2635. Put(I, QuaternionSlerp(TQuaternionList(list1)[I], TQuaternionList(list2)[I], lerpFactor));
  2636. end;
  2637. end;
  2638. procedure TQuaternionList.Combine(const list2: TgxBaseVectorList; factor: Single);
  2639. procedure CombineQuaternion(var q1: TQuaternion; const q2: TQuaternion; factor: Single);
  2640. begin
  2641. q1 := QuaternionMultiply(q1, QuaternionSlerp(IdentityQuaternion, q2, factor));
  2642. end;
  2643. var
  2644. I: Integer;
  2645. begin
  2646. Assert(list2.Count >= Count);
  2647. if list2 is TQuaternionList then
  2648. begin
  2649. for I := 0 to Count - 1 do
  2650. begin
  2651. CombineQuaternion(PQuaternion(ItemAddress[I])^,
  2652. PQuaternion(list2.ItemAddress[I])^,
  2653. factor);
  2654. end;
  2655. end
  2656. else
  2657. inherited;
  2658. end;
  2659. // ------------------
  2660. // ------------------ Tgx4ByteList ------------------
  2661. // ------------------
  2662. constructor Tgx4ByteList.Create;
  2663. begin
  2664. FItemSize := SizeOf(Tgx4ByteList);
  2665. inherited Create;
  2666. FGrowthDelta := cDefaultListGrowthDelta;
  2667. end;
  2668. procedure Tgx4ByteList.Assign(Src: TPersistent);
  2669. begin
  2670. if Assigned(Src) then
  2671. begin
  2672. inherited;
  2673. if (Src is Tgx4ByteList) then
  2674. System.Move(Tgx4ByteList(Src).FList^, FList^, FCount * SizeOf(T4ByteData));
  2675. end
  2676. else
  2677. Clear;
  2678. end;
  2679. function Tgx4ByteList.Add(const item: T4ByteData): Integer;
  2680. begin
  2681. Result := FCount;
  2682. if Result = FCapacity then
  2683. SetCapacity(FCapacity + FGrowthDelta);
  2684. FList^[Result] := Item;
  2685. Inc(FCount);
  2686. Inc(FRevision);
  2687. end;
  2688. procedure Tgx4ByteList.Add(const i1: Single);
  2689. var
  2690. tmpList: PSingle;
  2691. begin
  2692. Inc(FCount);
  2693. if FCount >= FCapacity then
  2694. SetCapacity(FCapacity + FGrowthDelta);
  2695. tmpList := @FList[FCount - 1];
  2696. tmpList^ := i1;
  2697. Inc(FRevision);
  2698. end;
  2699. procedure Tgx4ByteList.Add(const i1, i2: Single);
  2700. var
  2701. tmpList: PSingleArray;
  2702. begin
  2703. Inc(FCount, 2);
  2704. while FCount > FCapacity do
  2705. SetCapacity(FCapacity + FGrowthDelta);
  2706. tmpList := @FList[FCount - 2];
  2707. tmpList^[0] := i1;
  2708. tmpList^[1] := i2;
  2709. Inc(FRevision);
  2710. end;
  2711. procedure Tgx4ByteList.Add(const i1, i2, i3: Single);
  2712. var
  2713. tmpList: PSingleArray;
  2714. begin
  2715. Inc(FCount, 3);
  2716. while FCount > FCapacity do
  2717. SetCapacity(FCapacity + FGrowthDelta);
  2718. tmpList := @FList[FCount - 3];
  2719. tmpList^[0] := i1;
  2720. tmpList^[1] := i2;
  2721. tmpList^[2] := i3;
  2722. Inc(FRevision);
  2723. end;
  2724. procedure Tgx4ByteList.Add(const i1, i2, i3, i4: Single);
  2725. var
  2726. tmpList: PSingleArray;
  2727. begin
  2728. Inc(FCount, 4);
  2729. while FCount > FCapacity do
  2730. SetCapacity(FCapacity + FGrowthDelta);
  2731. tmpList := @FList[FCount - 4];
  2732. tmpList^[0] := i1;
  2733. tmpList^[1] := i2;
  2734. tmpList^[2] := i3;
  2735. tmpList^[3] := i4;
  2736. Inc(FRevision);
  2737. end;
  2738. procedure Tgx4ByteList.Add(const i1: Integer);
  2739. var
  2740. tmpList: PInteger;
  2741. begin
  2742. Inc(FCount);
  2743. while FCount > FCapacity do
  2744. SetCapacity(FCapacity + FGrowthDelta);
  2745. tmpList := @FList[FCount - 1];
  2746. tmpList^ := i1;
  2747. Inc(FRevision);
  2748. end;
  2749. procedure Tgx4ByteList.Add(const i1, i2: Integer);
  2750. var
  2751. tmpList: PIntegerArray;
  2752. begin
  2753. Inc(FCount, 2);
  2754. while FCount > FCapacity do
  2755. SetCapacity(FCapacity + FGrowthDelta);
  2756. tmpList := @FList[FCount - 2];
  2757. tmpList^[0] := i1;
  2758. tmpList^[1] := i2;
  2759. Inc(FRevision);
  2760. end;
  2761. procedure Tgx4ByteList.Add(const i1, i2, i3: Integer);
  2762. var
  2763. tmpList: PIntegerArray;
  2764. begin
  2765. Inc(FCount, 3);
  2766. while FCount > FCapacity do
  2767. SetCapacity(FCapacity + FGrowthDelta);
  2768. tmpList := @FList[FCount - 3];
  2769. tmpList^[0] := i1;
  2770. tmpList^[1] := i2;
  2771. tmpList^[2] := i3;
  2772. Inc(FRevision);
  2773. end;
  2774. procedure Tgx4ByteList.Add(const i1, i2, i3, i4: Integer);
  2775. var
  2776. tmpList: PIntegerArray;
  2777. begin
  2778. Inc(FCount, 4);
  2779. while FCount > FCapacity do
  2780. SetCapacity(FCapacity + FGrowthDelta);
  2781. tmpList := @FList[FCount - 4];
  2782. tmpList^[0] := i1;
  2783. tmpList^[1] := i2;
  2784. tmpList^[2] := i3;
  2785. tmpList^[3] := i4;
  2786. Inc(FRevision);
  2787. end;
  2788. procedure Tgx4ByteList.Add(const i1: Cardinal);
  2789. var
  2790. tmpList: PLongWord;
  2791. begin
  2792. Inc(FCount);
  2793. while FCount > FCapacity do
  2794. SetCapacity(FCapacity + FGrowthDelta);
  2795. tmpList := @FList[FCount - 1];
  2796. tmpList^ := i1;
  2797. Inc(FRevision);
  2798. end;
  2799. procedure Tgx4ByteList.Add(const i1, i2: Cardinal);
  2800. var
  2801. tmpList: PLongWordArray;
  2802. begin
  2803. Inc(FCount, 2);
  2804. while FCount > FCapacity do
  2805. SetCapacity(FCapacity + FGrowthDelta);
  2806. tmpList := @FList[FCount - 2];
  2807. tmpList^[0] := i1;
  2808. tmpList^[1] := i2;
  2809. Inc(FRevision);
  2810. end;
  2811. procedure Tgx4ByteList.Add(const i1, i2, i3: Cardinal);
  2812. var
  2813. tmpList: PLongWordArray;
  2814. begin
  2815. Inc(FCount, 3);
  2816. while FCount > FCapacity do
  2817. SetCapacity(FCapacity + FGrowthDelta);
  2818. tmpList := @FList[FCount - 3];
  2819. tmpList^[0] := i1;
  2820. tmpList^[1] := i2;
  2821. tmpList^[2] := i3;
  2822. Inc(FRevision);
  2823. end;
  2824. procedure Tgx4ByteList.Add(const i1, i2, i3, i4: Cardinal);
  2825. var
  2826. tmpList: PLongWordArray;
  2827. begin
  2828. Inc(FCount, 4);
  2829. while FCount > FCapacity do
  2830. SetCapacity(FCapacity + FGrowthDelta);
  2831. tmpList := @FList[FCount - 4];
  2832. tmpList^[0] := i1;
  2833. tmpList^[1] := i2;
  2834. tmpList^[2] := i3;
  2835. tmpList^[3] := i4;
  2836. Inc(FRevision);
  2837. end;
  2838. procedure Tgx4ByteList.Add(const AList: Tgx4ByteList);
  2839. begin
  2840. if Assigned(AList) and (AList.Count > 0) then
  2841. begin
  2842. if Count + AList.Count > Capacity then
  2843. Capacity := Count + AList.Count;
  2844. System.Move(AList.FList[0], FList[Count], AList.Count * SizeOf(T4ByteData));
  2845. Inc(FCount, AList.Count);
  2846. Inc(FRevision);
  2847. end;
  2848. end;
  2849. function Tgx4ByteList.Get(Index: Integer): T4ByteData;
  2850. begin
  2851. {$IFOPT R+}
  2852. Assert(Cardinal(Index) < Cardinal(FCount));
  2853. {$ENDIF}
  2854. Result := FList^[Index];
  2855. end;
  2856. procedure Tgx4ByteList.Insert(Index: Integer; const Item: T4ByteData);
  2857. begin
  2858. {$IFOPT R+}
  2859. Assert(Cardinal(Index) < Cardinal(FCount));
  2860. {$ENDIF}
  2861. if FCount = FCapacity then
  2862. SetCapacity(FCapacity + FGrowthDelta);
  2863. if Index < FCount then
  2864. System.Move(FList[Index], FList[Index + 1],
  2865. (FCount - Index) * SizeOf(T4ByteData));
  2866. FList^[Index] := Item;
  2867. Inc(FCount);
  2868. Inc(FRevision);
  2869. end;
  2870. procedure Tgx4ByteList.Put(Index: Integer; const Item: T4ByteData);
  2871. begin
  2872. {$IFOPT R+}
  2873. Assert(Cardinal(Index) < Cardinal(FCount));
  2874. {$ENDIF}
  2875. FList^[Index] := Item;
  2876. INc(FRevision);
  2877. end;
  2878. procedure Tgx4ByteList.SetCapacity(NewCapacity: Integer);
  2879. begin
  2880. inherited;
  2881. FList := P4ByteArrayList(FBaseList);
  2882. end;
  2883. procedure Tgx4ByteList.Push(const Val: T4ByteData);
  2884. begin
  2885. Add(Val);
  2886. end;
  2887. function Tgx4ByteList.Pop: T4ByteData;
  2888. const
  2889. Zero : T4ByteData = ( Int: (Value:0) );
  2890. begin
  2891. if FCount > 0 then
  2892. begin
  2893. Result := Get(FCount - 1);
  2894. Delete(FCount - 1);
  2895. end
  2896. else
  2897. Result := Zero;
  2898. end;
  2899. // ------------------
  2900. // ------------------ TgxLongWordList ------------------
  2901. // ------------------
  2902. constructor TgxLongWordList.Create;
  2903. begin
  2904. FItemSize := SizeOf(LongWord);
  2905. inherited Create;
  2906. FGrowthDelta := cDefaultListGrowthDelta;
  2907. end;
  2908. procedure TgxLongWordList.Assign(Src: TPersistent);
  2909. begin
  2910. if Assigned(Src) then
  2911. begin
  2912. inherited;
  2913. if (Src is TgxLongWordList) then
  2914. System.Move(TgxLongWordList(Src).FList^, FList^, FCount * SizeOf(LongWord));
  2915. end
  2916. else
  2917. Clear;
  2918. end;
  2919. function TgxLongWordList.Add(const item: LongWord): Integer;
  2920. begin
  2921. Result := FCount;
  2922. if Result = FCapacity then
  2923. SetCapacity(FCapacity + FGrowthDelta);
  2924. FList^[Result] := Item;
  2925. Inc(FCount);
  2926. end;
  2927. function TgxLongWordList.AddNC(const item: LongWord): Integer;
  2928. begin
  2929. Result := FCount;
  2930. FList^[Result] := Item;
  2931. Inc(FCount);
  2932. end;
  2933. procedure TgxLongWordList.Add(const i1, i2: LongWord);
  2934. var
  2935. tmpList : PLongWordArray;
  2936. begin
  2937. Inc(FCount, 2);
  2938. while FCount > FCapacity do
  2939. SetCapacity(FCapacity + FGrowthDelta);
  2940. tmpList := @FList[FCount - 2];
  2941. tmpList^[0] := i1;
  2942. tmpList^[1] := i2;
  2943. end;
  2944. procedure TgxLongWordList.Add(const i1, i2, i3: LongWord);
  2945. var
  2946. tmpList : PLongWordArray;
  2947. begin
  2948. Inc(FCount, 3);
  2949. while FCount > FCapacity do
  2950. SetCapacity(FCapacity + FGrowthDelta);
  2951. tmpList := @FList[FCount - 3];
  2952. tmpList^[0] := i1;
  2953. tmpList^[1] := i2;
  2954. tmpList^[2] := i3;
  2955. end;
  2956. procedure TgxLongWordList.Add(const AList: TgxLongWordList);
  2957. begin
  2958. if Assigned(AList) and (AList.Count > 0) then
  2959. begin
  2960. if Count + AList.Count > Capacity then
  2961. Capacity := Count + AList.Count;
  2962. System.Move(AList.FList[0], FList[Count], AList.Count * SizeOf(LongWord));
  2963. Inc(FCount, AList.Count);
  2964. end;
  2965. end;
  2966. function TgxLongWordList.Get(Index: Integer): LongWord;
  2967. begin
  2968. {$IFOPT R+}
  2969. Assert(Cardinal(Index) < Cardinal(FCount));
  2970. {$ENDIF}
  2971. Result := FList^[Index];
  2972. end;
  2973. procedure TgxLongWordList.Insert(Index: Integer; const Item: LongWord);
  2974. begin
  2975. {$IFOPT R+}
  2976. Assert(Cardinal(Index) < Cardinal(FCount));
  2977. {$ENDIF}
  2978. if FCount = FCapacity then
  2979. SetCapacity(FCapacity + FGrowthDelta);
  2980. if Index < FCount then
  2981. System.Move(FList[Index], FList[Index + 1], (FCount - Index) * SizeOf(LongWord));
  2982. FList^[Index] := Item;
  2983. Inc(FCount);
  2984. end;
  2985. procedure TgxLongWordList.Remove(const item: LongWord);
  2986. var
  2987. I: Integer;
  2988. begin
  2989. for I := 0 to Count - 1 do
  2990. begin
  2991. if FList^[I] = item then
  2992. begin
  2993. System.Move(FList[I + 1], FList[I], (FCount - 1 - I) * SizeOf(LongWord));
  2994. Dec(FCount);
  2995. Break;
  2996. end;
  2997. end;
  2998. end;
  2999. procedure TgxLongWordList.Put(Index: Integer; const Item: LongWord);
  3000. begin
  3001. {$IFOPT R+}
  3002. Assert(Cardinal(Index) < Cardinal(FCount));
  3003. {$ENDIF}
  3004. FList^[Index] := Item;
  3005. end;
  3006. procedure TgxLongWordList.SetCapacity(NewCapacity: Integer);
  3007. begin
  3008. inherited;
  3009. FList := PLongWordArray(FBaseList);
  3010. end;
  3011. procedure TgxLongWordList.Push(const Val: LongWord);
  3012. begin
  3013. Add(Val);
  3014. end;
  3015. function TgxLongWordList.Pop: LongWord;
  3016. begin
  3017. if FCount > 0 then
  3018. begin
  3019. Result := FList^[FCount - 1];
  3020. Delete(FCount - 1);
  3021. end
  3022. else
  3023. Result := 0;
  3024. end;
  3025. procedure TgxLongWordList.AddLongWords(const First: PLongWord; n: Integer);
  3026. begin
  3027. if n < 1 then
  3028. Exit;
  3029. AdjustCapacityToAtLeast(Count + n);
  3030. System.Move(First^, FList[FCount], n * SizeOf(LongWord));
  3031. FCount := FCount + n;
  3032. end;
  3033. procedure TgxLongWordList.AddLongWords(const aList: TgxLongWordList);
  3034. begin
  3035. if not Assigned(aList) then
  3036. Exit;
  3037. AddLongWords(@aList.List[0], aList.Count);
  3038. end;
  3039. procedure TgxLongWordList.AddLongWords(const anArray: array of LongWord);
  3040. var
  3041. n: Integer;
  3042. begin
  3043. n := Length(anArray);
  3044. if n > 0 then
  3045. AddLongWords(@anArray[0], n);
  3046. end;
  3047. function LongWordSearch(item: LongWord; list: PLongWordVector; Count: Integer): Integer; register;
  3048. var i : integer;
  3049. begin
  3050. result:=-1;
  3051. for i := 0 to Count-1 do begin
  3052. if list^[i]=item then begin
  3053. result:=i;
  3054. break;
  3055. end;
  3056. end;
  3057. end;
  3058. function TgxLongWordList.IndexOf(item: Integer): LongWord; register;
  3059. begin
  3060. Result := LongWordSearch(item, FList, FCount);
  3061. end;
  3062. // ------------------------------------------------------------------
  3063. initialization
  3064. // ------------------------------------------------------------------
  3065. RegisterClasses([TgxAffineVectorList, TgxVectorList, TgxTexPointList, TgxSingleList,
  3066. TgxDoubleList, Tgx4ByteList, TgxLongWordList]);
  3067. end.