| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393 |
- //
- // The graphics engine GLXEngine. The unit of GLScene for Delphi
- //
- unit GLS.VectorLists;
- (*
- Misc. lists of vectors and entities
- The registered classes are:
- [TGLAffineVectorList, TGLVectorList, TGLTexPointList,
- TGLSingleList, TGLDoubleList, TGL4ByteList, TGLLongWordList]
- *)
- interface
- {$I Stage.Defines.inc}
- uses
- System.Classes,
- System.SysUtils,
- Stage.VectorTypes,
- Stage.VectorGeometry,
- GLS.PersistentClasses;
- type
- TGLBaseListOption = (bloExternalMemory, bloSetCountResetsMemory);
- TGLBaseListOptions = set of TGLBaseListOption;
- // Base class for lists, introduces common behaviours
- TGLBaseList = class(TGLPersistentObject)
- private
- FCount: Integer;
- FCapacity: Integer;
- FGrowthDelta: Integer;
- FBufferItem: PByteArray;
- FOptions: TGLBaseListOptions;
- FRevision: LongWord;
- FTagString: string;
- protected
- // The base list pointer (untyped)
- FBaseList: PByteArray;
- // Must be defined by all subclasses in their constructor(s)
- FItemSize: Integer;
- procedure SetCount(Val: Integer); inline;
- (* Only function where list may be alloc'ed & freed.
- Resizes the array pointed by FBaseList, adjust the subclass's
- typed pointer accordingly if any *)
- procedure SetCapacity(NewCapacity: Integer); virtual;
- function BufferItem: PByteArray; inline;
- function GetSetCountResetsMemory: Boolean; inline;
- procedure SetSetCountResetsMemory(const Val: Boolean);
- procedure ReadItemsData(AReader : TReader); virtual;
- procedure WriteItemsData(AWriter : TWriter); virtual;
- procedure DefineProperties(AFiler: TFiler); override;
- public
- constructor Create; override;
- destructor Destroy; override;
- procedure Assign(Src: TPersistent); override;
- procedure WriteToFiler(writer: TGLVirtualWriter); override;
- procedure ReadFromFiler(reader: TGLVirtualReader); override;
- procedure AddNulls(nbVals: Cardinal);
- procedure InsertNulls(Index: Integer; nbVals: Cardinal);
- procedure AdjustCapacityToAtLeast(const size: Integer);
- function DataSize: Integer;
- (*Tell the list to use the specified range instead of its own.
- rangeCapacity should be expressed in bytes.
- The allocated memory is NOT managed by the list, current content
- if copied to the location, if the capacity is later changed, regular
- memory will be allocated, and the specified range no longer used *)
- procedure UseMemory(rangeStart: Pointer; rangeCapacity: Integer);
- // Empties the list without altering capacity
- procedure Flush; inline;
- // Empties the list and release
- procedure Clear;
- procedure Delete(Index: Integer);
- procedure DeleteItems(Index: Integer; nbVals: Cardinal);
- procedure Exchange(index1, index2: Integer); inline;
- procedure Move(curIndex, newIndex: Integer); inline;
- procedure Reverse;
- // Nb of items in the list. When assigning a Count, added items are reset to zero
- property Count: Integer read FCount write SetCount;
- // Current list capacity. Not persistent
- property Capacity: Integer read FCapacity write SetCapacity;
- // List growth granularity. Not persistent
- property GrowthDelta: Integer read FGrowthDelta write FGrowthDelta;
- (* If true (default value) adjusting count will reset added values.
- Switching this option to true will turn off this memory reset,
- which can improve performance is that having empty values isn't required. *)
- property SetCountResetsMemory: Boolean read GetSetCountResetsMemory write SetSetCountResetsMemory;
- property TagString: string read FTagString write FTagString;
- // Increase by one after every content changes
- property Revision: LongWord read FRevision write FRevision;
- end;
- // Base class for vector lists, introduces common behaviours
- TGLBaseVectorList = class(TGLBaseList)
- protected
- function GetItemAddress(Index: Integer): PFloatArray; inline;
- public
- procedure WriteToFiler(writer: TGLVirtualWriter); override;
- procedure ReadFromFiler(reader: TGLVirtualReader); override;
- procedure GetExtents(out min, max: TAffineVector); virtual;
- function Sum: TAffineVector;
- procedure Normalize; virtual;
- function MaxSpacing(list2: TGLBaseVectorList): Single;
- procedure Translate(const delta: TAffineVector); overload; virtual;
- procedure Translate(const delta: TGLBaseVectorList); overload; virtual;
- procedure TranslateInv(const delta: TGLBaseVectorList); overload; virtual;
- (*Replace content of the list with lerp results between the two given lists.
- Note: you can't Lerp with Self!!! *)
- procedure Lerp(const list1, list2: TGLBaseVectorList; lerpFactor: Single); virtual; abstract;
- (* Replace content of the list with angle lerp between the two given lists.
- Note: you can't Lerp with Self!!! *)
- procedure AngleLerp(const list1, list2: TGLBaseVectorList; lerpFactor: Single);
- procedure AngleCombine(const list1: TGLBaseVectorList; intensity: Single);
- //Linear combination of Self with another list. Self[i]:=Self[i]+list2[i]*factor
- procedure Combine(const list2: TGLBaseVectorList; factor: Single); virtual;
- property ItemAddress[Index: Integer]: PFloatArray read GetItemAddress;
- end;
- (*A list of TAffineVector.
- Similar to TList, but using TAffineVector as items.
- The list has stack-like push/pop methods *)
- TGLAffineVectorList = class(TGLBaseVectorList)
- private
- FList: PAffineVectorArray;
- protected
- function Get(Index: Integer): TAffineVector; inline;
- procedure Put(Index: Integer; const item: TAffineVector); inline;
- procedure SetCapacity(NewCapacity: Integer); override;
- public
- constructor Create; override;
- procedure Assign(Src: TPersistent); override;
- function Add(const item: TAffineVector): Integer; overload;
- function Add(const item: TGLVector): Integer; overload;
- procedure Add(const i1, i2: TAffineVector); overload;
- procedure Add(const i1, i2, i3: TAffineVector); overload;
- function Add(const item: TVector2f): Integer; overload;
- function Add(const item: TTexPoint): Integer; overload;
- function Add(const X, Y: Single): Integer; overload;
- function Add(const X, Y, Z: Single): Integer; overload;
- function Add(const X, Y, Z: Integer): Integer; overload;
- // Add (3 ints, no capacity check)
- function AddNC(const X, Y, Z: Integer): Integer; overload;
- // Add (2 ints in array + 1)
- function Add(const xy: PIntegerArray; const Z: Integer): Integer; overload;
- // AddNC (2 ints in array + 1, no capacity check)
- function AddNC(const xy: PIntegerArray; const Z: Integer): Integer; overload;
- procedure Add(const list: TGLAffineVectorList); overload;
- procedure Push(const Val: TAffineVector);
- function Pop: TAffineVector;
- procedure Insert(Index: Integer; const item: TAffineVector); inline;
- function IndexOf(const item: TAffineVector): Integer;
- function FindOrAdd(const item: TAffineVector): Integer;
- property Items[Index: Integer]: TAffineVector read Get write Put; default;
- property List: PAffineVectorArray read FList;
- procedure Translate(const delta: TAffineVector); overload; override;
- procedure Translate(const delta: TAffineVector; base, nb: Integer); overload;
- // Translates the given item
- procedure TranslateItem(Index: Integer; const delta: TAffineVector);
- // Translates given items
- procedure TranslateItems(Index: Integer; const delta: TAffineVector; nb: Integer);
- // Combines the given item
- procedure CombineItem(Index: Integer; const vector: TAffineVector; const f: Single);
- (*Transforms all items by the matrix as if they were points.
- ie. the translation component of the matrix is honoured. *)
- procedure TransformAsPoints(const matrix: TGLMatrix);
- (* Transforms all items by the matrix as if they were vectors.
- ie. the translation component of the matrix is not honoured. *)
- procedure TransformAsVectors(const matrix: TGLMatrix); overload;
- procedure TransformAsVectors(const matrix: TAffineMatrix); overload;
- procedure Normalize; override;
- procedure Lerp(const list1, list2: TGLBaseVectorList; lerpFactor: Single); override;
- procedure Scale(factor: Single); overload;
- procedure Scale(const factors: TAffineVector); overload;
- end;
- (* A list of TGLVectors.
- Similar to TList, but using TGLVector as items.
- The list has stack-like push/pop methods *)
- TGLVectorList = class(TGLBaseVectorList)
- private
- FList: PVectorArray;
- protected
- function Get(Index: Integer): TGLVector; inline;
- procedure Put(Index: Integer; const item: TGLVector); inline;
- procedure SetCapacity(NewCapacity: Integer); override;
- public
- constructor Create; override;
- procedure Assign(Src: TPersistent); override;
- function Add(const item: TGLVector): Integer; overload; inline;
- function Add(const item: TAffineVector; w: Single): Integer; overload; inline;
- function Add(const X, Y, Z, w: Single): Integer; overload; inline;
- procedure Add(const i1, i2, i3: TAffineVector; w: Single); overload; inline;
- function AddVector(const item: TAffineVector): Integer; overload;
- function AddPoint(const item: TAffineVector): Integer; overload;
- function AddPoint(const X, Y: Single; const Z: Single = 0): Integer; overload;
- procedure Push(const Val: TGLVector);
- function Pop: TGLVector;
- function IndexOf(const item: TGLVector): Integer;
- function FindOrAdd(const item: TGLVector): Integer;
- function FindOrAddPoint(const item: TAffineVector): Integer;
- procedure Insert(Index: Integer; const item: TGLVector);
- property Items[Index: Integer]: TGLVector read Get write Put; default;
- property List: PVectorArray read FList;
- procedure Lerp(const list1, list2: TGLBaseVectorList; lerpFactor: Single); override;
- end;
- (* A list of TGLTexPoint. Similar to TList, but using TTexPoint as items.
- The list has stack-like push/pop methods. *)
- TGLTexPointList = class(TGLBaseVectorList)
- private
- FList: PTexPointArray;
- protected
- function Get(Index: Integer): TTexPoint;
- procedure Put(Index: Integer; const item: TTexPoint);
- procedure SetCapacity(NewCapacity: Integer); override;
- public
- constructor Create; override;
- procedure Assign(Src: TPersistent); override;
- function IndexOf(const item: TTexpoint): Integer;
- function FindOrAdd(const item: TTexpoint): Integer;
- function Add(const item: TTexPoint): Integer; overload;
- function Add(const item: TVector2f): Integer; overload;
- function Add(const texS, Text: Single): Integer; overload;
- function Add(const texS, Text: Integer): Integer; overload;
- function AddNC(const texS, Text: Integer): Integer; overload;
- function Add(const texST: PIntegerArray): Integer; overload;
- function AddNC(const texST: PIntegerArray): Integer; overload;
- procedure Push(const Val: TTexPoint);
- function Pop: TTexPoint;
- procedure Insert(Index: Integer; const item: TTexPoint);
- property Items[Index: Integer]: TTexPoint read Get write Put; default;
- property List: PTexPointArray read FList;
- procedure Translate(const delta: TTexPoint);
- procedure ScaleAndTranslate(const scale, delta: TTexPoint); overload;
- procedure ScaleAndTranslate(const scale, delta: TTexPoint; base, nb: Integer); overload;
- procedure Lerp(const list1, list2: TGLBaseVectorList; lerpFactor: Single); override;
- end;
- (* A list of Integers. Similar to TList, but using TTexPoint as items.
- The list has stack-like push/pop methods. *)
- TGLIntegerList = class(TGLBaseList)
- private
- FList: PIntegerArray;
- protected
- function Get(Index: Integer): Integer; inline;
- procedure Put(Index: Integer; const item: Integer); inline;
- procedure SetCapacity(newCapacity: Integer); override;
- public
- constructor Create; override;
- procedure Assign(src: TPersistent); override;
- function Add(const item: Integer): Integer; overload; inline;
- function AddNC(const item: Integer): Integer; overload; inline;
- procedure Add(const i1, i2: Integer); overload; inline;
- procedure Add(const i1, i2, i3: Integer); overload; inline;
- procedure Add(const AList: TGLIntegerList); overload; inline;
- procedure Push(const Val: Integer); inline;
- function Pop: Integer; inline;
- procedure Insert(Index: Integer; const item: Integer); inline;
- procedure Remove(const item: Integer); inline;
- function IndexOf(item: Integer): Integer; inline;
- property Items[Index: Integer]: Integer read Get write Put; default;
- property List: PIntegerArray read FList;
- // Adds count items in an arithmetic serie. Items are (aBase),(aBase+aDelta)...(aBase+(aCount-1)*aDelta)
- procedure AddSerie(aBase, aDelta, aCount: Integer);
- // Add n integers at the address starting at (and including) first
- procedure AddIntegers(const First: PInteger; n: Integer); overload;
- // Add all integers from aList into the list
- procedure AddIntegers(const aList: TGLIntegerList); overload;
- // Add all integers from anArray into the list
- procedure AddIntegers(const anArray: array of Integer); overload;
- // Returns the minimum integer item, zero if list is empty
- function MinInteger: Integer;
- // Returns the maximum integer item, zero if list is empty
- function MaxInteger: Integer;
- // Sort items in ascending order
- procedure Sort;
- // Sort items in ascending order and remove duplicated integers
- procedure SortAndRemoveDuplicates;
- // Locate a value in a sorted list
- function BinarySearch(const Value: Integer): Integer; overload;
- (* Locate a value in a sorted list.
- If ReturnBestFit is set to true, the routine will return the position
- of the largest value that's smaller than the sought value. Found will
- be set to True if the exact value was found, False if a "BestFit" was found *)
- function BinarySearch(const Value: Integer; returnBestFit: Boolean; var found: Boolean): Integer; overload;
- (* Add integer to a sorted list.
- Maintains the list sorted. If you have to add "a lot" of integers
- at once, use the Add method then Sort the list for better performance. *)
- function AddSorted(const Value: Integer; const ignoreDuplicates: Boolean = False): Integer;
- // Removes an integer from a sorted list
- procedure RemoveSorted(const Value: Integer);
- // Adds delta to all items in the list
- procedure Offset(delta: Integer); overload;
- procedure Offset(delta: Integer; const base, nb: Integer); overload;
- end;
- TGLSingleArrayList = array[0..MaxInt shr 4] of Single;
- PGLSingleArrayList = ^TGLSingleArrayList;
- (* A list of Single. Similar to TList, but using Single as items.
- The list has stack-like push/pop methods *)
- TGLSingleList = class(TGLBaseList)
- private
- FList: PGLSingleArrayList;
- protected
- function Get(Index: Integer): Single; inline;
- procedure Put(Index: Integer; const item: Single); inline;
- procedure SetCapacity(NewCapacity: Integer); override;
- public
- constructor Create; override;
- procedure Assign(Src: TPersistent); override;
- function Add(const item: Single): Integer; overload; inline;
- procedure Add(const i1, i2: Single); overload; inline;
- procedure AddSingles(const First: PSingle; n: Integer); overload; inline;
- procedure AddSingles(const anArray: array of Single); overload;
- procedure Push(const Val: Single); inline;
- function Pop: Single; inline;
- procedure Insert(Index: Integer; const item: Single); inline;
- property Items[Index: Integer]: Single read Get write Put; default;
- property List: PGLSingleArrayList read FList;
- procedure AddSerie(aBase, aDelta: Single; aCount: Integer);
- // Adds delta to all items in the list
- procedure Offset(delta: Single); overload;
- (* Adds to each item the corresponding item in the delta list.
- Performs 'Items[i]:=Items[i]+delta[i]'.
- If both lists don't have the same item count, an exception is raised *)
- procedure Offset(const delta: TGLSingleList); overload;
- // Multiplies all items by factor
- procedure Scale(factor: Single);
- // Square all items
- procedure Sqr;
- // SquareRoot all items
- procedure Sqrt;
- // Computes the sum of all elements
- function Sum: Single;
- function Min: Single;
- function Max: Single;
- end;
- TGLDoubleArrayList = array[0..MaxInt shr 4] of Double;
- PGLDoubleArrayList = ^TGLDoubleArrayList;
- (* A list of Double. Similar to TList, but using Double as items.
- The list has stack-like push/pop methods *)
- TGLDoubleList = class(TGLBaseList)
- private
- FList: PGLDoubleArrayList;
- protected
- function Get(Index: Integer): Double;
- procedure Put(Index: Integer; const item: Double);
- procedure SetCapacity(NewCapacity: Integer); override;
- public
- constructor Create; override;
- procedure Assign(Src: TPersistent); override;
- function Add(const item: Double): Integer;
- procedure Push(const Val: Double);
- function Pop: Double;
- procedure Insert(Index: Integer; const item: Double);
- property Items[Index: Integer]: Double read Get write Put; default;
- property List: PGLDoubleArrayList read FList;
- procedure AddSerie(aBase, aDelta: Double; aCount: Integer);
- // Adds delta to all items in the list
- procedure Offset(delta: Double); overload;
- (* Adds to each item the corresponding item in the delta list.
- Performs 'Items[i] := Items[i] + delta[i]'.
- If both lists don't have the same item count, an exception is raised *)
- procedure Offset(const delta: TGLDoubleList); overload;
- // Multiplies all items by factor
- procedure Scale(factor: Double);
- // Square all items
- procedure Sqr;
- // SquareRoot all items
- procedure Sqrt;
- // Computes the sum of all elements
- function Sum: Double;
- function Min: Single;
- function Max: Single;
- end;
- // A list of bytes. Similar to TList, but using Byte as items
- TGLByteList = class(TGLBaseList)
- private
- FList: PByteArray;
- protected
- function Get(Index: Integer): Byte; inline;
- procedure Put(Index: Integer; const item: Byte); inline;
- procedure SetCapacity(NewCapacity: Integer); override;
- public
- constructor Create; override;
- procedure Assign(Src: TPersistent); override;
- function Add(const item: Byte): Integer; inline;
- procedure Insert(Index: Integer; const item: Byte); inline;
- property Items[Index: Integer]: Byte read Get write Put; default;
- property List: PByteArray read FList;
- end;
- (* A list of TQuaternion. Similar to TList, but using TQuaternion as items.
- The list has stack-like push/pop methods *)
- TGLQuaternionList = class(TGLBaseVectorList)
- private
- FList: PQuaternionArray;
- protected
- function Get(Index: Integer): TQuaternion;
- procedure Put(Index: Integer; const item: TQuaternion);
- procedure SetCapacity(NewCapacity: Integer); override;
- public
- constructor Create; override;
- procedure Assign(Src: TPersistent); override;
- function Add(const item: TQuaternion): Integer; overload;
- function Add(const item: TAffineVector; w: Single): Integer; overload;
- function Add(const X, Y, Z, W: Single): Integer; overload;
- procedure Push(const Val: TQuaternion);
- function Pop: TQuaternion;
- function IndexOf(const item: TQuaternion): Integer;
- function FindOrAdd(const item: TQuaternion): Integer;
- procedure Insert(Index: Integer; const item: TQuaternion);
- property Items[Index: Integer]: TQuaternion read Get write Put; default;
- property List: PQuaternionArray read FList;
- // Lerps corresponding quaternions from both lists using QuaternionSlerp
- procedure Lerp(const list1, list2: TGLBaseVectorList; lerpFactor: Single); override;
- (* Multiplies corresponding quaternions after the second quaternion is
- lerped with the IdentityQuaternion using factor. This allows for weighted
- combining of rotation transforms using quaternions *)
- procedure Combine(const list2: TGLBaseVectorList; factor: Single); override;
- end;
- // 4 byte union contain access like Integer, Single and four Byte
- TGL4ByteData = packed record
- case Byte of
- 0 : (Bytes : record Value : array[0..3] of Byte; end);
- 1 : (Int : record Value : Integer; end);
- 2 : (UInt : record Value : Cardinal; end);
- 3 : (Float : record Value : Single; end);
- 4 : (Word : record Value : array[0..1] of Word; end);
- end;
- TGL4ByteArrayList = array[0..MaxInt shr 4] of TGL4ByteData;
- PG4ByteArrayList = ^TGL4ByteArrayList;
- // A list of TGL4ByteData
- TGL4ByteList = class(TGLBaseList)
- private
- FList: PG4ByteArrayList;
- protected
- function Get(Index: Integer): TGL4ByteData;
- procedure Put(Index: Integer; const item: TGL4ByteData);
- procedure SetCapacity(NewCapacity: Integer); override;
- public
- constructor Create; override;
- procedure Assign(Src: TPersistent); override;
- function Add(const item: TGL4ByteData): Integer; overload;
- procedure Add(const i1: Single); overload;
- procedure Add(const i1, i2: Single); overload;
- procedure Add(const i1, i2, i3: Single); overload;
- procedure Add(const i1, i2, i3, i4: Single); overload;
- procedure Add(const i1: Integer); overload;
- procedure Add(const i1, i2: Integer); overload;
- procedure Add(const i1, i2, i3: Integer); overload;
- procedure Add(const i1, i2, i3, i4: Integer); overload;
- procedure Add(const i1: Cardinal); overload;
- procedure Add(const i1, i2: Cardinal); overload;
- procedure Add(const i1, i2, i3: Cardinal); overload;
- procedure Add(const i1, i2, i3, i4: Cardinal); overload;
- procedure Add(const AList: TGL4ByteList); overload;
- procedure Push(const Val: TGL4ByteData);
- function Pop: TGL4ByteData;
- procedure Insert(Index: Integer; const item: TGL4ByteData);
- property Items[Index: Integer]: TGL4ByteData read Get write Put; default;
- property List: PG4ByteArrayList read FList;
- end;
- TGLLongWordList = class(TGLBaseList)
- private
- FList: PLongWordArray;
- protected
- function Get(Index: Integer): LongWord;
- procedure Put(Index: Integer; const item: LongWord);
- procedure SetCapacity(newCapacity: Integer); override;
- public
- constructor Create; override;
- procedure Assign(src: TPersistent); override;
- function Add(const item: LongWord): Integer; overload;
- function AddNC(const item: LongWord): Integer; overload;
- procedure Add(const i1, i2: LongWord); overload;
- procedure Add(const i1, i2, i3: LongWord); overload;
- procedure Add(const AList: TGLLongWordList); overload;
- procedure Push(const Val: LongWord);
- function Pop: LongWord;
- procedure Insert(Index: Integer; const item: LongWord);
- procedure Remove(const item: LongWord);
- function IndexOf(item: Integer): LongWord;
- property Items[Index: Integer]: LongWord read Get write Put; default;
- property List: PLongWordArray read FList;
- // Add n integers at the address starting at (and including) first
- procedure AddLongWords(const First: PLongWord; n: Integer); overload;
- // Add all integers from aList into the list
- procedure AddLongWords(const aList: TGLLongWordList); overload;
- // Add all integers from anArray into the list
- procedure AddLongWords(const anArray: array of LongWord); overload;
- end;
- // Sort the refList in ascending order, ordering objList (TList) on the way
- procedure QuickSortLists(startIndex, endIndex: Integer; refList: TGLSingleList; objList: TList); overload;
- // Sort the refList in ascending order, ordering objList (TGLBaseList) on the way
- procedure QuickSortLists(startIndex, endIndex: Integer; refList: TGLSingleList; objList: TGLBaseList); overload;
- (* Sort the refList in ascending order, ordering objList on the way.
- Use if, and *ONLY* if refList contains only values superior or equal to 1 *)
- procedure FastQuickSortLists(startIndex, endIndex: Integer; const refList: TGLSingleList; const objList: TGLPersistentObjectList);
- implementation // ------------------------------------------------------------
- const
- cDefaultListGrowthDelta = 16;
- procedure QuickSortLists(startIndex, endIndex: Integer; refList: TGLSingleList; objList: TList);
- var
- I, J: Integer;
- P: Single;
- begin
- if endIndex - startIndex > 1 then
- begin
- repeat
- I := startIndex;
- J := endIndex;
- P := refList.List^[(I + J) shr 1];
- repeat
- while Single(refList.List^[I]) < P do
- Inc(I);
- while Single(refList.List^[J]) > P do
- Dec(J);
- if I <= J then
- begin
- refList.Exchange(I, J);
- objList.Exchange(I, J);
- Inc(I);
- Dec(J);
- end;
- until I > J;
- if startIndex < J then
- QuickSortLists(startIndex, J, refList, objList);
- startIndex := I;
- until I >= endIndex;
- end
- else
- if endIndex - startIndex > 0 then
- begin
- p := refList.List^[startIndex];
- if refList.List^[endIndex] < p then
- begin
- refList.Exchange(startIndex, endIndex);
- objList.Exchange(startIndex, endIndex);
- end;
- end;
- end;
- procedure QuickSortLists(startIndex, endIndex: Integer; refList: TGLSingleList; objList: TGLBaseList);
- var
- I, J: Integer;
- P: Single;
- begin
- if endIndex - startIndex > 1 then
- begin
- repeat
- I := startIndex;
- J := endIndex;
- P := refList.List^[(I + J) shr 1];
- repeat
- while Single(refList.List^[I]) < P do
- Inc(I);
- while Single(refList.List^[J]) > P do
- Dec(J);
- if I <= J then
- begin
- refList.Exchange(I, J);
- objList.Exchange(I, J);
- Inc(I);
- Dec(J);
- end;
- until I > J;
- if startIndex < J then
- QuickSortLists(startIndex, J, refList, objList);
- startIndex := I;
- until I >= endIndex;
- end
- else
- if endIndex - startIndex > 0 then
- begin
- p := refList.List^[startIndex];
- if refList.List^[endIndex] < p then
- begin
- refList.Exchange(startIndex, endIndex);
- objList.Exchange(startIndex, endIndex);
- end;
- end;
- end;
- procedure FastInsertionSortLists(startIndex, endIndex: Integer; const ppl: PIntegerArray; const oppl: PPointerArray); inline;
- var
- oTemp: Pointer;
- I, J: Integer;
- Temp: Integer;
- begin
- for I := startIndex+1 to endIndex-1 do
- begin
- J := i-1;
- Temp := ppl^[I];
- oTemp := oppl^[I];
- while (J>=startIndex) and (Temp < ppl^[J]) do
- begin
- ppl^[J+1] := ppl^[J];
- oppl^[J+1] := oppl^[J];
- Dec(j);
- end;
- ppl^[J+1] := Temp;
- oppl^[J+1] := oTemp;
- end;
- end;
- procedure FastQuickSortLists(startIndex, endIndex: Integer; const refList: TGLSingleList; const objList: TGLPersistentObjectList);
- var
- ppl: PIntegerArray;
- oTemp: Pointer;
- oppl: PPointerArray;
- I, J: Integer;
- p, Temp: Integer;
- begin
- // All singles are >=1, so IEEE format allows comparing them as if they were integers
- ppl := PIntegerArray(@refList.List[0]);
- oppl := PPointerArray(objList.List);
- if endIndex > startIndex + 1 then
- begin
- if (endIndex-startIndex)<16 then
- begin
- FastInsertionSortLists(startIndex, endIndex, ppl, oppl);
- end else
- begin
- repeat
- I := startIndex;
- J := endIndex;
- p := PInteger(@refList.List[(I + J) shr 1])^;
- repeat
- while ppl^[I] < p do
- Inc(I);
- while ppl^[J] > p do
- Dec(J);
- if I <= J then
- begin
- // swap integers
- Temp := ppl^[I];
- ppl^[I] := ppl^[J];
- ppl^[J] := Temp;
- // swap pointers
- oTemp := oppl^[I];
- oppl^[I] := oppl^[J];
- oppl^[J] := oTemp;
- Inc(I);
- Dec(J);
- end;
- until I > J;
- if startIndex < J then
- FastQuickSortLists(startIndex, J, refList, objList);
- startIndex := I;
- until I >= endIndex;
- end;
- end else if endIndex > startIndex then
- begin
- if ppl^[endIndex] < ppl^[startIndex] then
- begin
- I := endIndex;
- J := startIndex;
- // swap integers
- Temp := ppl^[I];
- ppl^[I] := ppl^[J];
- ppl^[J] := Temp;
- // swap pointers
- oTemp := oppl^[I];
- oppl^[I] := oppl^[J];
- oppl^[J] := oTemp;
- end;
- end;
- end;
- // ------------------
- // ------------------ TGLBaseList ------------------
- // ------------------
- constructor TGLBaseList.Create;
- begin
- inherited Create;
- FOptions := [bloSetCountResetsMemory];
- end;
- destructor TGLBaseList.Destroy;
- begin
- Clear;
- if Assigned(FBufferItem) then
- FreeMem(FBufferItem);
- inherited;
- end;
- procedure TGLBaseList.Assign(Src: TPersistent);
- begin
- if (Src is TGLBaseList) then
- begin
- SetCapacity(TGLBaseList(Src).Count);
- FGrowthDelta := TGLBaseList(Src).FGrowthDelta;
- FCount := FCapacity;
- FTagString := TGLBaseList(Src).FTagString;
- Inc(FRevision);
- end
- else
- inherited;
- end;
- procedure TGLBaseList.DefineProperties(AFiler: TFiler);
- begin
- inherited DefineProperties(AFiler);
- AFiler.DefineProperty('Items', ReadItemsData, WriteItemsData, True);
- end;
- procedure TGLBaseList.ReadItemsData(AReader: TReader);
- var
- lData: AnsiString;
- lOutputText: string;
- begin
- lOutputText := AReader.ReadString;
- SetLength(lData, Length(lOutputText) div 2 + 1);
- HexToBin(PChar(lOutputText), PAnsiChar(lData), Length(lData));
- LoadFromString(string(lData));
- end;
- procedure TGLBaseList.WriteItemsData(AWriter: TWriter);
- var
- lData: AnsiString;
- lOutputText: String;
- begin
- lData := AnsiString(SaveToString);
- SetLength(lOutputText, Length(lData) * 2);
- BinToHex(PAnsiChar(lData), PChar(lOutputText), Length(lData));
- AWriter.WriteString(lOutputText);
- end;
- procedure TGLBaseList.WriteToFiler(writer: TGLVirtualWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(0); // Archive Version 0
- WriteInteger(Count);
- WriteInteger(FItemSize);
- if Count > 0 then
- write(FBaseList[0], Count * FItemSize);
- end;
- end;
- procedure TGLBaseList.ReadFromFiler(reader: TGLVirtualReader);
- var
- archiveVersion: Integer;
- begin
- inherited;
- archiveVersion := reader.ReadInteger;
- if archiveVersion = 0 then
- with reader do
- begin
- FCount := ReadInteger;
- FItemSize := ReadInteger;
- SetCapacity(Count);
- if Count > 0 then
- read(FBaseList[0], Count * FItemSize);
- end
- else
- RaiseFilerException(archiveVersion);
- Inc(FRevision);
- end;
- procedure TGLBaseList.SetCount(Val: Integer);
- begin
- Assert(Val >= 0);
- if Val > FCapacity then
- SetCapacity(Val);
- if (Val > FCount) and (bloSetCountResetsMemory in FOptions) then
- FillChar(FBaseList[FItemSize * FCount], (Val - FCount) * FItemSize, 0);
- FCount := Val;
- Inc(FRevision);
- end;
- procedure TGLBaseList.SetCapacity(newCapacity: Integer);
- begin
- if newCapacity <> FCapacity then
- begin
- if bloExternalMemory in FOptions then
- begin
- Exclude(FOptions, bloExternalMemory);
- FBaseList := nil;
- end;
- ReallocMem(FBaseList, newCapacity * FItemSize);
- FCapacity := newCapacity;
- Inc(FRevision);
- end;
- end;
- procedure TGLBaseList.AddNulls(nbVals: Cardinal);
- begin
- if Integer(nbVals) + Count > Capacity then
- SetCapacity(Integer(nbVals) + Count);
- FillChar(FBaseList[FCount * FItemSize], Integer(nbVals) * FItemSize, 0);
- FCount := FCount + Integer(nbVals);
- Inc(FRevision);
- end;
- procedure TGLBaseList.InsertNulls(Index: Integer; nbVals: Cardinal);
- var
- nc: Integer;
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- if nbVals > 0 then
- begin
- nc := FCount + Integer(nbVals);
- if nc > FCapacity then
- SetCapacity(nc);
- if Index < FCount then
- System.Move(FBaseList[Index * FItemSize],
- FBaseList[(Index + Integer(nbVals)) * FItemSize],
- (FCount - Index) * FItemSize);
- FillChar(FBaseList[Index * FItemSize], Integer(nbVals) * FItemSize, 0);
- FCount := nc;
- Inc(FRevision);
- end;
- end;
- procedure TGLBaseList.AdjustCapacityToAtLeast(const size: Integer);
- begin
- if Capacity < size then
- Capacity := size;
- end;
- function TGLBaseList.DataSize: Integer;
- begin
- Result := FItemSize * FCount;
- end;
- function TGLBaseList.BufferItem: PByteArray;
- begin
- if not Assigned(FBufferItem) then
- GetMem(FBufferItem, FItemSize);
- Result := FBufferItem;
- end;
- function TGLBaseList.GetSetCountResetsMemory: Boolean;
- begin
- Result := (bloSetCountResetsMemory in FOptions);
- end;
- procedure TGLBaseList.SetSetCountResetsMemory(const Val: Boolean);
- begin
- if Val then
- Include(FOptions, bloSetCountResetsMemory)
- else
- Exclude(FOptions, bloSetCountResetsMemory);
- end;
- procedure TGLBaseList.UseMemory(rangeStart: Pointer; rangeCapacity: Integer);
- begin
- rangeCapacity := rangeCapacity div FItemSize;
- if rangeCapacity < FCount then
- Exit;
- // transfer data
- System.Move(FBaseList^, rangeStart^, FCount * FItemSize);
- if not (bloExternalMemory in FOptions) then
- begin
- FreeMem(FBaseList);
- Include(FOptions, bloExternalMemory);
- end;
- FBaseList := rangeStart;
- FCapacity := rangeCapacity;
- SetCapacity(FCapacity); // notify subclasses
- end;
- procedure TGLBaseList.Flush;
- begin
- if Assigned(Self) then
- begin
- SetCount(0);
- end;
- end;
- procedure TGLBaseList.Clear;
- begin
- if Assigned(Self) then
- begin
- SetCount(0);
- SetCapacity(0);
- end;
- end;
- procedure TGLBaseList.Delete(Index: Integer);
- begin
- {$IFOPT R+}
- Assert(Cardinal(index) < Cardinal(FCount));
- {$ENDIF}
- Dec(FCount);
- if Index < FCount then
- System.Move(FBaseList[(Index + 1) * FItemSize],
- FBaseList[Index * FItemSize],
- (FCount - Index) * FItemSize);
- Inc(FRevision);
- end;
- procedure TGLBaseList.DeleteItems(Index: Integer; nbVals: Cardinal);
- begin
- {$IFOPT R+}
- Assert(Cardinal(index) < Cardinal(FCount));
- {$ENDIF}
- if nbVals > 0 then
- begin
- if Index + Integer(nbVals) < FCount then
- begin
- System.Move(FBaseList[(Index + Integer(nbVals)) * FItemSize],
- FBaseList[Index * FItemSize],
- (FCount - Index - Integer(nbVals)) * FItemSize);
- end;
- Dec(FCount, nbVals);
- Inc(FRevision);
- end;
- end;
- procedure TGLBaseList.Exchange(index1, index2: Integer);
- var
- buf: Integer;
- p: PIntegerArray;
- begin
- {$IFOPT R+}
- Assert((Cardinal(index1) < Cardinal(FCount)) and (Cardinal(index2) < Cardinal(FCount)));
- {$ENDIF}
- if FItemSize = 4 then
- begin
- p := PIntegerArray(FBaseList);
- buf := p^[index1];
- p^[index1] := p^[index2];
- p^[index2] := buf;
- end
- else
- begin
- System.Move(FBaseList[index1 * FItemSize], BufferItem[0], FItemSize);
- System.Move(FBaseList[index2 * FItemSize], FBaseList[index1 * FItemSize], FItemSize);
- System.Move(BufferItem[0], FBaseList[index2 * FItemSize], FItemSize);
- end;
- Inc(FRevision);
- end;
- procedure TGLBaseList.Move(curIndex, newIndex: Integer);
- begin
- if curIndex <> newIndex then
- begin
- {$IFOPT R+}
- Assert(Cardinal(newIndex) < Cardinal(Count));
- Assert(Cardinal(curIndex) < Cardinal(Count));
- {$ENDIF}
- if FItemSize = 4 then
- PInteger(BufferItem)^ := PInteger(@FBaseList[curIndex * FItemSize])^
- else
- System.Move(FBaseList[curIndex * FItemSize], BufferItem[0], FItemSize);
- if curIndex < newIndex then
- begin
- // curIndex+1 necessarily exists since curIndex<newIndex and newIndex<Count
- System.Move(FBaseList[(curIndex + 1) * FItemSize], FBaseList[curIndex * FItemSize],
- (newIndex - curIndex) * FItemSize);
- end
- else
- begin
- // newIndex+1 necessarily exists since newIndex<curIndex and curIndex<Count
- System.Move(FBaseList[newIndex * FItemSize], FBaseList[(newIndex + 1) * FItemSize],
- (curIndex - newIndex) * FItemSize);
- end;
- if FItemSize = 4 then
- PInteger(@FBaseList[newIndex * FItemSize])^ := PInteger(BufferItem)^
- else
- System.Move(BufferItem[0], FBaseList[newIndex * FItemSize], FItemSize);
- Inc(FRevision);
- end;
- end;
- procedure TGLBaseList.Reverse;
- var
- s, e: Integer;
- begin
- s := 0;
- e := Count - 1;
- while s < e do
- begin
- Exchange(s, e);
- Inc(s);
- Dec(e);
- end;
- Inc(FRevision);
- end;
- // ------------------
- // ------------------ TGLBaseVectorList ------------------
- // ------------------
- procedure TGLBaseVectorList.WriteToFiler(writer: TGLVirtualWriter);
- begin
- inherited;
- if Self is TGLTexPointList then
- exit;
- with writer do
- begin
- WriteInteger(0); // Archive Version 0
- // nothing
- end;
- end;
- procedure TGLBaseVectorList.ReadFromFiler(reader: TGLVirtualReader);
- var
- archiveVersion: Integer;
- begin
- inherited;
- if Self is TGLTexPointList then
- exit;
- archiveVersion := reader.ReadInteger;
- if archiveVersion = 0 then
- with reader do
- begin
- // nothing
- end
- else
- RaiseFilerException(archiveVersion);
- end;
- procedure TGLBaseVectorList.GetExtents(out min, max: TAffineVector);
- var
- I, K: Integer;
- f: Single;
- ref: PFloatArray;
- const
- cBigValue: Single = 1E50;
- cSmallValue: Single = -1E50;
- begin
- SetVector(min, cBigValue, cBigValue, cBigValue);
- SetVector(max, cSmallValue, cSmallValue, cSmallValue);
- for I := 0 to Count - 1 do
- begin
- ref := ItemAddress[I];
- for K := 0 to 2 do
- begin
- f := ref^[K];
- if f < min.V[K] then
- min.V[K] := f;
- if f > max.V[K] then
- max.V[K] := f;
- end;
- end;
- end;
- function TGLBaseVectorList.Sum: TAffineVector;
- var
- I: Integer;
- begin
- Result := NullVector;
- for I := 0 to Count - 1 do
- AddVector(Result, PAffineVector(ItemAddress[I])^);
- end;
- procedure TGLBaseVectorList.Normalize;
- var
- I: Integer;
- begin
- for I := 0 to Count - 1 do
- NormalizeVector(PAffineVector(ItemAddress[I])^);
- Inc(FRevision);
- end;
- function TGLBaseVectorList.MaxSpacing(list2: TGLBaseVectorList): Single;
- var
- I: Integer;
- s: Single;
- begin
- Assert(list2.Count = Count);
- Result := 0;
- for I := 0 to Count - 1 do
- begin
- s := VectorSpacing(PAffineVector(ItemAddress[I])^,
- PAffineVector(list2.ItemAddress[I])^);
- if s > Result then
- Result := s;
- end;
- end;
- procedure TGLBaseVectorList.Translate(const delta: TAffineVector);
- var
- I: Integer;
- begin
- for I := 0 to Count - 1 do
- AddVector(PAffineVector(ItemAddress[I])^, delta);
- Inc(FRevision);
- end;
- procedure TGLBaseVectorList.Translate(const delta: TGLBaseVectorList);
- var
- I: Integer;
- begin
- Assert(Count <= delta.Count);
- for I := 0 to Count - 1 do
- AddVector(PAffineVector(ItemAddress[I])^, PAffineVector(delta.ItemAddress[I])^);
- Inc(FRevision);
- end;
- procedure TGLBaseVectorList.TranslateInv(const delta: TGLBaseVectorList);
- var
- I: Integer;
- begin
- Assert(Count <= delta.Count);
- for I := 0 to Count - 1 do
- SubtractVector(PAffineVector(ItemAddress[I])^, PAffineVector(delta.ItemAddress[I])^);
- Inc(FRevision);
- end;
- procedure TGLBaseVectorList.AngleLerp(const list1, list2: TGLBaseVectorList; lerpFactor: Single);
- var
- I: Integer;
- begin
- Assert(list1.Count = list2.Count);
- if list1 <> list2 then
- begin
- if lerpFactor = 0 then
- Assign(list1)
- else
- if lerpFactor = 1 then
- Assign(list2)
- else
- begin
- Capacity := list1.Count;
- FCount := list1.Count;
- for I := 0 to list1.Count - 1 do
- PAffineVector(ItemAddress[I])^ := VectorAngleLerp(PAffineVector(list1.ItemAddress[I])^,
- PAffineVector(list2.ItemAddress[I])^,
- lerpFactor);
- end;
- end
- else
- Assign(list1);
- Inc(FRevision);
- end;
- procedure TGLBaseVectorList.AngleCombine(const list1: TGLBaseVectorList; intensity: Single);
- var
- I: Integer;
- begin
- Assert(list1.Count = Count);
- for I := 0 to Count - 1 do
- PAffineVector(ItemAddress[I])^ := VectorAngleCombine(PAffineVector(ItemAddress[I])^,
- PAffineVector(list1.ItemAddress[I])^,
- intensity);
- Inc(FRevision);
- end;
- procedure TGLBaseVectorList.Combine(const list2: TGLBaseVectorList; factor: Single);
- var
- I: Integer;
- begin
- Assert(list2.Count >= Count);
- for I := 0 to Count - 1 do
- CombineVector(PAffineVector(ItemAddress[I])^,
- PAffineVector(list2.ItemAddress[I])^,
- factor);
- Inc(FRevision);
- end;
- function TGLBaseVectorList.GetItemAddress(Index: Integer): PFloatArray;
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- Result := PFloatArray(@FBaseList[Index * FItemSize]);
- end;
- // ------------------
- // ------------------ TGLAffineVectorList ------------------
- // ------------------
- constructor TGLAffineVectorList.Create;
- begin
- FItemSize := SizeOf(TAffineVector);
- inherited Create;
- FGrowthDelta := cDefaultListGrowthDelta;
- end;
- procedure TGLAffineVectorList.Assign(Src: TPersistent);
- begin
- if Assigned(Src) then
- begin
- inherited;
- if (Src is TGLAffineVectorList) then
- System.Move(TGLAffineVectorList(Src).FList^, FList^, FCount * SizeOf(TAffineVector));
- end
- else
- Clear;
- end;
- function TGLAffineVectorList.Add(const item: TAffineVector): Integer;
- begin
- Result := FCount;
- if Result = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- FList^[Result] := Item;
- Inc(FCount);
- Inc(FRevision);
- end;
- function TGLAffineVectorList.Add(const item: TGLVector): Integer;
- begin
- Result := Add(PAffineVector(@item)^);
- end;
- procedure TGLAffineVectorList.Add(const i1, i2: TAffineVector);
- begin
- Inc(FCount, 2);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- FList^[FCount - 2] := i1;
- FList^[FCount - 1] := i2;
- Inc(FRevision);
- end;
- procedure TGLAffineVectorList.Add(const i1, i2, i3: TAffineVector);
- begin
- Inc(FCount, 3);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- FList^[FCount - 3] := i1;
- FList^[FCount - 2] := i2;
- FList^[FCount - 1] := i3;
- Inc(FRevision);
- end;
- function TGLAffineVectorList.Add(const item: TVector2f): Integer;
- begin
- Result := Add(AffineVectorMake(item.X, item.Y, 0));
- end;
- function TGLAffineVectorList.Add(const item: TTexPoint): Integer;
- begin
- Result := Add(AffineVectorMake(item.S, item.T, 0));
- end;
- function TGLAffineVectorList.Add(const X, Y: Single): Integer;
- var
- v: PAffineVector;
- begin
- Result := FCount;
- Inc(FCount);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- v := @List[Result];
- v^.X := X;
- v^.Y := Y;
- v^.Z := 0;
- Inc(FRevision);
- end;
- function TGLAffineVectorList.Add(const X, Y, Z: Single): Integer;
- var
- v: PAffineVector;
- begin
- Result := FCount;
- Inc(FCount);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- v := @List[Result];
- v^.X := X;
- v^.Y := Y;
- v^.Z := Z;
- Inc(FRevision);
- end;
- function TGLAffineVectorList.Add(const X, Y, Z: Integer): Integer;
- var
- v: PAffineVector;
- begin
- Result := FCount;
- if Result = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- v := @List[Result];
- v^.X := X;
- v^.Y := Y;
- v^.Z := Z;
- Inc(FCount);
- Inc(FRevision);
- end;
- function TGLAffineVectorList.AddNC(const X, Y, Z: Integer): Integer;
- var
- v: PAffineVector;
- begin
- Result := FCount;
- v := @List[Result];
- v^.X := X;
- v^.Y := Y;
- v^.Z := Z;
- Inc(FCount);
- Inc(FRevision);
- end;
- function TGLAffineVectorList.Add(const xy: PIntegerArray; const Z: Integer): Integer;
- var
- v: PAffineVector;
- begin
- Result := FCount;
- if Result = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- v := @List[Result];
- v^.X := xy^[0];
- v^.Y := xy^[1];
- v^.Z := Z;
- Inc(FCount);
- Inc(FRevision);
- end;
- function TGLAffineVectorList.AddNC(const xy: PIntegerArray; const Z: Integer): Integer;
- var
- v: PAffineVector;
- begin
- Result := FCount;
- v := @List[Result];
- v^.X := xy^[0];
- v^.Y := xy^[1];
- v^.Z := Z;
- Inc(FCount);
- Inc(FRevision);
- end;
- procedure TGLAffineVectorList.Add(const list: TGLAffineVectorList);
- begin
- if Assigned(list) and (list.Count > 0) then
- begin
- if Count + list.Count > Capacity then
- Capacity := Count + list.Count;
- System.Move(list.FList[0], FList[Count], list.Count * SizeOf(TAffineVector));
- Inc(FCount, list.Count);
- end;
- Inc(FRevision);
- end;
- function TGLAffineVectorList.Get(Index: Integer): TAffineVector;
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- Result := FList^[Index];
- end;
- procedure TGLAffineVectorList.Insert(Index: Integer; const Item: TAffineVector);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- if FCount = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- if Index < FCount then
- System.Move(FList[Index], FList[Index + 1],
- (FCount - Index) * SizeOf(TAffineVector));
- FList^[Index] := Item;
- Inc(FCount);
- Inc(FRevision);
- end;
- function TGLAffineVectorList.IndexOf(const item: TAffineVector): Integer;
- var
- I: Integer;
- begin
- Result := -1;
- for I := 0 to Count - 1 do
- if VectorEquals(item, FList^[I]) then
- begin
- Result := I;
- Break;
- end;
- end;
- function TGLAffineVectorList.FindOrAdd(const item: TAffineVector): Integer;
- begin
- Result := IndexOf(item);
- if Result < 0 then
- begin
- Result := Add(item);
- Inc(FRevision);
- end;
- end;
- procedure TGLAffineVectorList.Put(Index: Integer; const Item: TAffineVector);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- FList^[Index] := Item;
- Inc(FRevision);
- end;
- procedure TGLAffineVectorList.SetCapacity(NewCapacity: Integer);
- begin
- inherited;
- FList := PAffineVectorArray(FBaseList);
- end;
- procedure TGLAffineVectorList.Push(const Val: TAffineVector);
- begin
- Add(Val);
- end;
- function TGLAffineVectorList.Pop: TAffineVector;
- begin
- if FCount > 0 then
- begin
- Result := Get(FCount - 1);
- Delete(FCount - 1);
- Inc(FRevision);
- end
- else
- Result := NullVector;
- end;
- procedure TGLAffineVectorList.Translate(const delta: TAffineVector);
- begin
- VectorArrayAdd(FList, delta, Count, FList);
- Inc(FRevision);
- end;
- procedure TGLAffineVectorList.Translate(const delta: TAffineVector; base, nb: Integer);
- begin
- VectorArrayAdd(@FList[base], delta, nb, @FList[base]);
- Inc(FRevision);
- end;
- procedure TGLAffineVectorList.TranslateItem(Index: Integer; const delta: TAffineVector);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- AddVector(FList^[Index], delta);
- Inc(FRevision);
- end;
- procedure TGLAffineVectorList.TranslateItems(Index: Integer; const delta: TAffineVector; nb: Integer);
- begin
- nb := Index + nb;
- {$IFOPT R+}
- Assert(Cardinal(index) < Cardinal(FCount));
- if nb > FCount then
- nb := FCount;
- {$ENDIF}
- VectorArrayAdd(@FList[Index], delta, nb - Index, @FList[Index]);
- Inc(FRevision);
- end;
- procedure TGLAffineVectorList.CombineItem(Index: Integer; const vector: TAffineVector; const f: Single);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- CombineVector(FList^[Index], vector, @f);
- Inc(FRevision);
- end;
- procedure TGLAffineVectorList.TransformAsPoints(const matrix: TGLMatrix);
- var
- I: Integer;
- begin
- for I := 0 to FCount - 1 do
- FList^[I] := VectorTransform(FList^[I], matrix);
- Inc(FRevision);
- end;
- procedure TGLAffineVectorList.TransformAsVectors(const matrix: TGLMatrix);
- var
- m: TAffineMatrix;
- begin
- if FCount > 0 then
- begin
- SetMatrix(m, matrix);
- TransformAsVectors(m);
- end;
- end;
- procedure TGLAffineVectorList.TransformAsVectors(const matrix: TAffineMatrix);
- var
- I: Integer;
- begin
- for I := 0 to FCount - 1 do
- FList^[I] := VectorTransform(FList^[I], matrix);
- Inc(FRevision);
- end;
- procedure TGLAffineVectorList.Normalize;
- begin
- NormalizeVectorArray(List, Count);
- Inc(FRevision);
- end;
- procedure TGLAffineVectorList.Lerp(const list1, list2: TGLBaseVectorList; lerpFactor: Single);
- begin
- if (list1 is TGLAffineVectorList) and (list2 is TGLAffineVectorList) then
- begin
- Assert(list1.Count = list2.Count);
- Capacity := list1.Count;
- FCount := list1.Count;
- VectorArrayLerp(TGLAffineVectorList(list1).List, TGLAffineVectorList(list2).List,
- lerpFactor, FCount, List);
- Inc(FRevision);
- end;
- end;
- procedure TGLAffineVectorList.Scale(factor: Single);
- begin
- if (Count > 0) and (factor <> 1) then
- begin
- ScaleFloatArray(@FList[0].X, Count * 3, factor);
- Inc(FRevision);
- end;
- end;
- procedure TGLAffineVectorList.Scale(const factors: TAffineVector);
- var
- I: Integer;
- begin
- for I := 0 to Count - 1 do
- ScaleVector(FList^[I], factors);
- Inc(FRevision);
- end;
- // ------------------
- // ------------------ TGLVectorList ------------------
- // ------------------
- constructor TGLVectorList.Create;
- begin
- FItemSize := SizeOf(TGLVector);
- inherited Create;
- FGrowthDelta := cDefaultListGrowthDelta;
- end;
- procedure TGLVectorList.Assign(Src: TPersistent);
- begin
- if Assigned(Src) then
- begin
- inherited;
- if (Src is TGLVectorList) then
- System.Move(TGLVectorList(Src).FList^, FList^, FCount * SizeOf(TGLVector));
- end
- else
- Clear;
- end;
- function TGLVectorList.Add(const item: TGLVector): Integer;
- begin
- Result := FCount;
- if Result = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- FList^[Result] := Item;
- Inc(FCount);
- end;
- function TGLVectorList.Add(const item: TAffineVector; w: Single): Integer;
- begin
- Result := Add(VectorMake(item, w));
- end;
- function TGLVectorList.Add(const X, Y, Z, w: Single): Integer;
- begin
- Result := Add(VectorMake(X, Y, Z, w));
- end;
- procedure TGLVectorList.Add(const i1, i2, i3: TAffineVector; w: Single);
- begin
- Inc(FCount, 3);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- PAffineVector(@FList[FCount - 3])^ := i1;
- FList^[FCount - 3].W := w;
- PAffineVector(@FList[FCount - 2])^ := i2;
- FList^[FCount - 2].W := w;
- PAffineVector(@FList[FCount - 1])^ := i3;
- FList^[FCount - 1].W := w;
- end;
- function TGLVectorList.AddVector(const item: TAffineVector): Integer;
- begin
- Result := Add(VectorMake(item));
- end;
- function TGLVectorList.AddPoint(const item: TAffineVector): Integer;
- begin
- Result := Add(PointMake(item));
- end;
- function TGLVectorList.AddPoint(const X, Y: Single; const Z: Single = 0): Integer;
- begin
- Result := Add(PointMake(X, Y, Z));
- end;
- function TGLVectorList.Get(Index: Integer): TGLVector;
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- Result := FList^[Index];
- end;
- procedure TGLVectorList.Insert(Index: Integer; const Item: TGLVector);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- if FCount = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- if Index < FCount then
- System.Move(FList[Index], FList[Index + 1],
- (FCount - Index) * SizeOf(TGLVector));
- FList^[Index] := Item;
- Inc(FCount);
- end;
- procedure TGLVectorList.Put(Index: Integer; const Item: TGLVector);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- FList^[Index] := Item;
- end;
- procedure TGLVectorList.SetCapacity(NewCapacity: Integer);
- begin
- inherited;
- FList := PVectorArray(FBaseList);
- end;
- procedure TGLVectorList.Push(const Val: TGLVector);
- begin
- Add(Val);
- end;
- function TGLVectorList.Pop: TGLVector;
- begin
- if FCount > 0 then
- begin
- Result := Get(FCount - 1);
- Delete(FCount - 1);
- end
- else
- Result := NullHmgVector;
- end;
- function TGLVectorList.IndexOf(const item: TGLVector): Integer;
- var
- I: Integer;
- begin
- Result := -1;
- for I := 0 to Count - 1 do
- if VectorEquals(item, FList^[I]) then
- begin
- Result := I;
- Break;
- end;
- end;
- function TGLVectorList.FindOrAdd(const item: TGLVector): Integer;
- begin
- Result := IndexOf(item);
- if Result < 0 then
- Result := Add(item);
- end;
- function TGLVectorList.FindOrAddPoint(const item: TAffineVector): Integer;
- var
- ptItem: TGLVector;
- begin
- MakePoint(ptItem, item);
- Result := IndexOf(ptItem);
- if Result < 0 then
- Result := Add(ptItem);
- end;
- procedure TGLVectorList.Lerp(const list1, list2: TGLBaseVectorList; lerpFactor: Single);
- begin
- if (list1 is TGLVectorList) and (list2 is TGLVectorList) then
- begin
- Assert(list1.Count = list2.Count);
- Capacity := list1.Count;
- FCount := list1.Count;
- VectorArrayLerp(TGLVectorList(list1).List, TGLVectorList(list2).List,
- lerpFactor, FCount, List);
- end;
- end;
- // ------------------
- // ------------------ TGLTexPointList ------------------
- // ------------------
- constructor TGLTexPointList.Create;
- begin
- FItemSize := SizeOf(TTexPoint);
- inherited Create;
- FGrowthDelta := cDefaultListGrowthDelta;
- end;
- procedure TGLTexPointList.Assign(Src: TPersistent);
- begin
- if Assigned(Src) then
- begin
- inherited;
- if (Src is TGLTexPointList) then
- System.Move(TGLTexPointList(Src).FList^, FList^, FCount * SizeOf(TTexPoint));
- end
- else
- Clear;
- end;
- function TGLTexPointList.IndexOf(const item: TTexpoint): Integer;
- var
- I: Integer;
- begin
- Result := -1;
- for I := 0 to Count - 1 do
- if TexpointEquals(FList^[I], item) then
- begin
- Result := I;
- Break;
- end;
- end;
- function TGLTexPointList.FindOrAdd(const item: TTexPoint): Integer;
- begin
- Result := IndexOf(item);
- if Result < 0 then
- Result := Add(item);
- end;
- function TGLTexPointList.Add(const item: TTexPoint): Integer;
- begin
- Result := FCount;
- if Result = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- FList^[Result] := Item;
- Inc(FCount);
- end;
- function TGLTexPointList.Add(const item: TVector2f): Integer;
- begin
- Result := FCount;
- if Result = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- FList^[Result] := PTexPoint(@Item)^;
- Inc(FCount);
- end;
- function TGLTexPointList.Add(const texS, Text: Single): Integer;
- begin
- Result := FCount;
- if Result = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- with FList^[Result] do
- begin
- s := texS;
- t := Text;
- end;
- Inc(FCount);
- end;
- function TGLTexPointList.Add(const texS, Text: Integer): Integer;
- begin
- Result := FCount;
- if Result = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- with FList^[Result] do
- begin
- s := texS;
- t := Text;
- end;
- Inc(FCount);
- end;
- function TGLTexPointList.AddNC(const texS, Text: Integer): Integer;
- begin
- Result := FCount;
- with FList^[Result] do
- begin
- s := texS;
- t := Text;
- end;
- Inc(FCount);
- end;
- function TGLTexPointList.Add(const texST: PIntegerArray): Integer;
- begin
- Result := FCount;
- if Result = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- with FList^[Result] do
- begin
- s := texST^[0];
- t := texST^[1];
- end;
- Inc(FCount);
- end;
- function TGLTexPointList.AddNC(const texST: PIntegerArray): Integer;
- begin
- Result := FCount;
- with FList^[Result] do
- begin
- s := texST^[0];
- t := texST^[1];
- end;
- Inc(FCount);
- end;
- function TGLTexPointList.Get(Index: Integer): TTexPoint;
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- Result := FList^[Index];
- end;
- procedure TGLTexPointList.Insert(Index: Integer; const Item: TTexPoint);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- if FCount = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- if Index < FCount then
- System.Move(FList[Index], FList[Index + 1],
- (FCount - Index) * SizeOf(TTexPoint));
- FList^[Index] := Item;
- Inc(FCount);
- end;
- procedure TGLTexPointList.Put(Index: Integer; const Item: TTexPoint);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- FList^[Index] := Item;
- end;
- procedure TGLTexPointList.SetCapacity(NewCapacity: Integer);
- begin
- inherited;
- FList := PTexPointArray(FBaseList);
- end;
- procedure TGLTexPointList.Push(const Val: TTexPoint);
- begin
- Add(Val);
- end;
- function TGLTexPointList.Pop: TTexPoint;
- begin
- if FCount > 0 then
- begin
- Result := Get(FCount - 1);
- Delete(FCount - 1);
- end
- else
- Result := NullTexPoint;
- end;
- procedure TGLTexPointList.Translate(const delta: TTexPoint);
- begin
- TexPointArrayAdd(List, delta, FCount, FList);
- end;
- procedure TGLTexPointList.ScaleAndTranslate(const scale, delta: TTexPoint);
- begin
- TexPointArrayScaleAndAdd(FList, delta, FCount, scale, FList);
- end;
- procedure TGLTexPointList.ScaleAndTranslate(const scale, delta: TTexPoint; base, nb: Integer);
- var
- p: PTexPointArray;
- begin
- p := @FList[base];
- TexPointArrayScaleAndAdd(p, delta, nb, scale, p);
- end;
- procedure TGLTexPointList.Lerp(const list1, list2: TGLBaseVectorList; lerpFactor: Single);
- begin
- if (list1 is TGLTexPointList) and (list2 is TGLTexPointList) then
- begin
- Assert(list1.Count = list2.Count);
- Capacity := list1.Count;
- FCount := list1.Count;
- VectorArrayLerp(TGLTexPointList(list1).List, TGLTexPointList(list2).List,
- lerpFactor, FCount, List);
- end;
- end;
- // ------------------
- // ------------------ TGLIntegerList ------------------
- // ------------------
- constructor TGLIntegerList.Create;
- begin
- FItemSize := SizeOf(Integer);
- inherited Create;
- FGrowthDelta := cDefaultListGrowthDelta;
- end;
- procedure TGLIntegerList.Assign(Src: TPersistent);
- begin
- if Assigned(Src) then
- begin
- inherited;
- if (Src is TGLIntegerList) then
- System.Move(TGLIntegerList(Src).FList^, FList^, FCount * SizeOf(Integer));
- end
- else
- Clear;
- end;
- function TGLIntegerList.Add(const item: Integer): Integer;
- begin
- Result := FCount;
- if Result = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- FList^[Result] := Item;
- Inc(FCount);
- end;
- function TGLIntegerList.AddNC(const item: Integer): Integer;
- begin
- Result := FCount;
- FList^[Result] := Item;
- Inc(FCount);
- end;
- procedure TGLIntegerList.Add(const i1, i2: Integer);
- var
- tmpList : PIntegerArray;
- begin
- Inc(FCount, 2);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- tmpList := @FList[FCount - 2];
- tmpList^[0] := i1;
- tmpList^[1] := i2;
- end;
- procedure TGLIntegerList.Add(const i1, i2, i3: Integer);
- var
- tmpList : PIntegerArray;
- begin
- Inc(FCount, 3);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- tmpList := @FList[FCount - 3];
- tmpList^[0] := i1;
- tmpList^[1] := i2;
- tmpList^[2] := i3;
- end;
- procedure TGLIntegerList.Add(const AList: TGLIntegerList);
- begin
- if Assigned(AList) and (AList.Count > 0) then
- begin
- if Count + AList.Count > Capacity then
- Capacity := Count + AList.Count;
- System.Move(AList.FList[0], FList[Count], AList.Count * SizeOf(Integer));
- Inc(FCount, AList.Count);
- end;
- end;
- function TGLIntegerList.Get(Index: Integer): Integer;
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- Result := FList^[Index];
- end;
- procedure TGLIntegerList.Insert(Index: Integer; const Item: Integer);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- if FCount = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- if Index < FCount then
- System.Move(FList[Index], FList[Index + 1], (FCount - Index) * SizeOf(Integer));
- FList^[Index] := Item;
- Inc(FCount);
- end;
- procedure TGLIntegerList.Remove(const item: Integer);
- var
- I: Integer;
- begin
- for I := 0 to Count - 1 do
- begin
- if FList^[I] = item then
- begin
- System.Move(FList[I + 1], FList[I], (FCount - 1 - I) * SizeOf(Integer));
- Dec(FCount);
- Break;
- end;
- end;
- end;
- procedure TGLIntegerList.Put(Index: Integer; const Item: Integer);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- FList^[Index] := Item;
- end;
- procedure TGLIntegerList.SetCapacity(NewCapacity: Integer);
- begin
- inherited;
- FList := PIntegerArray(FBaseList);
- end;
- procedure TGLIntegerList.Push(const Val: Integer);
- begin
- Add(Val);
- end;
- function TGLIntegerList.Pop: Integer;
- begin
- if FCount > 0 then
- begin
- Result := FList^[FCount - 1];
- Delete(FCount - 1);
- end
- else
- Result := 0;
- end;
- procedure TGLIntegerList.AddSerie(aBase, aDelta, aCount: Integer);
- var
- tmpList : PInteger;
- I: Integer;
- begin
- if aCount <= 0 then
- Exit;
- AdjustCapacityToAtLeast(Count + aCount);
- tmpList := @FList[Count];
- for I := Count to Count + aCount - 1 do
- begin
- tmpList^ := aBase;
- Inc(tmpList);
- aBase := aBase + aDelta;
- end;
- FCount := Count + aCount;
- end;
- procedure TGLIntegerList.AddIntegers(const First: PInteger; n: Integer);
- begin
- if n < 1 then
- Exit;
- AdjustCapacityToAtLeast(Count + n);
- System.Move(First^, FList[FCount], n * SizeOf(Integer));
- FCount := FCount + n;
- end;
- procedure TGLIntegerList.AddIntegers(const aList: TGLIntegerList);
- begin
- if not Assigned(aList) then
- Exit;
- AddIntegers(@aList.List[0], aList.Count);
- end;
- procedure TGLIntegerList.AddIntegers(const anArray: array of Integer);
- var
- n: Integer;
- begin
- n := Length(anArray);
- if n > 0 then
- AddIntegers(@anArray[0], n);
- end;
- function IntegerSearch(item: Integer; list: PIntegerVector; Count: Integer): Integer; register; inline;
- var i : integer;
- begin
- result:=-1;
- for i := 0 to Count-1 do begin
- if list^[i]=item then begin
- result:=i;
- break;
- end;
- end;
- end;
- function TGLIntegerList.IndexOf(item: Integer): Integer; register;
- begin
- Result := IntegerSearch(item, FList, FCount);
- end;
- function TGLIntegerList.MinInteger: Integer;
- var
- I: Integer;
- locList: PIntegerVector;
- begin
- if FCount > 0 then
- begin
- locList := FList;
- Result := locList^[0];
- for I := 1 to FCount - 1 do
- if locList^[I] < Result then
- Result := locList^[I];
- end
- else
- Result := 0;
- end;
- function TGLIntegerList.MaxInteger: Integer;
- var
- I: Integer;
- locList: PIntegerVector;
- begin
- if FCount > 0 then
- begin
- locList := FList;
- Result := locList^[0];
- for I := 1 to FCount - 1 do
- if locList^[I] > Result then
- Result := locList^[I];
- end
- else
- Result := 0;
- end;
- procedure IntegerQuickSort(sortList: PIntegerArray; left, right: Integer);
- var
- I, J: Integer;
- p, t: Integer;
- begin
- repeat
- I := left;
- J := right;
- p := sortList^[(left + right) shr 1];
- repeat
- while sortList^[I] < p do
- Inc(I);
- while sortList^[J] > p do
- Dec(J);
- if I <= J then
- begin
- t := sortList^[I];
- sortList^[I] := sortList^[J];
- sortList^[J] := t;
- Inc(I);
- Dec(J);
- end;
- until I > J;
- if left < J then
- IntegerQuickSort(sortList, left, J);
- left := I;
- until I >= right;
- end;
- procedure TGLIntegerList.Sort;
- begin
- if (FList <> nil) and (Count > 1) then
- IntegerQuickSort(FList, 0, Count - 1);
- end;
- procedure TGLIntegerList.SortAndRemoveDuplicates;
- var
- I, J, lastVal: Integer;
- localList: PIntegerArray;
- begin
- if (FList <> nil) and (Count > 1) then
- begin
- IntegerQuickSort(FList, 0, Count - 1);
- J := 0;
- localList := FList;
- lastVal := localList^[J];
- for I := 1 to Count - 1 do
- begin
- if localList^[I] <> lastVal then
- begin
- lastVal := localList^[I];
- Inc(J);
- localList^[J] := lastVal;
- end;
- end;
- FCount := J + 1;
- end;
- end;
- function TGLIntegerList.BinarySearch(const Value: Integer): Integer;
- var
- found: Boolean;
- begin
- Result := BinarySearch(Value, False, found);
- end;
- function TGLIntegerList.BinarySearch(const Value: Integer; returnBestFit: Boolean; var found: Boolean): Integer;
- var
- Index: Integer;
- min, max, mid: Integer;
- intList: PIntegerArray;
- begin
- // Assume we won't find it
- found := False;
- // If the list is empty, we won't find the sought value!
- if Count = 0 then
- begin
- Result := -1;
- Exit;
- end;
- min := -1; // ONE OFF!
- max := Count; // ONE OFF!
- // We now know that Min and Max AREN'T the values!
- Index := -1;
- intList := List;
- repeat
- // Find the middle of the current scope
- mid := (min + max) shr 1;
- // Reduce the search scope by half
- if intList^[mid] <= Value then
- begin
- // Is this the one?
- if intList^[mid] = Value then
- begin
- Index := mid;
- found := True;
- Break;
- end
- else
- min := mid;
- end
- else
- max := mid;
- until min + 1 = max;
- if returnBestFit then
- begin
- if Index >= 0 then
- Result := Index
- else
- Result := min;
- end
- else
- Result := Index;
- end;
- function TGLIntegerList.AddSorted(const Value: Integer; const ignoreDuplicates: Boolean = False): Integer;
- var
- Index: Integer;
- found: Boolean;
- begin
- Index := BinarySearch(Value, True, found);
- if ignoreDuplicates and Found then
- Result := -1
- else
- begin
- Insert(Index + 1, Value);
- Result := Index + 1;
- end;
- end;
- procedure TGLIntegerList.RemoveSorted(const Value: Integer);
- var
- Index: Integer;
- begin
- Index := BinarySearch(Value);
- if Index >= 0 then
- Delete(Index);
- end;
- procedure TGLIntegerList.Offset(delta: Integer);
- var
- I: Integer;
- locList: PIntegerArray;
- begin
- locList := FList;
- for I := 0 to FCount - 1 do
- locList^[I] := locList^[I] + delta;
- end;
- procedure TGLIntegerList.Offset(delta: Integer; const base, nb: Integer);
- var
- I: Integer;
- locList: PIntegerArray;
- begin
- locList := FList;
- for I := base to base + nb - 1 do
- locList^[I] := locList^[I] + delta;
- end;
- // ------------------
- // ------------------ TGLSingleList ------------------
- // ------------------
- constructor TGLSingleList.Create;
- begin
- FItemSize := SizeOf(Single);
- inherited Create;
- FGrowthDelta := cDefaultListGrowthDelta;
- end;
- procedure TGLSingleList.Assign(Src: TPersistent);
- begin
- if Assigned(Src) then
- begin
- inherited;
- if (Src is TGLSingleList) then
- System.Move(TGLSingleList(Src).FList^, FList^, FCount * SizeOf(Single));
- end
- else
- Clear;
- end;
- function TGLSingleList.Add(const item: Single): Integer;
- begin
- Result := FCount;
- if Result = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- FList^[Result] := Item;
- Inc(FCount);
- end;
- procedure TGLSingleList.Add(const i1, i2: Single);
- var
- tmpList : PSingleArray;
- begin
- Inc(FCount, 2);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- tmpList := @FList[FCount - 2];
- tmpList^[0] := i1;
- tmpList^[1] := i2;
- end;
- procedure TGLSingleList.AddSingles(const First: PSingle; n: Integer);
- begin
- if n < 1 then
- Exit;
- AdjustCapacityToAtLeast(Count + n);
- System.Move(First^, FList[FCount], n * SizeOf(Single));
- FCount := FCount + n;
- end;
- procedure TGLSingleList.AddSingles(const anArray: array of Single);
- var
- n: Integer;
- begin
- n := Length(anArray);
- if n > 0 then
- AddSingles(@anArray[0], n);
- end;
- function TGLSingleList.Get(Index: Integer): Single;
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- Result := FList^[Index];
- end;
- procedure TGLSingleList.Insert(Index: Integer; const Item: Single);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- if FCount = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- if Index < FCount then
- System.Move(FList[Index], FList[Index + 1],
- (FCount - Index) * SizeOf(Single));
- FList^[Index] := Item;
- Inc(FCount);
- end;
- procedure TGLSingleList.Put(Index: Integer; const Item: Single);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- FList^[Index] := Item;
- end;
- procedure TGLSingleList.SetCapacity(NewCapacity: Integer);
- begin
- inherited;
- FList := PGLSingleArrayList(FBaseList);
- end;
- procedure TGLSingleList.Push(const Val: Single);
- begin
- Add(Val);
- end;
- function TGLSingleList.Pop: Single;
- begin
- if FCount > 0 then
- begin
- Result := Get(FCount - 1);
- Delete(FCount - 1);
- end
- else
- Result := 0;
- end;
- procedure TGLSingleList.AddSerie(aBase, aDelta: Single; aCount: Integer);
- var
- tmpList : PSingle;
- I: Integer;
- begin
- if aCount <= 0 then
- Exit;
- AdjustCapacityToAtLeast(Count + aCount);
- tmpList := @FList[Count];
- for I := Count to Count + aCount - 1 do
- begin
- tmpList^ := aBase;
- Inc(tmpList);
- aBase := aBase + aDelta;
- end;
- FCount := Count + aCount;
- end;
- procedure TGLSingleList.Offset(delta: Single);
- begin
- OffsetFloatArray(PFloatVector(FList), FCount, delta);
- end;
- procedure TGLSingleList.Offset(const delta: TGLSingleList);
- begin
- if FCount = delta.FCount then
- OffsetFloatArray(PFloatVector(FList), PFloatVector(delta.FList), FCount)
- else
- raise Exception.Create('SingleList count do not match');
- end;
- procedure TGLSingleList.Scale(factor: Single);
- begin
- ScaleFloatArray(PFloatVector(FList), FCount, factor);
- end;
- procedure TGLSingleList.Sqr;
- var
- I: Integer;
- locList: PGLSingleArrayList;
- begin
- locList := FList;
- for I := 0 to Count - 1 do
- locList^[I] := locList^[I] * locList^[I];
- end;
- procedure TGLSingleList.Sqrt;
- var
- I: Integer;
- locList: PGLSingleArrayList;
- begin
- locList := FList;
- for I := 0 to Count - 1 do
- locList^[I] := System.Sqrt(locList^[I]);
- end;
- function TGLSingleList.Sum: Single;
- var
- i: Integer;
- begin
- Result := 0;
- for i := 0 to FCount-1 do
- Result := Result + FList^[i];
- end;
- function TGLSingleList.Min: Single;
- var
- I: Integer;
- locList: PGLSingleArrayList;
- begin
- if FCount > 0 then
- begin
- locList := FList;
- Result := locList^[0];
- for I := 1 to FCount - 1 do
- if locList^[I] < Result then
- Result := locList^[I];
- end
- else
- Result := 0;
- end;
- function TGLSingleList.Max: Single;
- var
- I: Integer;
- locList: PGLSingleArrayList;
- begin
- if FCount > 0 then
- begin
- locList := FList;
- Result := locList^[0];
- for I := 1 to FCount - 1 do
- if locList^[I] > Result then
- Result := locList^[I];
- end
- else
- Result := 0;
- end;
- // ------------------
- // ------------------ TGLByteList ------------------
- // ------------------
- constructor TGLByteList.Create;
- begin
- FItemSize := SizeOf(Byte);
- inherited Create;
- FGrowthDelta := cDefaultListGrowthDelta;
- end;
- procedure TGLByteList.Assign(Src: TPersistent);
- begin
- if Assigned(Src) then
- begin
- inherited;
- if (Src is TGLByteList) then
- System.Move(TGLByteList(Src).FList^, FList^, FCount * SizeOf(Byte));
- end
- else
- Clear;
- end;
- function TGLByteList.Add(const item: Byte): Integer;
- begin
- Result := FCount;
- if Result = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- FList^[Result] := Item;
- Inc(FCount);
- end;
- function TGLByteList.Get(Index: Integer): Byte;
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- Result := FList^[Index];
- end;
- procedure TGLByteList.Insert(Index: Integer; const Item: Byte);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- if FCount = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- if Index < FCount then
- System.Move(FList[Index], FList[Index + 1],
- (FCount - Index) * SizeOf(Byte));
- FList^[Index] := Item;
- Inc(FCount);
- end;
- procedure TGLByteList.Put(Index: Integer; const Item: Byte);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- FList^[Index] := Item;
- end;
- procedure TGLByteList.SetCapacity(NewCapacity: Integer);
- begin
- inherited;
- FList := PByteArray(FBaseList);
- end;
- // ------------------
- // ------------------ TGLDoubleList ------------------
- // ------------------
- constructor TGLDoubleList.Create;
- begin
- FItemSize := SizeOf(Double);
- inherited Create;
- FGrowthDelta := cDefaultListGrowthDelta;
- end;
- procedure TGLDoubleList.Assign(Src: TPersistent);
- begin
- if Assigned(Src) then
- begin
- inherited;
- if (Src is TGLDoubleList) then
- System.Move(TGLDoubleList(Src).FList^, FList^, FCount * SizeOf(Double));
- end
- else
- Clear;
- end;
- function TGLDoubleList.Add(const item: Double): Integer;
- begin
- Result := FCount;
- if Result = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- FList^[Result] := Item;
- Inc(FCount);
- end;
- function TGLDoubleList.Get(Index: Integer): Double;
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- Result := FList^[Index];
- end;
- procedure TGLDoubleList.Insert(Index: Integer; const Item: Double);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- if FCount = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- if Index < FCount then
- System.Move(FList[Index], FList[Index + 1],
- (FCount - Index) * SizeOf(Double));
- FList^[Index] := Item;
- Inc(FCount);
- end;
- procedure TGLDoubleList.Put(Index: Integer; const Item: Double);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- FList^[Index] := Item;
- end;
- procedure TGLDoubleList.SetCapacity(NewCapacity: Integer);
- begin
- inherited;
- FList := PGLDoubleArrayList(FBaseList);
- end;
- procedure TGLDoubleList.Push(const Val: Double);
- begin
- Add(Val);
- end;
- function TGLDoubleList.Pop: Double;
- begin
- if FCount > 0 then
- begin
- Result := Get(FCount - 1);
- Delete(FCount - 1);
- end
- else
- Result := 0;
- end;
- procedure TGLDoubleList.AddSerie(aBase, aDelta: Double; aCount: Integer);
- var
- tmpList: PDouble;
- I: Integer;
- begin
- if aCount <= 0 then
- Exit;
- AdjustCapacityToAtLeast(Count + aCount);
- tmpList := @FList[Count];
- for I := Count to Count + aCount - 1 do
- begin
- tmpList^ := aBase;
- Inc(tmpList);
- aBase := aBase + aDelta;
- end;
- FCount := Count + aCount;
- end;
- procedure TGLDoubleList.Offset(delta: Double);
- var
- I: Integer;
- begin
- for I := 0 to Count - 1 do
- FList^[I] := FList^[I] + delta;
- end;
- procedure TGLDoubleList.Offset(const delta: TGLDoubleList);
- var
- I: Integer;
- begin
- if FCount = delta.FCount then
- for I := 0 to Count - 1 do
- FList^[I] := FList^[I] + delta[I]
- else
- raise Exception.Create('DoubleList count do not match');
- end;
- procedure TGLDoubleList.Scale(factor: Double);
- var
- I: Integer;
- begin
- for I := 0 to Count - 1 do
- FList^[I] := FList^[I] * factor;
- end;
- procedure TGLDoubleList.Sqr;
- var
- I: Integer;
- locList: PGLDoubleArrayList;
- begin
- locList := FList;
- for I := 0 to Count - 1 do
- locList^[I] := locList^[I] * locList^[I];
- end;
- procedure TGLDoubleList.Sqrt;
- var
- I: Integer;
- locList: PGLDoubleArrayList;
- begin
- locList := FList;
- for I := 0 to Count - 1 do
- locList^[I] := System.Sqrt(locList^[I]);
- end;
- function TGLDoubleList.Sum: Double;
- var
- i: Integer;
- begin
- Result := 0;
- for i := 0 to FCount-1 do
- Result := Result + FList^[i];
- end;
- function TGLDoubleList.Min: Single;
- var
- I: Integer;
- locList: PGLDoubleArrayList;
- begin
- if FCount > 0 then
- begin
- locList := FList;
- Result := locList^[0];
- for I := 1 to FCount - 1 do
- if locList^[I] < Result then
- Result := locList^[I];
- end
- else
- Result := 0;
- end;
- function TGLDoubleList.Max: Single;
- var
- I: Integer;
- locList: PGLDoubleArrayList;
- begin
- if FCount > 0 then
- begin
- locList := FList;
- Result := locList^[0];
- for I := 1 to FCount - 1 do
- if locList^[I] > Result then
- Result := locList^[I];
- end
- else
- Result := 0;
- end;
- // ------------------
- // ------------------ TGLQuaternionList ------------------
- // ------------------
- constructor TGLQuaternionList.Create;
- begin
- FItemSize := SizeOf(TQuaternion);
- inherited Create;
- FGrowthDelta := cDefaultListGrowthDelta;
- end;
- procedure TGLQuaternionList.Assign(Src: TPersistent);
- begin
- if Assigned(Src) then
- begin
- inherited;
- if (Src is TGLQuaternionList) then
- System.Move(TGLQuaternionList(Src).FList^, FList^, FCount * SizeOf(TQuaternion));
- end
- else
- Clear;
- end;
- function TGLQuaternionList.Add(const item: TQuaternion): Integer;
- begin
- Result := FCount;
- if Result = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- FList^[Result] := Item;
- Inc(FCount);
- end;
- function TGLQuaternionList.Add(const item: TAffineVector; w: Single): Integer;
- begin
- Result := Add(QuaternionMake([item.X, item.Y, item.Z], w));
- end;
- function TGLQuaternionList.Add(const X, Y, Z, w: Single): Integer;
- begin
- Result := Add(QuaternionMake([X, Y, Z], w));
- end;
- function TGLQuaternionList.Get(Index: Integer): TQuaternion;
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- Result := FList^[Index];
- end;
- procedure TGLQuaternionList.Insert(Index: Integer; const Item: TQuaternion);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- if FCount = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- if Index < FCount then
- System.Move(FList[Index], FList[Index + 1],
- (FCount - Index) * SizeOf(TQuaternion));
- FList^[Index] := Item;
- Inc(FCount);
- end;
- procedure TGLQuaternionList.Put(Index: Integer; const Item: TQuaternion);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- FList^[Index] := Item;
- end;
- procedure TGLQuaternionList.SetCapacity(NewCapacity: Integer);
- begin
- inherited;
- FList := PQuaternionArray(FBaseList);
- end;
- procedure TGLQuaternionList.Push(const Val: TQuaternion);
- begin
- Add(Val);
- end;
- function TGLQuaternionList.Pop: TQuaternion;
- begin
- if FCount > 0 then
- begin
- Result := Get(FCount - 1);
- Delete(FCount - 1);
- end
- else
- Result := IdentityQuaternion;
- end;
- function TGLQuaternionList.IndexOf(const item: TQuaternion): Integer;
- var
- I: Integer;
- curItem: PQuaternion;
- begin
- for I := 0 to Count - 1 do
- begin
- curItem := @FList[I];
- if (item.RealPart = curItem^.RealPart) and VectorEquals(item.ImagPart, curItem^.ImagPart) then
- begin
- Result := I;
- Exit;
- end;
- end;
- Result := -1;
- end;
- function TGLQuaternionList.FindOrAdd(const item: TQuaternion): Integer;
- begin
- Result := IndexOf(item);
- if Result < 0 then
- Result := Add(item);
- end;
- procedure TGLQuaternionList.Lerp(const list1, list2: TGLBaseVectorList; lerpFactor: Single);
- var
- I: Integer;
- begin
- if (list1 is TGLQuaternionList) and (list2 is TGLQuaternionList) then
- begin
- Assert(list1.Count = list2.Count);
- Capacity := list1.Count;
- FCount := list1.Count;
- for I := 0 to FCount - 1 do
- Put(I, QuaternionSlerp(TGLQuaternionList(list1)[I], TGLQuaternionList(list2)[I], lerpFactor));
- end;
- end;
- procedure TGLQuaternionList.Combine(const list2: TGLBaseVectorList; factor: Single);
- procedure CombineQuaternion(var q1: TQuaternion; const q2: TQuaternion; factor: Single);
- begin
- q1 := QuaternionMultiply(q1, QuaternionSlerp(IdentityQuaternion, q2, factor));
- end;
- var
- I: Integer;
- begin
- Assert(list2.Count >= Count);
- if list2 is TGLQuaternionList then
- begin
- for I := 0 to Count - 1 do
- begin
- CombineQuaternion(PQuaternion(ItemAddress[I])^,
- PQuaternion(list2.ItemAddress[I])^,
- factor);
- end;
- end
- else
- inherited;
- end;
- // ------------------
- // ------------------ TGL4ByteList ------------------
- // ------------------
- constructor TGL4ByteList.Create;
- begin
- FItemSize := SizeOf(TGL4ByteList);
- inherited Create;
- FGrowthDelta := cDefaultListGrowthDelta;
- end;
- procedure TGL4ByteList.Assign(Src: TPersistent);
- begin
- if Assigned(Src) then
- begin
- inherited;
- if (Src is TGL4ByteList) then
- System.Move(TGL4ByteList(Src).FList^, FList^, FCount * SizeOf(TGL4ByteData));
- end
- else
- Clear;
- end;
- function TGL4ByteList.Add(const item: TGL4ByteData): Integer;
- begin
- Result := FCount;
- if Result = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- FList^[Result] := Item;
- Inc(FCount);
- Inc(FRevision);
- end;
- procedure TGL4ByteList.Add(const i1: Single);
- var
- tmpList: PSingle;
- begin
- Inc(FCount);
- if FCount >= FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- tmpList := @FList[FCount - 1];
- tmpList^ := i1;
- Inc(FRevision);
- end;
- procedure TGL4ByteList.Add(const i1, i2: Single);
- var
- tmpList: PSingleArray;
- begin
- Inc(FCount, 2);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- tmpList := @FList[FCount - 2];
- tmpList^[0] := i1;
- tmpList^[1] := i2;
- Inc(FRevision);
- end;
- procedure TGL4ByteList.Add(const i1, i2, i3: Single);
- var
- tmpList: PSingleArray;
- begin
- Inc(FCount, 3);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- tmpList := @FList[FCount - 3];
- tmpList^[0] := i1;
- tmpList^[1] := i2;
- tmpList^[2] := i3;
- Inc(FRevision);
- end;
- procedure TGL4ByteList.Add(const i1, i2, i3, i4: Single);
- var
- tmpList: PSingleArray;
- begin
- Inc(FCount, 4);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- tmpList := @FList[FCount - 4];
- tmpList^[0] := i1;
- tmpList^[1] := i2;
- tmpList^[2] := i3;
- tmpList^[3] := i4;
- Inc(FRevision);
- end;
- procedure TGL4ByteList.Add(const i1: Integer);
- var
- tmpList: PInteger;
- begin
- Inc(FCount);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- tmpList := @FList[FCount - 1];
- tmpList^ := i1;
- Inc(FRevision);
- end;
- procedure TGL4ByteList.Add(const i1, i2: Integer);
- var
- tmpList: PIntegerArray;
- begin
- Inc(FCount, 2);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- tmpList := @FList[FCount - 2];
- tmpList^[0] := i1;
- tmpList^[1] := i2;
- Inc(FRevision);
- end;
- procedure TGL4ByteList.Add(const i1, i2, i3: Integer);
- var
- tmpList: PIntegerArray;
- begin
- Inc(FCount, 3);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- tmpList := @FList[FCount - 3];
- tmpList^[0] := i1;
- tmpList^[1] := i2;
- tmpList^[2] := i3;
- Inc(FRevision);
- end;
- procedure TGL4ByteList.Add(const i1, i2, i3, i4: Integer);
- var
- tmpList: PIntegerArray;
- begin
- Inc(FCount, 4);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- tmpList := @FList[FCount - 4];
- tmpList^[0] := i1;
- tmpList^[1] := i2;
- tmpList^[2] := i3;
- tmpList^[3] := i4;
- Inc(FRevision);
- end;
- procedure TGL4ByteList.Add(const i1: Cardinal);
- var
- tmpList: PLongWord;
- begin
- Inc(FCount);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- tmpList := @FList[FCount - 1];
- tmpList^ := i1;
- Inc(FRevision);
- end;
- procedure TGL4ByteList.Add(const i1, i2: Cardinal);
- var
- tmpList: PLongWordArray;
- begin
- Inc(FCount, 2);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- tmpList := @FList[FCount - 2];
- tmpList^[0] := i1;
- tmpList^[1] := i2;
- Inc(FRevision);
- end;
- procedure TGL4ByteList.Add(const i1, i2, i3: Cardinal);
- var
- tmpList: PLongWordArray;
- begin
- Inc(FCount, 3);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- tmpList := @FList[FCount - 3];
- tmpList^[0] := i1;
- tmpList^[1] := i2;
- tmpList^[2] := i3;
- Inc(FRevision);
- end;
- procedure TGL4ByteList.Add(const i1, i2, i3, i4: Cardinal);
- var
- tmpList: PLongWordArray;
- begin
- Inc(FCount, 4);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- tmpList := @FList[FCount - 4];
- tmpList^[0] := i1;
- tmpList^[1] := i2;
- tmpList^[2] := i3;
- tmpList^[3] := i4;
- Inc(FRevision);
- end;
- procedure TGL4ByteList.Add(const AList: TGL4ByteList);
- begin
- if Assigned(AList) and (AList.Count > 0) then
- begin
- if Count + AList.Count > Capacity then
- Capacity := Count + AList.Count;
- System.Move(AList.FList[0], FList[Count], AList.Count * SizeOf(TGL4ByteData));
- Inc(FCount, AList.Count);
- Inc(FRevision);
- end;
- end;
- function TGL4ByteList.Get(Index: Integer): TGL4ByteData;
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- Result := FList^[Index];
- end;
- procedure TGL4ByteList.Insert(Index: Integer; const Item: TGL4ByteData);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- if FCount = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- if Index < FCount then
- System.Move(FList[Index], FList[Index + 1],
- (FCount - Index) * SizeOf(TGL4ByteData));
- FList^[Index] := Item;
- Inc(FCount);
- Inc(FRevision);
- end;
- procedure TGL4ByteList.Put(Index: Integer; const Item: TGL4ByteData);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- FList^[Index] := Item;
- INc(FRevision);
- end;
- procedure TGL4ByteList.SetCapacity(NewCapacity: Integer);
- begin
- inherited;
- FList := PG4ByteArrayList(FBaseList);
- end;
- procedure TGL4ByteList.Push(const Val: TGL4ByteData);
- begin
- Add(Val);
- end;
- function TGL4ByteList.Pop: TGL4ByteData;
- const
- Zero : TGL4ByteData = ( Int: (Value:0) );
- begin
- if FCount > 0 then
- begin
- Result := Get(FCount - 1);
- Delete(FCount - 1);
- end
- else
- Result := Zero;
- end;
- // ------------------
- // ------------------ TGLLongWordList ------------------
- // ------------------
- constructor TGLLongWordList.Create;
- begin
- FItemSize := SizeOf(LongWord);
- inherited Create;
- FGrowthDelta := cDefaultListGrowthDelta;
- end;
- procedure TGLLongWordList.Assign(Src: TPersistent);
- begin
- if Assigned(Src) then
- begin
- inherited;
- if (Src is TGLLongWordList) then
- System.Move(TGLLongWordList(Src).FList^, FList^, FCount * SizeOf(LongWord));
- end
- else
- Clear;
- end;
- function TGLLongWordList.Add(const item: LongWord): Integer;
- begin
- Result := FCount;
- if Result = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- FList^[Result] := Item;
- Inc(FCount);
- end;
- function TGLLongWordList.AddNC(const item: LongWord): Integer;
- begin
- Result := FCount;
- FList^[Result] := Item;
- Inc(FCount);
- end;
- procedure TGLLongWordList.Add(const i1, i2: LongWord);
- var
- tmpList : PLongWordArray;
- begin
- Inc(FCount, 2);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- tmpList := @FList[FCount - 2];
- tmpList^[0] := i1;
- tmpList^[1] := i2;
- end;
- procedure TGLLongWordList.Add(const i1, i2, i3: LongWord);
- var
- tmpList : PLongWordArray;
- begin
- Inc(FCount, 3);
- while FCount > FCapacity do
- SetCapacity(FCapacity + FGrowthDelta);
- tmpList := @FList[FCount - 3];
- tmpList^[0] := i1;
- tmpList^[1] := i2;
- tmpList^[2] := i3;
- end;
- procedure TGLLongWordList.Add(const AList: TGLLongWordList);
- begin
- if Assigned(AList) and (AList.Count > 0) then
- begin
- if Count + AList.Count > Capacity then
- Capacity := Count + AList.Count;
- System.Move(AList.FList[0], FList[Count], AList.Count * SizeOf(LongWord));
- Inc(FCount, AList.Count);
- end;
- end;
- function TGLLongWordList.Get(Index: Integer): LongWord;
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- Result := FList^[Index];
- end;
- procedure TGLLongWordList.Insert(Index: Integer; const Item: LongWord);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- if FCount = FCapacity then
- SetCapacity(FCapacity + FGrowthDelta);
- if Index < FCount then
- System.Move(FList[Index], FList[Index + 1], (FCount - Index) * SizeOf(LongWord));
- FList^[Index] := Item;
- Inc(FCount);
- end;
- procedure TGLLongWordList.Remove(const item: LongWord);
- var
- I: Integer;
- begin
- for I := 0 to Count - 1 do
- begin
- if FList^[I] = item then
- begin
- System.Move(FList[I + 1], FList[I], (FCount - 1 - I) * SizeOf(LongWord));
- Dec(FCount);
- Break;
- end;
- end;
- end;
- procedure TGLLongWordList.Put(Index: Integer; const Item: LongWord);
- begin
- {$IFOPT R+}
- Assert(Cardinal(Index) < Cardinal(FCount));
- {$ENDIF}
- FList^[Index] := Item;
- end;
- procedure TGLLongWordList.SetCapacity(NewCapacity: Integer);
- begin
- inherited;
- FList := PLongWordArray(FBaseList);
- end;
- procedure TGLLongWordList.Push(const Val: LongWord);
- begin
- Add(Val);
- end;
- function TGLLongWordList.Pop: LongWord;
- begin
- if FCount > 0 then
- begin
- Result := FList^[FCount - 1];
- Delete(FCount - 1);
- end
- else
- Result := 0;
- end;
- procedure TGLLongWordList.AddLongWords(const First: PLongWord; n: Integer);
- begin
- if n < 1 then
- Exit;
- AdjustCapacityToAtLeast(Count + n);
- System.Move(First^, FList[FCount], n * SizeOf(LongWord));
- FCount := FCount + n;
- end;
- procedure TGLLongWordList.AddLongWords(const aList: TGLLongWordList);
- begin
- if not Assigned(aList) then
- Exit;
- AddLongWords(@aList.List[0], aList.Count);
- end;
- procedure TGLLongWordList.AddLongWords(const anArray: array of LongWord);
- var
- n: Integer;
- begin
- n := Length(anArray);
- if n > 0 then
- AddLongWords(@anArray[0], n);
- end;
- function LongWordSearch(item: LongWord; list: PLongWordVector; Count: Integer): Integer; register;
- var i : integer;
- begin
- result:=-1;
- for i := 0 to Count-1 do begin
- if list^[i]=item then begin
- result:=i;
- break;
- end;
- end;
- end;
- function TGLLongWordList.IndexOf(item: Integer): LongWord; register;
- begin
- Result := LongWordSearch(item, FList, FCount);
- end;
- // ------------------------------------------------------------------
- initialization
- // ------------------------------------------------------------------
- RegisterClasses([TGLAffineVectorList, TGLVectorList, TGLTexPointList, TGLSingleList,
- TGLDoubleList, TGL4ByteList, TGLLongWordList]);
- end.
|