1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394 |
- //
- // The graphics engine GLScene
- //
- 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);
- // Borland-style persistency support.
- 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
- slerped 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.
|