GXS.VectorLists.pas 86 KB

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