GLS.VectorLists.pas 86 KB

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