GLS.VectorLists.pas 86 KB

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