GLS.VectorGeometry.pas 244 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978597959805981598259835984598559865987598859895990599159925993599459955996599759985999600060016002600360046005600660076008600960106011601260136014601560166017601860196020602160226023602460256026602760286029603060316032603360346035603660376038603960406041604260436044604560466047604860496050605160526053605460556056605760586059606060616062606360646065606660676068606960706071607260736074607560766077607860796080608160826083608460856086608760886089609060916092609360946095609660976098609961006101610261036104610561066107610861096110611161126113611461156116611761186119612061216122612361246125612661276128612961306131613261336134613561366137613861396140614161426143614461456146614761486149615061516152615361546155615661576158615961606161616261636164616561666167616861696170617161726173617461756176617761786179618061816182618361846185618661876188618961906191619261936194619561966197619861996200620162026203620462056206620762086209621062116212621362146215621662176218621962206221622262236224622562266227622862296230623162326233623462356236623762386239624062416242624362446245624662476248624962506251625262536254625562566257625862596260626162626263626462656266626762686269627062716272627362746275627662776278627962806281628262836284628562866287628862896290629162926293629462956296629762986299630063016302630363046305630663076308630963106311631263136314631563166317631863196320632163226323632463256326632763286329633063316332633363346335633663376338633963406341634263436344634563466347634863496350635163526353635463556356635763586359636063616362636363646365636663676368636963706371637263736374637563766377637863796380638163826383638463856386638763886389639063916392639363946395639663976398639964006401640264036404640564066407640864096410641164126413641464156416641764186419642064216422642364246425642664276428642964306431643264336434643564366437643864396440644164426443644464456446644764486449645064516452645364546455645664576458645964606461646264636464646564666467646864696470647164726473647464756476647764786479648064816482648364846485648664876488648964906491649264936494649564966497649864996500650165026503650465056506650765086509651065116512651365146515651665176518651965206521652265236524652565266527652865296530653165326533653465356536653765386539654065416542654365446545654665476548654965506551655265536554655565566557655865596560656165626563656465656566656765686569657065716572657365746575657665776578657965806581658265836584658565866587658865896590659165926593659465956596659765986599660066016602660366046605660666076608660966106611661266136614661566166617661866196620662166226623662466256626662766286629663066316632663366346635663666376638663966406641664266436644664566466647664866496650665166526653665466556656665766586659666066616662666366646665666666676668666966706671667266736674667566766677667866796680668166826683668466856686668766886689669066916692669366946695669666976698669967006701670267036704670567066707670867096710671167126713671467156716671767186719672067216722672367246725672667276728672967306731673267336734673567366737673867396740674167426743674467456746674767486749675067516752675367546755675667576758675967606761676267636764676567666767676867696770677167726773677467756776677767786779678067816782678367846785678667876788678967906791679267936794679567966797679867996800680168026803680468056806680768086809681068116812681368146815681668176818681968206821682268236824682568266827682868296830683168326833683468356836683768386839684068416842684368446845684668476848684968506851685268536854685568566857685868596860686168626863686468656866686768686869687068716872687368746875687668776878687968806881688268836884688568866887688868896890689168926893689468956896689768986899690069016902690369046905690669076908690969106911691269136914691569166917691869196920692169226923692469256926692769286929693069316932693369346935693669376938693969406941694269436944694569466947694869496950695169526953695469556956695769586959696069616962696369646965696669676968696969706971697269736974697569766977697869796980698169826983698469856986698769886989699069916992699369946995699669976998699970007001700270037004700570067007700870097010701170127013701470157016701770187019702070217022702370247025702670277028702970307031703270337034703570367037703870397040704170427043704470457046704770487049705070517052705370547055705670577058705970607061706270637064706570667067706870697070707170727073707470757076707770787079708070817082708370847085708670877088708970907091709270937094709570967097709870997100710171027103710471057106710771087109711071117112711371147115711671177118711971207121712271237124712571267127712871297130713171327133713471357136713771387139714071417142714371447145714671477148714971507151715271537154715571567157715871597160716171627163716471657166716771687169717071717172717371747175717671777178717971807181718271837184718571867187718871897190719171927193719471957196719771987199720072017202720372047205720672077208720972107211721272137214721572167217721872197220722172227223722472257226722772287229723072317232723372347235723672377238723972407241724272437244724572467247724872497250725172527253725472557256725772587259726072617262726372647265726672677268726972707271727272737274727572767277727872797280728172827283728472857286728772887289729072917292729372947295729672977298729973007301730273037304730573067307730873097310731173127313731473157316731773187319732073217322732373247325732673277328732973307331733273337334733573367337733873397340734173427343734473457346734773487349735073517352735373547355735673577358735973607361736273637364736573667367736873697370737173727373737473757376737773787379738073817382738373847385738673877388738973907391739273937394739573967397739873997400740174027403740474057406740774087409741074117412741374147415741674177418741974207421742274237424742574267427742874297430743174327433743474357436743774387439744074417442744374447445744674477448744974507451745274537454745574567457745874597460746174627463746474657466746774687469747074717472747374747475747674777478747974807481748274837484748574867487748874897490749174927493749474957496749774987499750075017502750375047505750675077508750975107511751275137514751575167517751875197520752175227523752475257526752775287529753075317532753375347535753675377538753975407541754275437544754575467547754875497550755175527553755475557556755775587559756075617562756375647565756675677568756975707571757275737574757575767577757875797580758175827583758475857586758775887589759075917592759375947595759675977598759976007601760276037604760576067607760876097610761176127613761476157616761776187619762076217622762376247625762676277628762976307631763276337634763576367637763876397640764176427643764476457646764776487649765076517652765376547655765676577658765976607661766276637664766576667667766876697670767176727673767476757676767776787679768076817682768376847685768676877688768976907691769276937694769576967697769876997700770177027703770477057706770777087709771077117712771377147715771677177718771977207721772277237724772577267727772877297730773177327733773477357736773777387739774077417742774377447745774677477748774977507751775277537754775577567757775877597760776177627763776477657766776777687769777077717772777377747775777677777778777977807781778277837784778577867787778877897790779177927793779477957796779777987799780078017802780378047805780678077808780978107811781278137814781578167817781878197820782178227823782478257826782778287829783078317832783378347835783678377838783978407841784278437844784578467847784878497850785178527853
  1. //
  2. // The graphics rendering engine GLScene http://glscene.org
  3. //
  4. unit GLS.VectorGeometry;
  5. (*
  6. Base classes and structures.
  7. Most common functions/procedures come in various flavours (using overloads),
  8. the naming convention is :
  9. TypeOperation: functions returning a result, or accepting a "var" as last
  10. parameter to place result (VectorAdd, VectorCrossProduct...)
  11. OperationType : procedures taking as first parameter a "var" that will be
  12. used as operand and result (AddVector, CombineVector...)
  13. As a general rule, procedures implementations (asm or not) are the fastest
  14. (up to 800% faster than function equivalents), due to reduced return value
  15. duplication overhead (the exception being the matrix operations).
  16. For better performance, it is recommended not to use the "Math" unit
  17. that comes with Delphi, and only use functions/procedures from this unit
  18. (the single-based functions have been optimized and are up to 100% faster,
  19. than extended-based ones from "Math").
  20. *)
  21. interface
  22. {$I GLScene.inc}
  23. uses
  24. System.SysUtils,
  25. System.Types,
  26. System.Math,
  27. GLS.VectorTypes;
  28. const
  29. cMaxArray = (MaxInt shr 4);
  30. cColinearBias = 1E-8;
  31. type
  32. (* Data types needed for 3D graphics calculation, included are 'C like'
  33. aliases for each type (to be conformal with OpenGL types) *)
  34. PFloat = PSingle;
  35. PTexPoint = ^TTexPoint;
  36. TTexPoint = packed record
  37. S, T: Single;
  38. end;
  39. (* Types to specify continous streams of a specific type
  40. switch off range checking to access values beyond the limits *)
  41. PByteVector = ^TByteVector;
  42. PByteArray = PByteVector;
  43. TByteVector = array [0 .. cMaxArray] of Byte;
  44. PWordVector = ^TWordVector;
  45. TWordVector = array [0 .. cMaxArray] of Word;
  46. PIntegerVector = ^TIntegerVector;
  47. PIntegerArray = PIntegerVector;
  48. TIntegerVector = array [0 .. cMaxArray] of Integer;
  49. PFloatVector = ^TFloatVector;
  50. PFloatArray = PFloatVector;
  51. PSingleArray = PFloatArray;
  52. TFloatVector = array [0 .. cMaxArray] of Single;
  53. TSingleArray = array of Single;
  54. PDoubleVector = ^TDoubleVector;
  55. PDoubleArray = PDoubleVector;
  56. TDoubleVector = array [0 .. cMaxArray] of Double;
  57. PExtendedVector = ^TExtendedVector;
  58. PExtendedArray = PExtendedVector;
  59. {$IFDEF CROSSVCL}
  60. TExtendedVector = array [0 .. cMaxArray div 2] of Extended;
  61. {$ELSE}
  62. TExtendedVector = array [0 .. cMaxArray] of Extended;
  63. {$ENDIF}
  64. PPointerVector = ^TPointerVector;
  65. PPointerArray = PPointerVector;
  66. TPointerVector = array [0 .. cMaxArray] of Pointer;
  67. PCardinalVector = ^TCardinalVector;
  68. PCardinalArray = PCardinalVector;
  69. TCardinalVector = array [0 .. cMaxArray] of Cardinal;
  70. PLongWordVector = ^TLongWordVector;
  71. PLongWordArray = PLongWordVector;
  72. TLongWordVector = array [0 .. cMaxArray] of LongWord;
  73. (*
  74. Common vector and matrix types with predefined limits
  75. indices correspond like: x -> 0
  76. y -> 1
  77. z -> 2
  78. w -> 3
  79. *)
  80. PHomogeneousByteVector = ^THomogeneousByteVector;
  81. THomogeneousByteVector = TVector4b;
  82. PHomogeneousWordVector = ^THomogeneousWordVector;
  83. THomogeneousWordVector = TVector4w;
  84. PHomogeneousIntVector = ^THomogeneousIntVector;
  85. THomogeneousIntVector = TVector4i;
  86. PHomogeneousFltVector = ^THomogeneousFltVector;
  87. THomogeneousFltVector = TVector4f;
  88. PHomogeneousDblVector = ^THomogeneousDblVector;
  89. THomogeneousDblVector = TVector4d;
  90. PHomogeneousExtVector = ^THomogeneousExtVector;
  91. THomogeneousExtVector = TVector4e;
  92. PHomogeneousPtrVector = ^THomogeneousPtrVector;
  93. THomogeneousPtrVector = TVector4p;
  94. PAffineByteVector = ^TAffineByteVector;
  95. TAffineByteVector = TVector3b;
  96. PAffineWordVector = ^TAffineWordVector;
  97. TAffineWordVector = TVector3w;
  98. PAffineIntVector = ^TAffineIntVector;
  99. TAffineIntVector = TVector3i;
  100. PAffineFltVector = ^TAffineFltVector;
  101. TAffineFltVector = TVector3f;
  102. PAffineDblVector = ^TAffineDblVector;
  103. TAffineDblVector = TVector3d;
  104. PAffineExtVector = ^TAffineExtVector;
  105. TAffineExtVector = TVector3e;
  106. PAffinePtrVector = ^TAffinePtrVector;
  107. TAffinePtrVector = TVector3p;
  108. PVector2f = ^TVector2f;
  109. // some simplified names
  110. PHomogeneousVector = ^THomogeneousVector;
  111. THomogeneousVector = THomogeneousFltVector;
  112. PAffineVector = ^TAffineVector;
  113. TAffineVector = TVector3f;
  114. PVertex = ^TVertex;
  115. TVertex = TAffineVector;
  116. // Arrays of vectors
  117. PAffineVectorArray = ^TAffineVectorArray;
  118. TAffineVectorArray = array [0 .. MaxInt shr 4] of TAffineVector;
  119. PVectorArray = ^TVectorArray;
  120. TVectorArray = array [0 .. MaxInt shr 5] of TGLVector;
  121. PTexPointArray = ^TTexPointArray;
  122. TTexPointArray = array [0 .. MaxInt shr 4] of TTexPoint;
  123. // Matrices
  124. THomogeneousByteMatrix = TMatrix4b;
  125. THomogeneousWordMatrix = array [0 .. 3] of THomogeneousWordVector;
  126. THomogeneousIntMatrix = TMatrix4i;
  127. THomogeneousFltMatrix = TMatrix4f;
  128. THomogeneousDblMatrix = TMatrix4d;
  129. THomogeneousExtMatrix = array [0 .. 3] of THomogeneousExtVector;
  130. TAffineByteMatrix = TMatrix3b;
  131. TAffineWordMatrix = array [0 .. 2] of TAffineWordVector;
  132. TAffineIntMatrix = TMatrix3i;
  133. TAffineFltMatrix = TMatrix3f;
  134. TAffineDblMatrix = TMatrix3d;
  135. TAffineExtMatrix = array [0 .. 2] of TAffineExtVector;
  136. // Some simplified names
  137. /// PGLMatrix = ^TGLMatrix;
  138. /// TGLMatrix = THomogeneousFltMatrix;
  139. TMatrixArray = array [0 .. MaxInt shr 7] of TGLMatrix;
  140. PMatrixArray = ^TMatrixArray;
  141. PHomogeneousMatrix = ^THomogeneousMatrix;
  142. THomogeneousMatrix = THomogeneousFltMatrix;
  143. PAffineMatrix = ^TAffineMatrix;
  144. TAffineMatrix = TAffineFltMatrix;
  145. (* A plane equation.
  146. Defined by its equation A.x+B.y+C.z+D , a plane can be mapped to the
  147. homogeneous space coordinates, and this is what we are doing here.
  148. The typename is just here for easing up data manipulation *)
  149. THmgPlane = TGLVector;
  150. TDoubleHmgPlane = THomogeneousDblVector;
  151. // q = ([x, y, z], w)
  152. PQuaternion = ^TQuaternion;
  153. TQuaternion = record
  154. case Integer of
  155. 0: (ImagPart: TAffineVector;
  156. RealPart: Single);
  157. 1: (X, Y, Z, W: Single);
  158. end;
  159. PQuaternionArray = ^TQuaternionArray;
  160. TQuaternionArray = array [0 .. MaxInt shr 5] of TQuaternion;
  161. TRectangle = record
  162. Left, Top, Width, Height: Integer;
  163. end;
  164. PFrustum = ^TFrustum;
  165. TFrustum = record
  166. pLeft, pTop, pRight, pBottom, pNear, pFar: THmgPlane;
  167. end;
  168. TTransType = (ttScaleX, ttScaleY, ttScaleZ,
  169. ttShearXY, ttShearXZ, ttShearYZ,
  170. ttRotateX, ttRotateY, ttRotateZ,
  171. ttTranslateX, ttTranslateY, ttTranslateZ,
  172. ttPerspectiveX, ttPerspectiveY, ttPerspectiveZ, ttPerspectiveW);
  173. (* Used to describe a sequence of transformations in following order:
  174. [Sx][Sy][Sz][ShearXY][ShearXZ][ShearZY][Rx][Ry][Rz][Tx][Ty][Tz][P(x,y,z,w)]
  175. constants are declared for easier access (see MatrixDecompose below) *)
  176. TTransformations = array [TTransType] of Single;
  177. TPackedRotationMatrix = array [0 .. 2] of SmallInt;
  178. const
  179. // TexPoints (2D space)
  180. XTexPoint: TTexPoint = (S: 1; T: 0);
  181. YTexPoint: TTexPoint = (S: 0; T: 1);
  182. XYTexPoint: TTexPoint = (S: 1; T: 1);
  183. NullTexPoint: TTexPoint = (S: 0; T: 0);
  184. MidTexPoint: TTexPoint = (S: 0.5; T: 0.5);
  185. // standard vectors
  186. XVector: TAffineVector = (X: 1; Y: 0; Z: 0);
  187. YVector: TAffineVector = (X: 0; Y: 1; Z: 0);
  188. ZVector: TAffineVector = (X: 0; Y: 0; Z: 1);
  189. XYVector: TAffineVector = (X: 1; Y: 1; Z: 0);
  190. XZVector: TAffineVector = (X: 1; Y: 0; Z: 1);
  191. YZVector: TAffineVector = (X: 0; Y: 1; Z: 1);
  192. XYZVector: TAffineVector = (X: 1; Y: 1; Z: 1);
  193. NullVector: TAffineVector = (X: 0; Y: 0; Z: 0);
  194. MinusXVector: TAffineVector = (X: - 1; Y: 0; Z: 0);
  195. MinusYVector: TAffineVector = (X: 0; Y: - 1; Z: 0);
  196. MinusZVector: TAffineVector = (X: 0; Y: 0; Z: - 1);
  197. // Standard homogeneous vectors
  198. XHmgVector: THomogeneousVector = (X: 1; Y: 0; Z: 0; W: 0);
  199. YHmgVector: THomogeneousVector = (X: 0; Y: 1; Z: 0; W: 0);
  200. ZHmgVector: THomogeneousVector = (X: 0; Y: 0; Z: 1; W: 0);
  201. WHmgVector: THomogeneousVector = (X: 0; Y: 0; Z: 0; W: 1);
  202. XYHmgVector: THomogeneousVector = (X: 1; Y: 1; Z: 0; W: 0);
  203. YZHmgVector: THomogeneousVector = (X: 0; Y: 1; Z: 1; W: 0);
  204. XZHmgVector: THomogeneousVector = (X: 1; Y: 0; Z: 1; W: 0);
  205. XYZHmgVector: THomogeneousVector = (X: 1; Y: 1; Z: 1; W: 0);
  206. XYZWHmgVector: THomogeneousVector = (X: 1; Y: 1; Z: 1; W: 1);
  207. NullHmgVector: THomogeneousVector = (X: 0; Y: 0; Z: 0; W: 0);
  208. // Standard homogeneous points
  209. XHmgPoint: THomogeneousVector = (X: 1; Y: 0; Z: 0; W: 1);
  210. YHmgPoint: THomogeneousVector = (X: 0; Y: 1; Z: 0; W: 1);
  211. ZHmgPoint: THomogeneousVector = (X: 0; Y: 0; Z: 1; W: 1);
  212. WHmgPoint: THomogeneousVector = (X: 0; Y: 0; Z: 0; W: 1);
  213. NullHmgPoint: THomogeneousVector = (X: 0; Y: 0; Z: 0; W: 1);
  214. IdentityMatrix: TAffineMatrix = (V: ((X: 1; Y: 0; Z: 0), (X: 0; Y: 1;
  215. Z: 0), (X: 0; Y: 0; Z: 1)));
  216. IdentityHmgMatrix: TGLMatrix = (V: ((X: 1; Y: 0; Z: 0; W: 0), (X: 0; Y: 1; Z: 0;
  217. W: 0), (X: 0; Y: 0; Z: 1; W: 0), (X: 0; Y: 0; Z: 0; W: 1)));
  218. IdentityHmgDblMatrix: THomogeneousDblMatrix = (V: ((X: 1; Y: 0; Z: 0;
  219. W: 0), (X: 0; Y: 1; Z: 0; W: 0), (X: 0; Y: 0; Z: 1; W: 0), (X: 0; Y: 0;
  220. Z: 0; W: 1)));
  221. EmptyMatrix: TAffineMatrix = (V: ((X: 0; Y: 0; Z: 0), (X: 0; Y: 0;
  222. Z: 0), (X: 0; Y: 0; Z: 0)));
  223. EmptyHmgMatrix: TGLMatrix = (V: ((X: 0; Y: 0; Z: 0; W: 0), (X: 0; Y: 0; Z: 0;
  224. W: 0), (X: 0; Y: 0; Z: 0; W: 0), (X: 0; Y: 0; Z: 0; W: 0)));
  225. // Quaternions
  226. IdentityQuaternion: TQuaternion = (ImagPart: (X: 0; Y: 0; Z: 0); RealPart: 1);
  227. // Some very small numbers
  228. EPSILON: Single = 1E-40;
  229. EPSILON2: Single = 1E-30;
  230. (* --------------------------------------------------------------------------
  231. Vector functions
  232. --------------------------------------------------------------------------*)
  233. function TexPointMake(const S, T: Single): TTexPoint; inline;
  234. function AffineVectorMake(const X, Y, Z: Single): TAffineVector; overload; inline;
  235. function AffineVectorMake(const V: TGLVector): TAffineVector; overload; inline;
  236. procedure SetAffineVector(out V: TAffineVector; const X, Y, Z: Single); overload; inline;
  237. procedure SetVector(out V: TAffineVector; const X, Y, Z: Single); overload;inline;
  238. procedure SetVector(out V: TAffineVector; const vSrc: TGLVector); overload; inline;
  239. procedure SetVector(out V: TAffineVector; const vSrc: TAffineVector); overload; inline;
  240. procedure SetVector(out V: TAffineDblVector; const vSrc: TAffineVector); overload; inline;
  241. procedure SetVector(out V: TAffineDblVector; const vSrc: TGLVector); overload; inline;
  242. function VectorMake(const V: TAffineVector; W: Single = 0): TGLVector; overload; inline;
  243. function VectorMake(const X, Y, Z: Single; W: Single = 0): TGLVector; overload; inline;
  244. function VectorMake(const Q: TQuaternion): TGLVector; overload; inline;
  245. function PointMake(const X, Y, Z: Single): TGLVector; overload; inline;
  246. function PointMake(const V: TAffineVector): TGLVector; overload; inline;
  247. function PointMake(const V: TGLVector): TGLVector; overload;inline;
  248. procedure SetVector(out V: TGLVector; const X, Y, Z: Single; W: Single = 0); overload; inline;
  249. procedure SetVector(out V: TGLVector; const av: TAffineVector; W: Single = 0); overload; inline;
  250. procedure SetVector(out V: TGLVector; const vSrc: TGLVector); overload; inline;
  251. procedure MakePoint(out V: TGLVector; const X, Y, Z: Single); overload; inline;
  252. procedure MakePoint(out V: TGLVector; const av: TAffineVector); overload;inline;
  253. procedure MakePoint(out V: TGLVector; const av: TGLVector); overload; inline;
  254. procedure MakeVector(out V: TAffineVector; const X, Y, Z: Single); overload; inline;
  255. procedure MakeVector(out V: TGLVector; const X, Y, Z: Single); overload; inline;
  256. procedure MakeVector(out V: TGLVector; const av: TAffineVector); overload; inline;
  257. procedure MakeVector(out V: TGLVector; const av: TGLVector); overload; inline;
  258. procedure RstVector(var V: TAffineVector); overload; inline;
  259. procedure RstVector(var V: TGLVector); overload; inline;
  260. function VectorEquals(const Vector1, Vector2: TVector2f): Boolean; overload; inline;
  261. function VectorEquals(const Vector1, Vector2: TVector2i): Boolean; overload; inline;
  262. function VectorEquals(const V1, V2: TVector2d): Boolean; overload;inline;
  263. function VectorEquals(const V1, V2: TVector2s): Boolean; overload;inline;
  264. function VectorEquals(const V1, V2: TVector2b): Boolean; overload;inline;
  265. // function VectorEquals(const V1, V2: TVector3f): Boolean; overload; //declared further
  266. function VectorEquals(const V1, V2: TVector3i): Boolean; overload;inline;
  267. function VectorEquals(const V1, V2: TVector3d): Boolean; overload;inline;
  268. function VectorEquals(const V1, V2: TVector3s): Boolean; overload;inline;
  269. function VectorEquals(const V1, V2: TVector3b): Boolean; overload;inline;
  270. // function VectorEquals(const V1, V2: TVector4f): Boolean; overload; //declared further
  271. function VectorEquals(const V1, V2: TVector4i): Boolean; overload;inline;
  272. function VectorEquals(const V1, V2: TVector4d): Boolean; overload;inline;
  273. function VectorEquals(const V1, V2: TVector4s): Boolean; overload;inline;
  274. function VectorEquals(const V1, V2: TVector4b): Boolean; overload;inline;
  275. // 3x3
  276. function MatrixEquals(const Matrix1, Matrix2: TMatrix3f): Boolean; overload;
  277. function MatrixEquals(const Matrix1, Matrix2: TMatrix3i): Boolean; overload;
  278. function MatrixEquals(const Matrix1, Matrix2: TMatrix3d): Boolean; overload;
  279. function MatrixEquals(const Matrix1, Matrix2: TMatrix3s): Boolean; overload;
  280. function MatrixEquals(const Matrix1, Matrix2: TMatrix3b): Boolean; overload;
  281. // 4x4
  282. function MatrixEquals(const Matrix1, Matrix2: TMatrix4f): Boolean; overload;
  283. function MatrixEquals(const Matrix1, Matrix2: TMatrix4i): Boolean; overload;
  284. function MatrixEquals(const Matrix1, Matrix2: TMatrix4d): Boolean; overload;
  285. function MatrixEquals(const Matrix1, Matrix2: TMatrix4s): Boolean; overload;
  286. function MatrixEquals(const Matrix1, Matrix2: TMatrix4b): Boolean; overload;
  287. // 2x
  288. function Vector2fMake(const X, Y: Single): TVector2f; overload; inline;
  289. function Vector2iMake(const X, Y: Longint): TVector2i; overload; inline;
  290. function Vector2sMake(const X, Y: SmallInt): TVector2s; overload; inline;
  291. function Vector2dMake(const X, Y: Double): TVector2d; overload; inline;
  292. function Vector2bMake(const X, Y: Byte): TVector2b; overload; inline;
  293. function Vector2fMake(const Vector: TVector3f): TVector2f; overload; inline;
  294. function Vector2iMake(const Vector: TVector3i): TVector2i; overload; inline;
  295. function Vector2sMake(const Vector: TVector3s): TVector2s; overload; inline;
  296. function Vector2dMake(const Vector: TVector3d): TVector2d; overload; inline;
  297. function Vector2bMake(const Vector: TVector3b): TVector2b; overload; inline;
  298. function Vector2fMake(const Vector: TVector4f): TVector2f; overload; inline;
  299. function Vector2iMake(const Vector: TVector4i): TVector2i; overload; inline;
  300. function Vector2sMake(const Vector: TVector4s): TVector2s; overload; inline;
  301. function Vector2dMake(const Vector: TVector4d): TVector2d; overload; inline;
  302. function Vector2bMake(const Vector: TVector4b): TVector2b; overload; inline;
  303. // 3x
  304. function Vector3fMake(const X: Single; const Y: Single = 0; const Z: Single = 0) : TVector3f; overload; inline;
  305. function Vector3iMake(const X: Longint; const Y: Longint = 0; const Z: Longint = 0): TVector3i; overload;inline;
  306. function Vector3sMake(const X: SmallInt; const Y: SmallInt = 0; const Z: SmallInt = 0): TVector3s; overload;inline;
  307. function Vector3dMake(const X: Double; const Y: Double = 0; const Z: Double = 0): TVector3d; overload; inline;
  308. function Vector3bMake(const X: Byte; const Y: Byte = 0; const Z: Byte = 0): TVector3b; overload; inline;
  309. function Vector3fMake(const Vector: TVector2f; const Z: Single = 0): TVector3f; overload; inline;
  310. function Vector3iMake(const Vector: TVector2i; const Z: Longint = 0): TVector3i; overload; inline;
  311. function Vector3sMake(const Vector: TVector2s; const Z: SmallInt = 0): TVector3s; overload; inline;
  312. function Vector3dMake(const Vector: TVector2d; const Z: Double = 0): TVector3d; overload; inline;
  313. function Vector3bMake(const Vector: TVector2b; const Z: Byte = 0): TVector3b; overload; inline;
  314. function Vector3fMake(const Vector: TVector4f): TVector3f; overload; inline;
  315. function Vector3iMake(const Vector: TVector4i): TVector3i; overload; inline;
  316. function Vector3sMake(const Vector: TVector4s): TVector3s; overload; inline;
  317. function Vector3dMake(const Vector: TVector4d): TVector3d; overload; inline;
  318. function Vector3bMake(const Vector: TVector4b): TVector3b; overload; inline;
  319. // 4x
  320. function Vector4fMake(const X: Single; const Y: Single = 0; const Z: Single = 0; const W: Single = 0): TVector4f; overload; inline;
  321. function Vector4iMake(const X: Longint; const Y: Longint = 0; const Z: Longint = 0; const W: Longint = 0): TVector4i; overload; inline;
  322. function Vector4sMake(const X: SmallInt; const Y: SmallInt = 0; const Z: SmallInt = 0; const W: SmallInt = 0): TVector4s; overload; inline;
  323. function Vector4dMake(const X: Double; const Y: Double = 0; const Z: Double = 0; const W: Double = 0): TVector4d; overload; inline;
  324. function Vector4bMake(const X: Byte; const Y: Byte = 0; const Z: Byte = 0; const W: Byte = 0): TVector4b; overload; inline;
  325. function Vector4fMake(const Vector: TVector3f; const W: Single = 0): TVector4f; overload; inline;
  326. function Vector4iMake(const Vector: TVector3i; const W: Longint = 0): TVector4i; overload; inline;
  327. function Vector4sMake(const Vector: TVector3s; const W: SmallInt = 0) : TVector4s; overload; inline;
  328. function Vector4dMake(const Vector: TVector3d; const W: Double = 0): TVector4d; overload; inline;
  329. function Vector4bMake(const Vector: TVector3b; const W: Byte = 0): TVector4b; overload; inline;
  330. function Vector4fMake(const Vector: TVector2f; const Z: Single = 0; const W: Single = 0): TVector4f; overload; inline;
  331. function Vector4iMake(const Vector: TVector2i; const Z: Longint = 0; const W: Longint = 0): TVector4i; overload;inline;
  332. function Vector4sMake(const Vector: TVector2s; const Z: SmallInt = 0; const W: SmallInt = 0): TVector4s; overload;inline;
  333. function Vector4dMake(const Vector: TVector2d; const Z: Double = 0; const W: Double = 0): TVector4d; overload; inline;
  334. function Vector4bMake(const Vector: TVector2b; const Z: Byte = 0; const W: Byte = 0): TVector4b; overload; inline;
  335. // Vector comparison functions:
  336. // 3f
  337. function VectorMoreThen(const SourceVector, ComparedVector: TVector3f): Boolean; overload;
  338. function VectorMoreEqualThen(const SourceVector, ComparedVector: TVector3f): Boolean; overload;
  339. function VectorLessThen(const SourceVector, ComparedVector: TVector3f): Boolean; overload;
  340. function VectorLessEqualThen(const SourceVector, ComparedVector: TVector3f): Boolean; overload;
  341. // 4f
  342. function VectorMoreThen(const SourceVector, ComparedVector: TVector4f): Boolean; overload;
  343. function VectorMoreEqualThen(const SourceVector, ComparedVector: TVector4f): Boolean; overload;
  344. function VectorLessThen(const SourceVector, ComparedVector: TVector4f): Boolean; overload;
  345. function VectorLessEqualThen(const SourceVector, ComparedVector: TVector4f): Boolean; overload;
  346. // 3i
  347. function VectorMoreThen(const SourceVector, ComparedVector: TVector3i): Boolean; overload;
  348. function VectorMoreEqualThen(const SourceVector, ComparedVector: TVector3i): Boolean; overload;
  349. function VectorLessThen(const SourceVector, ComparedVector: TVector3i): Boolean; overload;
  350. function VectorLessEqualThen(const SourceVector, ComparedVector: TVector3i): Boolean; overload;
  351. // 4i
  352. function VectorMoreThen(const SourceVector, ComparedVector: TVector4i): Boolean; overload;
  353. function VectorMoreEqualThen(const SourceVector, ComparedVector: TVector4i): Boolean; overload;
  354. function VectorLessThen(const SourceVector, ComparedVector: TVector4i): Boolean; overload;
  355. function VectorLessEqualThen(const SourceVector, ComparedVector: TVector4i): Boolean; overload;
  356. // 3s
  357. function VectorMoreThen(const SourceVector, ComparedVector: TVector3s): Boolean; overload;
  358. function VectorMoreEqualThen(const SourceVector, ComparedVector: TVector3s): Boolean; overload;
  359. function VectorLessThen(const SourceVector, ComparedVector: TVector3s): Boolean; overload;
  360. function VectorLessEqualThen(const SourceVector, ComparedVector: TVector3s): Boolean; overload;
  361. // 4s
  362. function VectorMoreThen(const SourceVector, ComparedVector: TVector4s): Boolean; overload;
  363. function VectorMoreEqualThen(const SourceVector, ComparedVector: TVector4s): Boolean; overload;
  364. function VectorLessThen(const SourceVector, ComparedVector: TVector4s): Boolean; overload;
  365. function VectorLessEqualThen(const SourceVector, ComparedVector: TVector4s): Boolean; overload;
  366. // ComparedNumber
  367. // 3f
  368. function VectorMoreThen(const SourceVector: TVector3f; const ComparedNumber: Single): Boolean; overload;
  369. function VectorMoreEqualThen(const SourceVector: TVector3f; const ComparedNumber: Single): Boolean; overload;
  370. function VectorLessThen(const SourceVector: TVector3f; const ComparedNumber: Single): Boolean; overload;
  371. function VectorLessEqualThen(const SourceVector: TVector3f; const ComparedNumber: Single): Boolean; overload;
  372. // 4f
  373. function VectorMoreThen(const SourceVector: TVector4f; const ComparedNumber: Single): Boolean; overload;
  374. function VectorMoreEqualThen(const SourceVector: TVector4f; const ComparedNumber: Single): Boolean; overload;
  375. function VectorLessThen(const SourceVector: TVector4f; const ComparedNumber: Single): Boolean; overload;
  376. function VectorLessEqualThen(const SourceVector: TVector4f; const ComparedNumber: Single): Boolean; overload;
  377. // 3i
  378. function VectorMoreThen(const SourceVector: TVector3i; const ComparedNumber: Single): Boolean; overload;
  379. function VectorMoreEqualThen(const SourceVector: TVector3i; const ComparedNumber: Single): Boolean; overload;
  380. function VectorLessThen(const SourceVector: TVector3i; const ComparedNumber: Single): Boolean; overload;
  381. function VectorLessEqualThen(const SourceVector: TVector3i; const ComparedNumber: Single): Boolean; overload;
  382. // 4i
  383. function VectorMoreThen(const SourceVector: TVector4i; const ComparedNumber: Single): Boolean; overload;
  384. function VectorMoreEqualThen(const SourceVector: TVector4i; const ComparedNumber: Single): Boolean; overload;
  385. function VectorLessThen(const SourceVector: TVector4i; const ComparedNumber: Single): Boolean; overload;
  386. function VectorLessEqualThen(const SourceVector: TVector4i; const ComparedNumber: Single): Boolean; overload;
  387. // 3s
  388. function VectorMoreThen(const SourceVector: TVector3s; const ComparedNumber: Single): Boolean; overload;
  389. function VectorMoreEqualThen(const SourceVector: TVector3s; const ComparedNumber: Single): Boolean; overload;
  390. function VectorLessThen(const SourceVector: TVector3s; const ComparedNumber: Single): Boolean; overload;
  391. function VectorLessEqualThen(const SourceVector: TVector3s; const ComparedNumber: Single): Boolean; overload;
  392. // 4s
  393. function VectorMoreThen(const SourceVector: TVector4s; const ComparedNumber: Single): Boolean; overload;
  394. function VectorMoreEqualThen(const SourceVector: TVector4s; const ComparedNumber: Single): Boolean; overload;
  395. function VectorLessThen(const SourceVector: TVector4s; const ComparedNumber: Single): Boolean; overload;
  396. function VectorLessEqualThen(const SourceVector: TVector4s; const ComparedNumber: Single): Boolean; overload;
  397. function VectorAdd(const V1, V2: TVector2f): TVector2f; overload;
  398. // Returns the sum of two affine vectors
  399. function VectorAdd(const V1, V2: TAffineVector): TAffineVector; overload;
  400. // Adds two vectors and places result in vr
  401. procedure VectorAdd(const V1, V2: TAffineVector; var vr: TAffineVector); overload;
  402. procedure VectorAdd(const V1, V2: TAffineVector; vr: PAffineVector); overload;
  403. // Returns the sum of two homogeneous vectors
  404. function VectorAdd(const V1, V2: TGLVector): TGLVector; overload;
  405. procedure VectorAdd(const V1, V2: TGLVector; var vr: TGLVector); overload;
  406. // Sums up f to each component of the vector
  407. function VectorAdd(const V: TAffineVector; const f: Single): TAffineVector; overload; inline;
  408. // Sums up f to each component of the vector
  409. function VectorAdd(const V: TGLVector; const f: Single): TGLVector; overload; inline;
  410. // Adds V2 to V1, result is placed in V1
  411. procedure AddVector(var V1: TAffineVector; const V2: TAffineVector); overload;
  412. // Adds V2 to V1, result is placed in V1
  413. procedure AddVector(var V1: TAffineVector; const V2: TGLVector); overload;
  414. // Adds V2 to V1, result is placed in V1
  415. procedure AddVector(var V1: TGLVector; const V2: TGLVector); overload;
  416. // Sums up f to each component of the vector
  417. procedure AddVector(var V: TAffineVector; const f: Single); overload; inline;
  418. // Sums up f to each component of the vector
  419. procedure AddVector(var V: TGLVector; const f: Single); overload; inline;
  420. // Adds V2 to V1, result is placed in V1. W coordinate is always 1.
  421. procedure AddPoint(var V1: TGLVector; const V2: TGLVector); overload; inline;
  422. // Returns the sum of two homogeneous vectors. W coordinate is always 1.
  423. function PointAdd(var V1: TGLVector; const V2: TGLVector): TGLVector; overload; inline;
  424. // Adds delta to nb texpoints in src and places result in dest
  425. procedure TexPointArrayAdd(const src: PTexPointArray; const delta: TTexPoint; const nb: Integer; dest: PTexPointArray); overload;
  426. procedure TexPointArrayScaleAndAdd(const src: PTexPointArray; const delta: TTexPoint;
  427. const nb: Integer; const scale: TTexPoint; dest: PTexPointArray); overload;
  428. // Adds delta to nb vectors in src and places result in dest
  429. procedure VectorArrayAdd(const src: PAffineVectorArray;
  430. const delta: TAffineVector; const nb: Integer; dest: PAffineVectorArray); overload;
  431. // Returns V1-V2
  432. function VectorSubtract(const V1, V2: TVector2f): TVector2f; overload;
  433. // Subtracts V2 from V1, result is placed in V1
  434. procedure SubtractVector(var V1: TVector2f; const V2: TVector2f); overload;
  435. // Returns V1-V2
  436. function VectorSubtract(const V1, V2: TAffineVector): TAffineVector; overload;
  437. // Subtracts V2 from V1 and return value in result
  438. procedure VectorSubtract(const V1, V2: TAffineVector; var result: TAffineVector); overload;
  439. // Subtracts V2 from V1 and return value in result
  440. procedure VectorSubtract(const V1, V2: TAffineVector; var result: TGLVector); overload;
  441. // Subtracts V2 from V1 and return value in result
  442. procedure VectorSubtract(const V1: TGLVector; const V2: TAffineVector; var result: TGLVector); overload;
  443. // Returns V1-V2
  444. function VectorSubtract(const V1, V2: TGLVector): TGLVector; overload;
  445. // Subtracts V2 from V1 and return value in result
  446. procedure VectorSubtract(const V1, V2: TGLVector; var result: TGLVector); overload;
  447. // Subtracts V2 from V1 and return value in result
  448. procedure VectorSubtract(const V1, V2: TGLVector; var result: TAffineVector); overload;
  449. function VectorSubtract(const V1: TAffineVector; delta: Single): TAffineVector; overload; inline;
  450. function VectorSubtract(const V1: TGLVector; delta: Single): TGLVector; overload;inline;
  451. // Subtracts V2 from V1, result is placed in V1
  452. procedure SubtractVector(var V1: TAffineVector; const V2: TAffineVector); overload;
  453. // Subtracts V2 from V1, result is placed in V1
  454. procedure SubtractVector(var V1: TGLVector; const V2: TGLVector); overload;
  455. // Combine the first vector with the second : vr:=vr+v*f
  456. procedure CombineVector(var vr: TAffineVector; const V: TAffineVector; var f: Single); overload;
  457. procedure CombineVector(var vr: TAffineVector; const V: TAffineVector; pf: PFloat); overload;
  458. // Makes a linear combination of two texpoints
  459. function TexPointCombine(const t1, t2: TTexPoint; f1, f2: Single): TTexPoint; inline;
  460. // Makes a linear combination of two vectors and return the result
  461. function VectorCombine(const V1, V2: TAffineVector; const f1, f2: Single): TAffineVector; overload; inline;
  462. // Makes a linear combination of three vectors and return the result
  463. function VectorCombine3(const V1, V2, V3: TAffineVector; const f1, f2, F3: Single): TAffineVector; overload;inline;
  464. procedure VectorCombine3(const V1, V2, V3: TAffineVector;
  465. const f1, f2, F3: Single; var vr: TAffineVector); overload;inline;
  466. // Combine the first vector with the second : vr:=vr+v*f
  467. procedure CombineVector(var vr: TGLVector; const V: TGLVector; var f: Single); overload;
  468. // Combine the first vector with the second : vr:=vr+v*f
  469. procedure CombineVector(var vr: TGLVector; const V: TAffineVector; var f: Single); overload;
  470. // Makes a linear combination of two vectors and return the result
  471. function VectorCombine(const V1, V2: TGLVector; const F1, F2: Single): TGLVector; overload; inline;
  472. // Makes a linear combination of two vectors and return the result
  473. function VectorCombine(const V1: TGLVector; const V2: TAffineVector;
  474. const F1, F2: Single): TGLVector; overload; inline;
  475. // Makes a linear combination of two vectors and place result in vr
  476. procedure VectorCombine(const V1: TGLVector; const V2: TAffineVector; const F1, F2: Single; var VR: TGLVector); overload;inline;
  477. // Makes a linear combination of two vectors and place result in vr
  478. procedure VectorCombine(const V1, V2: TGLVector; const F1, F2: Single; var vr: TGLVector); overload;
  479. // Makes a linear combination of two vectors and place result in vr, F1=1.0
  480. procedure VectorCombine(const V1, V2: TGLVector; const F2: Single; var vr: TGLVector); overload;
  481. // Makes a linear combination of three vectors and return the result
  482. function VectorCombine3(const V1, V2, V3: TGLVector; const F1, F2, F3: Single): TGLVector; overload; inline;
  483. // Makes a linear combination of three vectors and return the result
  484. procedure VectorCombine3(const V1, V2, V3: TGLVector; const F1, F2, F3: Single; var vr: TGLVector); overload;
  485. (* Calculates the dot product between V1 and V2.
  486. Result:=V1[X] * V2[X] + V1[Y] * V2[Y] *)
  487. function VectorDotProduct(const V1, V2: TVector2f): Single; overload;
  488. (* Calculates the dot product between V1 and V2.
  489. Result:=V1[X] * V2[X] + V1[Y] * V2[Y] + V1[Z] * V2[Z] *)
  490. function VectorDotProduct(const V1, V2: TAffineVector): Single; overload;
  491. (* Calculates the dot product between V1 and V2.
  492. Result:=V1[X] * V2[X] + V1[Y] * V2[Y] + V1[Z] * V2[Z] *)
  493. function VectorDotProduct(const V1, V2: TGLVector): Single; overload;
  494. (* Calculates the dot product between V1 and V2.
  495. Result:=V1[X] * V2[X] + V1[Y] * V2[Y] + V1[Z] * V2[Z] *)
  496. function VectorDotProduct(const V1: TGLVector; const V2: TAffineVector): Single; overload;
  497. (* Projects p on the line defined by o and direction.
  498. Performs VectorDotProduct(VectorSubtract(p, origin), direction), which,
  499. if direction is normalized, computes the distance between origin and the
  500. projection of p on the (origin, direction) line *)
  501. function PointProject(const p, origin, direction: TAffineVector): Single; overload;
  502. function PointProject(const p, origin, direction: TGLVector): Single; overload;
  503. // Calculates the cross product between vector 1 and 2
  504. function VectorCrossProduct(const V1, V2: TAffineVector): TAffineVector; overload;
  505. // Calculates the cross product between vector 1 and 2
  506. function VectorCrossProduct(const V1, V2: TGLVector): TGLVector; overload;
  507. // Calculates the cross product between vector 1 and 2, place result in vr
  508. procedure VectorCrossProduct(const V1, V2: TGLVector; var vr: TGLVector); overload;
  509. // Calculates the cross product between vector 1 and 2, place result in vr
  510. procedure VectorCrossProduct(const V1, V2: TAffineVector; var vr: TGLVector); overload;
  511. // Calculates the cross product between vector 1 and 2, place result in vr
  512. procedure VectorCrossProduct(const V1, V2: TGLVector; var vr: TAffineVector); overload;
  513. // Calculates the cross product between vector 1 and 2, place result in vr
  514. procedure VectorCrossProduct(const V1, V2: TAffineVector; var vr: TAffineVector); overload;
  515. // Calculates linear interpolation between start and stop at point t
  516. function Lerp(const start, stop, T: Single): Single; inline;
  517. // Calculates angular interpolation between start and stop at point t
  518. function AngleLerp(start, stop, T: Single): Single; inline;
  519. (* This is used for interpolating between 2 matrices. The result
  520. is used to reposition the model parts each frame. *)
  521. function MatrixLerp(const m1, m2: TGLMatrix; const delta: Single): TGLMatrix;
  522. (* Calculates the angular distance between two angles in radians.
  523. Result is in the [0; PI] range. *)
  524. function DistanceBetweenAngles(angle1, angle2: Single): Single;
  525. // Calculates linear interpolation between texpoint1 and texpoint2 at point t
  526. function TexPointLerp(const t1, t2: TTexPoint; T: Single): TTexPoint; overload; inline;
  527. // Calculates linear interpolation between vector1 and vector2 at point t
  528. function VectorLerp(const V1, V2: TAffineVector; T: Single): TAffineVector; overload; inline;
  529. // Calculates linear interpolation between vector1 and vector2 at point t, places result in vr
  530. procedure VectorLerp(const V1, V2: TAffineVector; T: Single; var vr: TAffineVector); overload;
  531. // Calculates linear interpolation between vector1 and vector2 at point t
  532. function VectorLerp(const V1, V2: TGLVector; T: Single): TGLVector; overload; inline;
  533. // Calculates linear interpolation between vector1 and vector2 at point t, places result in vr
  534. procedure VectorLerp(const V1, V2: TGLVector; T: Single; var vr: TGLVector); overload; inline;
  535. function VectorAngleLerp(const V1, V2: TAffineVector; T: Single): TAffineVector; overload;
  536. function VectorAngleCombine(const V1, V2: TAffineVector; f: Single): TAffineVector; overload;
  537. // Calculates linear interpolation between vector arrays
  538. procedure VectorArrayLerp(const src1, src2: PVectorArray; T: Single; n: Integer; dest: PVectorArray); overload;
  539. procedure VectorArrayLerp(const src1, src2: PAffineVectorArray; T: Single; n: Integer; dest: PAffineVectorArray); overload;
  540. procedure VectorArrayLerp(const src1, src2: PTexPointArray; T: Single; n: Integer; dest: PTexPointArray); overload;
  541. type
  542. TGLInterpolationType = (itLinear, itPower, itSin, itSinAlt, itTan, itLn, itExp);
  543. // There functions that do the same as "Lerp", but add some distortions
  544. function InterpolatePower(const start, stop, delta: Single; const DistortionDegree: Single): Single;
  545. function InterpolateLn(const start, stop, delta: Single; const DistortionDegree: Single): Single;
  546. function InterpolateExp(const start, stop, delta: Single; const DistortionDegree: Single): Single;
  547. // Only valid where Delta belongs to [0..1]
  548. function InterpolateSin(const start, stop, delta: Single): Single;
  549. function InterpolateTan(const start, stop, delta: Single): Single;
  550. // "Alt" functions are valid everywhere
  551. function InterpolateSinAlt(const start, stop, delta: Single): Single;
  552. function InterpolateCombinedFastPower(const OriginalStart, OriginalStop,
  553. OriginalCurrent: Single; const TargetStart, TargetStop: Single;
  554. const DistortionDegree: Single): Single; inline;
  555. function InterpolateCombinedSafe(const OriginalStart, OriginalStop,
  556. OriginalCurrent: Single; const TargetStart, TargetStop: Single;
  557. const DistortionDegree: Single;
  558. const InterpolationType: TGLInterpolationType): Single; inline;
  559. function InterpolateCombinedFast(const OriginalStart, OriginalStop,
  560. OriginalCurrent: Single; const TargetStart, TargetStop: Single;
  561. const DistortionDegree: Single;
  562. const InterpolationType: TGLInterpolationType): Single; inline;
  563. function InterpolateCombined(const start, stop, delta: Single;
  564. const DistortionDegree: Single;
  565. const InterpolationType: TGLInterpolationType): Single; inline;
  566. { Calculates the length of a vector following the equation sqrt(x*x+y*y). }
  567. function VectorLength(const X, Y: Single): Single; overload;
  568. { Calculates the length of a vector following the equation sqrt(x*x+y*y+z*z). }
  569. function VectorLength(const X, Y, Z: Single): Single; overload;
  570. // Calculates the length of a vector following the equation sqrt(x*x+y*y).
  571. function VectorLength(const V: TVector2f): Single; overload;
  572. // Calculates the length of a vector following the equation sqrt(x*x+y*y+z*z).
  573. function VectorLength(const V: TAffineVector): Single; overload;
  574. // Calculates the length of a vector following the equation sqrt(x*x+y*y+z*z+w*w).
  575. function VectorLength(const V: TGLVector): Single; overload;
  576. (* Calculates the length of a vector following the equation: sqrt(x*x+y*y+...).
  577. Note: The parameter of this function is declared as open array. Thus
  578. there's no restriction about the number of the components of the vector. *)
  579. function VectorLength(const V: array of Single): Single; overload;
  580. (* Calculates norm of a vector which is defined as norm = x * x + y * y
  581. Also known as "Norm 2" in the math world, this is sqr(VectorLength). *)
  582. function VectorNorm(const X, Y: Single): Single; overload;
  583. (* Calculates norm of a vector which is defined as norm = x*x + y*y + z*z
  584. Also known as "Norm 2" in the math world, this is sqr(VectorLength). *)
  585. function VectorNorm(const V: TAffineVector): Single; overload;
  586. (* Calculates norm of a vector which is defined as norm = x*x + y*y + z*z
  587. Also known as "Norm 2" in the math world, this is sqr(VectorLength). *)
  588. function VectorNorm(const V: TGLVector): Single; overload;
  589. (* Calculates norm of a vector which is defined as norm = v.X*v.X + ...
  590. Also known as "Norm 2" in the math world, this is sqr(VectorLength). *)
  591. function VectorNorm(var V: array of Single): Single; overload;
  592. // Transforms a vector to unit length
  593. procedure NormalizeVector(var V: TVector2f); overload;
  594. (* Returns the vector transformed to unit length
  595. Transforms a vector to unit length *)
  596. procedure NormalizeVector(var V: TAffineVector); overload;
  597. // Transforms a vector to unit length
  598. procedure NormalizeVector(var V: TGLVector); overload;
  599. // Returns the vector transformed to unit length
  600. function VectorNormalize(const V: TVector2f): TVector2f; overload;
  601. // Returns the vector transformed to unit length
  602. function VectorNormalize(const V: TAffineVector): TAffineVector; overload;
  603. // Returns the vector transformed to unit length (w component dropped)
  604. function VectorNormalize(const V: TGLVector): TGLVector; overload;
  605. // Transforms vectors to unit length
  606. procedure NormalizeVectorArray(list: PAffineVectorArray; n: Integer); overload; inline;
  607. (* Calculates the cosine of the angle between Vector1 and Vector2.
  608. Result = DotProduct(V1, V2) / (Length(V1) * Length(V2)) *)
  609. function VectorAngleCosine(const V1, V2: TAffineVector): Single; overload;
  610. (* Calculates the cosine of the angle between Vector1 and Vector2.
  611. Result = DotProduct(V1, V2) / (Length(V1) * Length(V2)) *)
  612. function VectorAngleCosine(const V1, V2: TGLVector): Single; overload;
  613. // Negates the vector
  614. function VectorNegate(const Vector: TAffineVector): TAffineVector; overload;
  615. function VectorNegate(const Vector: TGLVector): TGLVector; overload;
  616. // Negates the vector
  617. procedure NegateVector(var V: TAffineVector); overload;
  618. // Negates the vector
  619. procedure NegateVector(var V: TGLVector); overload;
  620. // Negates the vector
  621. procedure NegateVector(var V: array of Single); overload;
  622. // Scales given vector by a factor
  623. procedure ScaleVector(var V: TVector2f; factor: Single); overload;
  624. // Scales given vector by a factor
  625. procedure ScaleVector(var V: TAffineVector; factor: Single); overload;
  626. (* Scales given vector by another vector.
  627. v[x]:=v[x]*factor[x], v[y]:=v[y]*factor[y] etc. *)
  628. procedure ScaleVector(var V: TAffineVector; const factor: TAffineVector); overload;
  629. // Scales given vector by a factor
  630. procedure ScaleVector(var V: TGLVector; factor: Single); overload;
  631. (* Scales given vector by another vector.
  632. v[x]:=v[x]*factor[x], v[y]:=v[y]*factor[y] etc. *)
  633. procedure ScaleVector(var V: TGLVector; const factor: TGLVector); overload;
  634. // Returns a vector scaled by a factor
  635. function VectorScale(const V: TVector2f; factor: Single): TVector2f; overload;
  636. // Returns a vector scaled by a factor
  637. function VectorScale(const V: TAffineVector; factor: Single): TAffineVector; overload;
  638. // Scales a vector by a factor and places result in vr
  639. procedure VectorScale(const V: TAffineVector; factor: Single; var vr: TAffineVector); overload;
  640. // Returns a vector scaled by a factor
  641. function VectorScale(const V: TGLVector; factor: Single): TGLVector; overload;
  642. // Scales a vector by a factor and places result in vr
  643. procedure VectorScale(const V: TGLVector; factor: Single; var vr: TGLVector); overload;
  644. // Scales a vector by a factor and places result in vr
  645. procedure VectorScale(const V: TGLVector; factor: Single; var vr: TAffineVector); overload;
  646. // Scales given vector by another vector
  647. function VectorScale(const V: TAffineVector; const factor: TAffineVector): TAffineVector; overload;
  648. // RScales given vector by another vector
  649. function VectorScale(const V: TGLVector; const factor: TGLVector): TGLVector; overload;
  650. (* Divides given vector by another vector.
  651. v[x]:=v[x]/divider[x], v[y]:=v[y]/divider[y] etc. *)
  652. procedure DivideVector(var V: TGLVector; const divider: TGLVector); overload; inline;
  653. procedure DivideVector(var V: TAffineVector; const divider: TAffineVector); overload; inline;
  654. function VectorDivide(const V: TGLVector; const divider: TGLVector): TGLVector; overload; inline;
  655. function VectorDivide(const V: TAffineVector; const divider: TAffineVector): TAffineVector; overload; inline;
  656. // True if all components are equal.
  657. function TexpointEquals(const p1, p2: TTexPoint): Boolean; inline;
  658. // True if all components are equal.
  659. function RectEquals(const Rect1, Rect2: TRect): Boolean; inline;
  660. // True if all components are equal.
  661. function VectorEquals(const V1, V2: TGLVector): Boolean; overload; inline;
  662. // True if all components are equal.
  663. function VectorEquals(const V1, V2: TAffineVector): Boolean; overload; inline;
  664. // True if X, Y and Z components are equal.
  665. function AffineVectorEquals(const V1, V2: TGLVector): Boolean; overload; inline;
  666. // True if x=y=z=0, w ignored
  667. function VectorIsNull(const V: TGLVector): Boolean; overload; inline;
  668. // True if x=y=z=0, w ignored
  669. function VectorIsNull(const V: TAffineVector): Boolean; overload; inline;
  670. // Calculates Abs(v1[x]-v2[x])+Abs(v1[y]-v2[y]), also know as "Norm1".
  671. function VectorSpacing(const V1, V2: TTexPoint): Single; overload;
  672. // Calculates Abs(v1[x]-v2[x])+Abs(v1[y]-v2[y])+..., also know as "Norm1".
  673. function VectorSpacing(const V1, V2: TAffineVector): Single; overload;
  674. // Calculates Abs(v1[x]-v2[x])+Abs(v1[y]-v2[y])+..., also know as "Norm1".
  675. function VectorSpacing(const V1, V2: TGLVector): Single; overload;
  676. // Calculates distance between two vectors. ie. sqrt(sqr(v1[x]-v2[x])+...)
  677. function VectorDistance(const V1, V2: TAffineVector): Single; overload;
  678. (* Calculates distance between two vectors.
  679. ie. sqrt(sqr(v1[x]-v2[x])+...) (w component ignored) *)
  680. function VectorDistance(const V1, V2: TGLVector): Single; overload;
  681. // Calculates the "Norm 2" between two vectors. ie. sqr(v1[x]-v2[x])+...
  682. function VectorDistance2(const V1, V2: TAffineVector): Single; overload;
  683. // Calculates the "Norm 2" between two vectors. ie. sqr(v1[x]-v2[x])+...(w component ignored)
  684. function VectorDistance2(const V1, V2: TGLVector): Single; overload;
  685. // Calculates a vector perpendicular to N. N is assumed to be of unit length, subtract out any component parallel to N
  686. function VectorPerpendicular(const V, n: TAffineVector): TAffineVector;
  687. // Reflects vector V against N (assumes N is normalized)
  688. function VectorReflect(const V, n: TAffineVector): TAffineVector;
  689. // Rotates Vector about Axis with Angle radians
  690. procedure RotateVector(var Vector: TGLVector; const axis: TAffineVector; angle: Single); overload;
  691. // Rotates Vector about Axis with Angle radians
  692. procedure RotateVector(var Vector: TGLVector; const axis: TGLVector; angle: Single); overload;
  693. // Rotate given vector around the Y axis (alpha is in rad)
  694. procedure RotateVectorAroundY(var V: TAffineVector; alpha: Single);
  695. // Returns given vector rotated around the X axis (alpha is in rad)
  696. function VectorRotateAroundX(const V: TAffineVector; alpha: Single): TAffineVector; overload;
  697. // Returns given vector rotated around the Y axis (alpha is in rad)
  698. function VectorRotateAroundY(const V: TAffineVector; alpha: Single): TAffineVector; overload;
  699. // Returns given vector rotated around the Y axis in vr (alpha is in rad)
  700. procedure VectorRotateAroundY(const V: TAffineVector; alpha: Single; var vr: TAffineVector); overload;
  701. // Returns given vector rotated around the Z axis (alpha is in rad)
  702. function VectorRotateAroundZ(const V: TAffineVector; alpha: Single): TAffineVector; overload;
  703. // Vector components are replaced by their Abs() value. }
  704. procedure AbsVector(var V: TGLVector); overload; inline;
  705. // Vector components are replaced by their Abs() value. }
  706. procedure AbsVector(var V: TAffineVector); overload;inline;
  707. // Returns a vector with components replaced by their Abs value. }
  708. function VectorAbs(const V: TGLVector): TGLVector; overload; inline;
  709. // Returns a vector with components replaced by their Abs value. }
  710. function VectorAbs(const V: TAffineVector): TAffineVector; overload;inline;
  711. // Returns true if both vector are colinear
  712. function IsColinear(const V1, V2: TVector2f): Boolean; overload;
  713. // Returns true if both vector are colinear
  714. function IsColinear(const V1, V2: TAffineVector): Boolean; overload;
  715. // Returns true if both vector are colinear
  716. function IsColinear(const V1, V2: TGLVector): Boolean; overload;
  717. (* ----------------------------------------------------------------------------
  718. Matrix functions
  719. ---------------------------------------------------------------------------- *)
  720. procedure SetMatrix(var dest: THomogeneousDblMatrix; const src: TGLMatrix); overload;
  721. procedure SetMatrix(var dest: TAffineMatrix; const src: TGLMatrix); overload;
  722. procedure SetMatrix(var dest: TGLMatrix; const src: TAffineMatrix); overload;
  723. procedure SetMatrixRow(var dest: TGLMatrix; rowNb: Integer; const aRow: TGLVector); overload;
  724. // Creates scale matrix
  725. function CreateScaleMatrix(const V: TAffineVector): TGLMatrix; overload;
  726. // Creates scale matrix
  727. function CreateScaleMatrix(const V: TGLVector): TGLMatrix; overload;
  728. // Creates translation matrix
  729. function CreateTranslationMatrix(const V: TAffineVector): TGLMatrix; overload;
  730. // Creates translation matrix
  731. function CreateTranslationMatrix(const V: TGLVector): TGLMatrix; overload;
  732. { Creates a scale+translation matrix.
  733. Scale is applied BEFORE applying offset }
  734. function CreateScaleAndTranslationMatrix(const scale, offset: TGLVector): TGLMatrix; overload;
  735. // Creates matrix for rotation about x-axis (angle in rad)
  736. function CreateRotationMatrixX(const sine, cosine: Single): TGLMatrix; overload;
  737. function CreateRotationMatrixX(const angle: Single): TGLMatrix; overload;
  738. // Creates matrix for rotation about y-axis (angle in rad)
  739. function CreateRotationMatrixY(const sine, cosine: Single): TGLMatrix; overload;
  740. function CreateRotationMatrixY(const angle: Single): TGLMatrix; overload;
  741. // Creates matrix for rotation about z-axis (angle in rad)
  742. function CreateRotationMatrixZ(const sine, cosine: Single): TGLMatrix; overload;
  743. function CreateRotationMatrixZ(const angle: Single): TGLMatrix; overload;
  744. // Creates a rotation matrix along the given Axis by the given Angle in radians.
  745. function CreateRotationMatrix(const anAxis: TAffineVector; angle: Single): TGLMatrix; overload;
  746. function CreateRotationMatrix(const anAxis: TGLVector; angle: Single): TGLMatrix; overload;
  747. // Creates a rotation matrix along the given Axis by the given Angle in radians.
  748. function CreateAffineRotationMatrix(const anAxis: TAffineVector; angle: Single): TAffineMatrix;
  749. // Multiplies two 3x3 matrices
  750. function MatrixMultiply(const m1, m2: TAffineMatrix): TAffineMatrix; overload;
  751. // Multiplies two 4x4 matrices
  752. function MatrixMultiply(const m1, m2: TGLMatrix): TGLMatrix; overload;
  753. // Multiplies M1 by M2 and places result in MResult
  754. procedure MatrixMultiply(const m1, m2: TGLMatrix; var MResult: TGLMatrix); overload;
  755. // Transforms a homogeneous vector by multiplying it with a matrix
  756. function VectorTransform(const V: TGLVector; const M: TGLMatrix): TGLVector; overload;
  757. // Transforms a homogeneous vector by multiplying it with a matrix
  758. function VectorTransform(const V: TGLVector; const M: TAffineMatrix): TGLVector; overload;
  759. // Transforms an affine vector by multiplying it with a matrix
  760. function VectorTransform(const V: TAffineVector; const M: TGLMatrix): TAffineVector; overload;
  761. // Transforms an affine vector by multiplying it with a matrix
  762. function VectorTransform(const V: TAffineVector; const M: TAffineMatrix): TAffineVector; overload;
  763. // Determinant of a 3x3 matrix
  764. function MatrixDeterminant(const M: TAffineMatrix): Single; overload;
  765. // Determinant of a 4x4 matrix
  766. function MatrixDeterminant(const M: TGLMatrix): Single; overload;
  767. // Adjoint of a 4x4 matrix, used in the computation of the inverse of a 4x4 matrix
  768. procedure AdjointMatrix(var M: TGLMatrix); overload;
  769. // Adjoint of a 3x3 matrix, used in the computation of the inverse of a 3x3 matrix
  770. procedure AdjointMatrix(var M: TAffineMatrix); overload;
  771. // Multiplies all elements of a 3x3 matrix with a factor
  772. procedure ScaleMatrix(var M: TAffineMatrix; const factor: Single); overload;
  773. // Multiplies all elements of a 4x4 matrix with a factor
  774. procedure ScaleMatrix(var M: TGLMatrix; const factor: Single); overload;
  775. // Adds the translation vector into the matrix
  776. procedure TranslateMatrix(var M: TGLMatrix; const V: TAffineVector); overload;
  777. procedure TranslateMatrix(var M: TGLMatrix; const V: TGLVector); overload;
  778. (* Normalize the matrix and remove the translation component.
  779. The resulting matrix is an orthonormal matrix (Y direction preserved, then Z) *)
  780. procedure NormalizeMatrix(var M: TGLMatrix);
  781. // Computes transpose of 3x3 matrix
  782. procedure TransposeMatrix(var M: TAffineMatrix); overload;
  783. // Computes transpose of 4x4 matrix
  784. procedure TransposeMatrix(var M: TGLMatrix); overload;
  785. // Finds the inverse of a 4x4 matrix
  786. procedure InvertMatrix(var M: TGLMatrix); overload;
  787. function MatrixInvert(const M: TGLMatrix): TGLMatrix; overload;
  788. // Finds the inverse of a 3x3 matrix;
  789. procedure InvertMatrix(var M: TAffineMatrix); overload;
  790. function MatrixInvert(const M: TAffineMatrix): TAffineMatrix; overload;
  791. (* Finds the inverse of an angle preserving matrix.
  792. Angle preserving matrices can combine translation, rotation and isotropic
  793. scaling, other matrices won't be properly inverted by this function. *)
  794. function AnglePreservingMatrixInvert(const mat: TGLMatrix): TGLMatrix;
  795. (* Decompose a non-degenerated 4x4 transformation matrix into the sequence of transformations that produced it.
  796. Modified by ml then eg, original Author: Spencer W. Thomas, University of Michigan
  797. The coefficient of each transformation is returned in the corresponding
  798. element of the vector Tran. Returns true upon success, false if the matrix is singular. *)
  799. function MatrixDecompose(const M: TGLMatrix; var Tran: TTransformations): Boolean;
  800. function CreateLookAtMatrix(const eye, center, normUp: TGLVector): TGLMatrix;
  801. function CreateMatrixFromFrustum(Left, Right, Bottom, Top, ZNear, ZFar: Single): TGLMatrix;
  802. function CreatePerspectiveMatrix(FOV, Aspect, ZNear, ZFar: Single): TGLMatrix;
  803. function CreateOrthoMatrix(Left, Right, Bottom, Top, ZNear, ZFar: Single): TGLMatrix;
  804. function CreatePickMatrix(X, Y, deltax, deltay: Single; const viewport: TVector4i): TGLMatrix;
  805. function Project(objectVector: TGLVector; const ViewProjMatrix: TGLMatrix; const viewport: TVector4i; out WindowVector: TGLVector): Boolean;
  806. function UnProject(WindowVector: TGLVector; ViewProjMatrix: TGLMatrix; const viewport: TVector4i; out objectVector: TGLVector): Boolean;
  807. (* ----------------------------------------------------------------------------
  808. Plane functions
  809. -----------------------------------------------------------------------------*)
  810. // Computes the parameters of a plane defined by three points.
  811. function PlaneMake(const p1, p2, p3: TAffineVector): THmgPlane; overload;
  812. function PlaneMake(const p1, p2, p3: TGLVector): THmgPlane; overload;
  813. // Computes the parameters of a plane defined by a point and a normal.
  814. function PlaneMake(const point, normal: TAffineVector): THmgPlane; overload;
  815. function PlaneMake(const point, normal: TGLVector): THmgPlane; overload;
  816. // Converts from single to double representation
  817. procedure SetPlane(var dest: TDoubleHmgPlane; const src: THmgPlane);
  818. // Normalize a plane so that point evaluation = plane distance. }
  819. procedure NormalizePlane(var plane: THmgPlane);
  820. (* Calculates the cross-product between the plane normal and plane to point vector.
  821. This functions gives an hint as to were the point is, if the point is in the
  822. half-space pointed by the vector, result is positive.
  823. This function performs an homogeneous space dot-product. *)
  824. function PlaneEvaluatePoint(const plane: THmgPlane; const point: TAffineVector): Single; overload;
  825. function PlaneEvaluatePoint(const plane: THmgPlane; const point: TGLVector): Single; overload;
  826. // Calculate the normal of a plane defined by three points.
  827. function CalcPlaneNormal(const p1, p2, p3: TAffineVector): TAffineVector; overload;
  828. procedure CalcPlaneNormal(const p1, p2, p3: TAffineVector; var vr: TAffineVector); overload;
  829. procedure CalcPlaneNormal(const p1, p2, p3: TGLVector; var vr: TAffineVector); overload;
  830. (* Returns true if point is in the half-space defined by a plane with normal.
  831. The plane itself is not considered to be in the tested halfspace. *)
  832. function PointIsInHalfSpace(const point, planePoint, planeNormal: TGLVector): Boolean; overload;
  833. function PointIsInHalfSpace(const point, planePoint, planeNormal: TAffineVector): Boolean; overload;
  834. function PointIsInHalfSpace(const point: TAffineVector; const plane: THmgPlane): Boolean; overload;
  835. (* Computes algebraic distance between point and plane.
  836. Value will be positive if the point is in the halfspace pointed by the normal,
  837. negative on the other side. *)
  838. function PointPlaneDistance(const point, planePoint, planeNormal: TGLVector): Single; overload;
  839. function PointPlaneDistance(const point, planePoint, planeNormal: TAffineVector): Single; overload;
  840. function PointPlaneDistance(const point: TAffineVector; const plane: THmgPlane): Single; overload;
  841. // Computes point to plane projection. Plane and direction have to be normalized
  842. function PointPlaneOrthoProjection(const point: TAffineVector; const plane: THmgPlane; var inter: TAffineVector; bothface: Boolean = True): Boolean;
  843. function PointPlaneProjection(const point, direction: TAffineVector; const plane: THmgPlane; var inter: TAffineVector; bothface: Boolean = True): Boolean;
  844. // Computes segment / plane intersection return false if there isn't an intersection
  845. function SegmentPlaneIntersection(const ptA, ptB: TAffineVector; const plane: THmgPlane; var inter: TAffineVector): Boolean;
  846. // Computes point to triangle projection. Direction has to be normalized
  847. function PointTriangleOrthoProjection(const point, ptA, ptB, ptC: TAffineVector; var inter: TAffineVector; bothface: Boolean = True): Boolean;
  848. function PointTriangleProjection(const point, direction, ptA, ptB, ptC: TAffineVector; var inter: TAffineVector; bothface: Boolean = True): Boolean;
  849. // Returns true if line intersect ABC triangle
  850. function IsLineIntersectTriangle(const point, direction, ptA, ptB, ptC: TAffineVector): Boolean;
  851. // Computes point to Quad projection. Direction has to be normalized. Quad have to be flat and convex
  852. function PointQuadOrthoProjection(const point, ptA, ptB, ptC, ptD: TAffineVector; var inter: TAffineVector; bothface: Boolean = True): Boolean;
  853. function PointQuadProjection(const point, direction, ptA, ptB, ptC, ptD: TAffineVector; var inter: TAffineVector; bothface: Boolean = True): Boolean;
  854. // Returns true if line intersect ABCD quad. Quad have to be flat and convex
  855. function IsLineIntersectQuad(const point, direction, ptA, ptB, ptC, ptD: TAffineVector): Boolean;
  856. // Computes point to disk projection. Direction has to be normalized
  857. function PointDiskOrthoProjection(const point, center, up: TAffineVector; const radius: Single; var inter: TAffineVector; bothface: Boolean = True): Boolean;
  858. function PointDiskProjection(const point, direction, center, up: TAffineVector; const radius: Single; var inter: TAffineVector; bothface: Boolean = True): Boolean;
  859. // Computes closest point on a segment (a segment is a limited line)
  860. function PointSegmentClosestPoint(const point, segmentStart, segmentStop: TAffineVector): TAffineVector; overload;
  861. function PointSegmentClosestPoint(const point, segmentStart, segmentStop: TGLVector): TGLVector; overload;
  862. // Computes algebraic distance between segment and line (a segment is a limited line)
  863. function PointSegmentDistance(const point, segmentStart, segmentStop: TAffineVector): Single;
  864. // Computes closest point on a line
  865. function PointLineClosestPoint(const point, linePoint, lineDirection: TAffineVector): TAffineVector;
  866. // Computes algebraic distance between point and line
  867. function PointLineDistance(const point, linePoint, lineDirection: TAffineVector): Single;
  868. // Computes the closest points (2) given two segments
  869. procedure SegmentSegmentClosestPoint(const S0Start, S0Stop, S1Start,
  870. S1Stop: TAffineVector; var Segment0Closest, Segment1Closest: TAffineVector);
  871. // Computes the closest distance between two segments
  872. function SegmentSegmentDistance(const S0Start, S0Stop, S1Start, S1Stop: TAffineVector): Single;
  873. // Computes the closest distance between two lines
  874. function LineLineDistance(const linePt0, lineDir0, linePt1, lineDir1: TAffineVector): Single;
  875. (* ----------------------------------------------------------------------------
  876. Quaternion functions
  877. ----------------------------------------------------------------------------*)
  878. type
  879. TEulerOrder = (eulXYZ, eulXZY, eulYXZ, eulYZX, eulZXY, eulZYX);
  880. // Creates a quaternion from the given values
  881. function QuaternionMake(const Imag: array of Single; Real: Single): TQuaternion; overload;
  882. function QuaternionMake(const X,Y,Z,W: Single): TQuaternion; overload;
  883. function QuaternionMake(const V: TGLVector): TQuaternion; overload;
  884. // Returns the conjugate of a quaternion
  885. function QuaternionConjugate(const Q: TQuaternion): TQuaternion;
  886. // Returns the magnitude of the quaternion
  887. function QuaternionMagnitude(const Q: TQuaternion): Single;
  888. // Normalizes the given quaternion
  889. procedure NormalizeQuaternion(var Q: TQuaternion);
  890. // Constructs a unit quaternion from two points on unit sphere
  891. function QuaternionFromPoints(const V1, V2: TAffineVector): TQuaternion;
  892. // Converts a unit quaternion into two points on a unit sphere
  893. procedure QuaternionToPoints(const Q: TQuaternion; var ArcFrom, ArcTo: TAffineVector);
  894. // Constructs a unit quaternion from a rotation matrix
  895. function QuaternionFromMatrix(const mat: TGLMatrix): TQuaternion;
  896. (* Constructs a rotation matrix from (possibly non-unit) quaternion.
  897. Assumes matrix is used to multiply column vector on the left: vnew = mat vold.
  898. Works correctly for right-handed coordinate system and right-handed rotations *)
  899. function QuaternionToMatrix(quat: TQuaternion): TGLMatrix;
  900. // Constructs an affine rotation matrix from (possibly non-unit) quaternion
  901. function QuaternionToAffineMatrix(quat: TQuaternion): TAffineMatrix;
  902. // Constructs quaternion from angle (in deg) and axis
  903. function QuaternionFromAngleAxis(const angle: Single; const axis: TAffineVector): TQuaternion;
  904. // Constructs quaternion from Euler angles
  905. function QuaternionFromRollPitchYaw(const r, p, Y: Single): TQuaternion;
  906. // Constructs quaternion from Euler angles in arbitrary order (angles in degrees)
  907. function QuaternionFromEuler(const X, Y, Z: Single; eulerOrder: TEulerOrder): TQuaternion;
  908. (* Returns quaternion product qL * qR. Note: order is important!
  909. To combine rotations, use the product QuaternionMuliply(qSecond, qFirst),
  910. which gives the effect of rotating by qFirst then qSecond *)
  911. function QuaternionMultiply(const qL, qR: TQuaternion): TQuaternion;
  912. (* Spherical linear interpolation of unit quaternions with spins.
  913. QStart, QEnd - start and end unit quaternions
  914. t - interpolation parameter (0 to 1)
  915. Spin - number of extra spin rotations to involve *)
  916. function QuaternionSlerp(const QStart, QEnd: TQuaternion; Spin: Integer; T: Single): TQuaternion; overload;
  917. function QuaternionSlerp(const source, dest: TQuaternion; const T: Single): TQuaternion; overload;
  918. (* ----------------------------------------------------------------------------
  919. Exponential functions
  920. -----------------------------------------------------------------------------*)
  921. function Logarithm2(const X: Single): Single; inline;
  922. // Raise base to any power. For fractional exponents, or |exponents| > MaxInt, base must be > 0
  923. function PowerSingle(const Base, Exponent: Single): Single; overload;
  924. // Raise base to an integer
  925. function PowerInteger(Base: Single; Exponent: Integer): Single; overload;
  926. function PowerInt64(Base: Single; Exponent: Int64): Single; overload;
  927. (* ----------------------------------------------------------------------------
  928. Trigonometric functions
  929. ----------------------------------------------------------------------------*)
  930. function DegToRadian(const Degrees: Extended): Extended; overload;
  931. function DegToRadian(const Degrees: Single): Single; overload;
  932. function RadianToDeg(const Radians: Extended): Extended; overload;
  933. function RadianToDeg(const Radians: Single): Single; overload;
  934. // Normalize to an angle in the [-PI; +PI] range
  935. function NormalizeAngle(angle: Single): Single;
  936. // Normalize to an angle in the [-180; 180] range
  937. function NormalizeDegAngle(angle: Single): Single;
  938. // Calculates sine and cosine from the given angle Theta
  939. procedure SinCosine(const Theta: Double; out Sin, Cos: Double); overload;
  940. // Calculates sine and cosine from the given angle Theta
  941. procedure SinCosine(const Theta: Single; out Sin, Cos: Single); overload;
  942. (* Calculates sine and cosine from the given angle Theta and Radius.
  943. sin and cos values calculated from theta are multiplicated by radius *)
  944. procedure SinCosine(const Theta, radius: Double; out Sin, Cos: Double); overload;
  945. (* Calculates sine and cosine from the given angle Theta and Radius.
  946. sin and cos values calculated from theta are multiplicated by radius *)
  947. procedure SinCosine(const Theta, radius: Single; out Sin, Cos: Single); overload;
  948. (* Fills up the two given dynamic arrays with sin cos values.
  949. start and stop angles must be given in degrees, the number of steps is
  950. determined by the length of the given arrays. *)
  951. procedure PrepareSinCosCache(var S, c: array of Single; startAngle, stopAngle: Single);
  952. function ArcCosine(const X: Extended): Extended; overload;
  953. // Fast ArcTangent2 approximation, about 0.07 rads accuracy
  954. function FastArcTangent2(Y, X: Single): Single;
  955. // ------------------------------------------------------------------------------
  956. // Miscellanious math functions
  957. // ------------------------------------------------------------------------------
  958. // Computes 1/Sqrt(v)
  959. function RSqrt(V: Single): Single;
  960. // Computes 1/Sqrt(Sqr(x)+Sqr(y)).
  961. function RLength(X, Y: Single): Single;
  962. // Computes an integer sqrt approximation
  963. function ISqrt(i: Integer): Integer;
  964. // Computes an integer length Result:=Sqrt(x*x+y*y)
  965. function ILength(X, Y: Integer): Integer; overload;
  966. function ILength(X, Y, Z: Integer): Integer; overload;
  967. // Generates a random point on the unit sphere.
  968. // Point repartition is correctly isotropic with no privilegied direction
  969. procedure RandomPointOnSphere(var p: TAffineVector);
  970. // Rounds the floating point value to the closest integer.
  971. // Behaves like Round but returns a floating point value like Int.
  972. function RoundInt(V: Single): Single; overload;
  973. function RoundInt(V: Extended): Extended; overload;
  974. // Multiples i by s and returns the rounded result.
  975. function ScaleAndRound(i: Integer; var S: Single): Integer;
  976. // Returns the sign of the x value using the (-1, 0, +1) convention
  977. function SignStrict(X: Single): Integer;
  978. // Returns True if x is in [a; b]
  979. function IsInRange(const X, a, b: Single): Boolean; overload;
  980. function IsInRange(const X, a, b: Double): Boolean; overload;
  981. // Returns True if p is in the cube defined by d.
  982. function IsInCube(const p, d: TAffineVector): Boolean; overload;
  983. function IsInCube(const p, d: TGLVector): Boolean; overload;
  984. // Returns the minimum value of the array.
  985. function MinFloat(values: PSingleArray; nbItems: Integer): Single; overload;
  986. function MinFloat(values: PDoubleArray; nbItems: Integer): Double; overload;
  987. function MinFloat(values: PExtendedArray; nbItems: Integer): Extended; overload;
  988. // Returns the minimum of given values.
  989. function MinFloat(const V1, V2: Single): Single; overload;
  990. function MinFloat(const V: array of Single): Single; overload;
  991. function MinFloat(const V1, V2: Double): Double; overload;
  992. {$IFDEF USE_PLATFORM_HAS_EXTENDED}
  993. function MinFloat(const V1, V2: Extended): Extended; overload;
  994. {$ENDIF}
  995. function MinFloat(const V1, V2, V3: Single): Single; overload;
  996. function MinFloat(const V1, V2, V3: Double): Double; overload;
  997. {$IFDEF USE_PLATFORM_HAS_EXTENDED}
  998. function MinFloat(const V1, V2, V3: Extended): Extended; overload;
  999. {$ENDIF}
  1000. // Returns the maximum value of the array.
  1001. function MaxFloat(values: PSingleArray; nbItems: Integer): Single; overload;
  1002. function MaxFloat(values: PDoubleArray; nbItems: Integer): Double; overload;
  1003. function MaxFloat(values: PExtendedArray; nbItems: Integer): Extended; overload;
  1004. function MaxFloat(const V: array of Single): Single; overload;
  1005. // Returns the maximum of given values.
  1006. function MaxFloat(const V1, V2: Single): Single; overload;
  1007. function MaxFloat(const V1, V2: Double): Double; overload;
  1008. {$IFDEF USE_PLATFORM_HAS_EXTENDED}
  1009. function MaxFloat(const V1, V2: Extended): Extended; overload;
  1010. {$ENDIF USE_PLATFORM_HAS_EXTENDED}
  1011. function MaxFloat(const V1, V2, V3: Single): Single; overload;
  1012. function MaxFloat(const V1, V2, V3: Double): Double; overload;
  1013. {$IFDEF USE_PLATFORM_HAS_EXTENDED}
  1014. function MaxFloat(const V1, V2, V3: Extended): Extended; overload;
  1015. {$ENDIF USE_PLATFORM_HAS_EXTENDED}
  1016. function MinInteger(const V1, V2: Integer): Integer; overload;
  1017. function MinInteger(const V1, V2: Cardinal): Cardinal; overload;
  1018. function MinInteger(const V1, V2, V3: Integer): Integer; overload;
  1019. function MinInteger(const V1, V2, V3: Cardinal): Cardinal; overload;
  1020. function MaxInteger(const V1, V2: Integer): Integer; overload;
  1021. function MaxInteger(const V1, V2: Cardinal): Cardinal; overload;
  1022. function MaxInteger(const V1, V2, V3: Integer): Integer; overload;
  1023. function MaxInteger(const V1, V2, V3: Cardinal): Cardinal; overload;
  1024. function ClampInteger(const value, min, max: Integer): Integer; overload; inline;
  1025. function ClampInteger(const value, min, max: Cardinal): Cardinal; overload; inline;
  1026. // Computes the triangle's area
  1027. function TriangleArea(const p1, p2, p3: TAffineVector): Single; overload;
  1028. // Computes the polygons's area. Points must be coplanar. Polygon needs not be convex
  1029. function PolygonArea(const p: PAffineVectorArray; nSides: Integer): Single; overload;
  1030. // Computes a 2D triangle's signed area. Only X and Y coordinates are used, Z is ignored
  1031. function TriangleSignedArea(const p1, p2, p3: TAffineVector): Single; overload;
  1032. // Computes a 2D polygon's signed area. Only X and Y coordinates are used, Z is ignored. Polygon needs not be convex
  1033. function PolygonSignedArea(const p: PAffineVectorArray; nSides: Integer): Single; overload;
  1034. (* Multiplies values in the array by factor.
  1035. This function is especially efficient for large arrays, it is not recommended
  1036. for arrays that have less than 10 items.
  1037. Expected performance is 4 to 5 times that of a Deliph-compiled loop on AMD
  1038. CPUs, and 2 to 3 when 3DNow! isn't available *)
  1039. procedure ScaleFloatArray(values: PSingleArray; nb: Integer; var factor: Single); overload;
  1040. procedure ScaleFloatArray(var values: TSingleArray; factor: Single); overload;
  1041. // Adds delta to values in the array. Array size must be a multiple of four
  1042. procedure OffsetFloatArray(values: PSingleArray; nb: Integer; var delta: Single); overload;
  1043. procedure OffsetFloatArray(var values: array of Single; delta: Single); overload;
  1044. procedure OffsetFloatArray(valuesDest, valuesDelta: PSingleArray; nb: Integer); overload;
  1045. // Returns the max of the X, Y and Z components of a vector (W is ignored)
  1046. function MaxXYZComponent(const V: TGLVector): Single; overload;
  1047. function MaxXYZComponent(const V: TAffineVector): Single; overload;
  1048. // Returns the min of the X, Y and Z components of a vector (W is ignored)
  1049. function MinXYZComponent(const V: TGLVector): Single; overload;
  1050. function MinXYZComponent(const V: TAffineVector): Single; overload;
  1051. // Returns the max of the Abs(X), Abs(Y) and Abs(Z) components of a vector (W is ignored)
  1052. function MaxAbsXYZComponent(V: TGLVector): Single;
  1053. // Returns the min of the Abs(X), Abs(Y) and Abs(Z) components of a vector (W is ignored)
  1054. function MinAbsXYZComponent(V: TGLVector): Single;
  1055. // Replace components of v with the max of v or v1 component. Maximum is computed per component
  1056. procedure MaxVector(var V: TGLVector; const V1: TGLVector); overload;
  1057. procedure MaxVector(var V: TAffineVector; const V1: TAffineVector); overload;
  1058. // Replace components of v with the min of v or v1 component. Minimum is computed per component
  1059. procedure MinVector(var V: TGLVector; const V1: TGLVector); overload;
  1060. procedure MinVector(var V: TAffineVector; const V1: TAffineVector); overload;
  1061. // Sorts given array in ascending order. NOTE : current implementation is a slow bubble sort...
  1062. procedure SortArrayAscending(var a: array of Extended);
  1063. // Clamps aValue in the aMin-aMax interval
  1064. function ClampValue(const aValue, aMin, aMax: Single): Single; overload;
  1065. // Clamps aValue in the aMin-INF interval
  1066. function ClampValue(const aValue, aMin: Single): Single; overload;
  1067. // Returns the detected optimization mode. Returned values is either 'FPU', '3DNow!' or 'SSE'
  1068. function GeometryOptimizationMode: String;
  1069. (* Begins a FPU-only section.
  1070. You can use a FPU-only section to force use of FPU versions of the math
  1071. functions, though typically slower than their SIMD counterparts, they have
  1072. a higher precision (80 bits internally) that may be required in some cases.
  1073. Each BeginFPUOnlySection call must be balanced by a EndFPUOnlySection (calls
  1074. can be nested). *)
  1075. procedure BeginFPUOnlySection;
  1076. // Ends a FPU-only section. See BeginFPUOnlySection
  1077. procedure EndFPUOnlySection;
  1078. // --------------------- Unstandardized functions after these lines
  1079. // Mixed functions
  1080. // Turn a triplet of rotations about x, y, and z (in that order) into an equivalent rotation around a single axis (all in radians)
  1081. function ConvertRotation(const Angles: TAffineVector): TGLVector;
  1082. // Miscellaneous functions
  1083. function MakeAffineDblVector(var V: array of Double): TAffineDblVector;
  1084. function MakeDblVector(var V: array of Double): THomogeneousDblVector;
  1085. // Converts a vector containing double sized values into a vector with single sized values
  1086. function VectorAffineDblToFlt(const V: TAffineDblVector): TAffineVector;
  1087. // Converts a vector containing double sized values into a vector with single sized values
  1088. function VectorDblToFlt(const V: THomogeneousDblVector): THomogeneousVector;
  1089. // Converts a vector containing single sized values into a vector with double sized values
  1090. function VectorAffineFltToDbl(const V: TAffineVector): TAffineDblVector;
  1091. // Converts a vector containing single sized values into a vector with double sized values
  1092. function VectorFltToDbl(const V: TGLVector): THomogeneousDblVector;
  1093. (* The code below is from Wm. Randolph Franklin <[email protected]>
  1094. with some minor modifications for speed. It returns 1 for strictly
  1095. interior points, 0 for strictly exterior, and 0 or 1 for points on the boundary *)
  1096. function PointInPolygon(const xp, yp: array of Single; X, Y: Single): Boolean;
  1097. // PtInRegion
  1098. function IsPointInPolygon(const Polygon: array of TPoint; const p: TPoint): Boolean;
  1099. procedure DivMod(Dividend: Integer; Divisor: Word; var result, Remainder: Word);
  1100. // Coordinate system manipulation functions
  1101. // Rotates the given coordinate system (represented by the matrix) around its Y-axis
  1102. function Turn(const Matrix: TGLMatrix; Angle: Single): TGLMatrix; overload;
  1103. // Rotates the given coordinate system (represented by the matrix) around MasterUp
  1104. function Turn(const Matrix: TGLMatrix; const MasterUp: TAffineVector; Angle: Single): TGLMatrix; overload;
  1105. // Rotates the given coordinate system (represented by the matrix) around its X-axis
  1106. function Pitch(const Matrix: TGLMatrix; Angle: Single): TGLMatrix; overload;
  1107. // Rotates the given coordinate system (represented by the matrix) around MasterRight
  1108. function Pitch(const Matrix: TGLMatrix; const MasterRight: TAffineVector; Angle: Single): TGLMatrix; overload;
  1109. // Rotates the given coordinate system (represented by the matrix) around its Z-axis
  1110. function Roll(const Matrix: TGLMatrix; Angle: Single): TGLMatrix; overload;
  1111. // Rotates the given coordinate system (represented by the matrix) around MasterDirection
  1112. function Roll(const Matrix: TGLMatrix; const MasterDirection: TAffineVector; Angle: Single): TGLMatrix; overload;
  1113. // Intersection functions
  1114. (* Compute the intersection point "res" of a line with a plane.
  1115. Return value:
  1116. 0 : no intersection, line parallel to plane
  1117. 1 : res is valid
  1118. -1 : line is inside plane
  1119. Adapted from:
  1120. E.Hartmann, Computeruntersttzte Darstellende Geometrie, B.G. Teubner Stuttgart 1988 *)
  1121. function IntersectLinePlane(const point, direction: TGLVector;
  1122. const plane: THmgPlane; intersectPoint: PGLVector = nil): Integer; overload;
  1123. (* Compute intersection between a triangle and a box.
  1124. Returns True if an intersection was found *)
  1125. function IntersectTriangleBox(const p1, p2, p3, aMinExtent, aMaxExtent: TAffineVector): Boolean;
  1126. (* Compute intersection between a Sphere and a box.
  1127. Up, Direction and Right must be normalized!
  1128. Use CubDepth, CubeHeight and CubeWidth to scale TGLCube *)
  1129. function IntersectSphereBox(const SpherePos: TGLVector;
  1130. const SphereRadius: Single; const BoxMatrix: TGLMatrix;
  1131. const BoxScale: TAffineVector; intersectPoint: PAffineVector = nil;
  1132. normal: PAffineVector = nil; depth: PSingle = nil): Boolean;
  1133. (* Compute intersection between a ray and a plane.
  1134. Returns True if an intersection was found, the intersection point is placed
  1135. in intersectPoint is the reference is not nil *)
  1136. function RayCastPlaneIntersect(const rayStart, rayVector: TGLVector;
  1137. const planePoint, planeNormal: TGLVector; intersectPoint: PGLVector = nil): Boolean; overload;
  1138. function RayCastPlaneXZIntersect(const rayStart, rayVector: TGLVector;
  1139. const planeY: Single; intersectPoint: PGLVector = nil): Boolean; overload;
  1140. // Compute intersection between a ray and a triangle
  1141. function RayCastTriangleIntersect(const rayStart, rayVector: TGLVector;
  1142. const p1, p2, p3: TAffineVector; intersectPoint: PGLVector = nil;
  1143. intersectNormal: PGLVector = nil): Boolean; overload;
  1144. // Compute the min distance a ray will pass to a point
  1145. function RayCastMinDistToPoint(const rayStart, rayVector: TGLVector; const point: TGLVector): Single;
  1146. // Determines if a ray will intersect with a given sphere
  1147. function RayCastIntersectsSphere(const rayStart, rayVector: TGLVector;
  1148. const sphereCenter: TGLVector; const SphereRadius: Single): Boolean; overload;
  1149. (* Calculates the intersections between a sphere and a ray.
  1150. Returns 0 if no intersection is found (i1 and i2 untouched), 1 if one
  1151. intersection was found (i1 defined, i2 untouched), and 2 is two intersections
  1152. were found (i1 and i2 defined) *)
  1153. function RayCastSphereIntersect(const rayStart, rayVector: TGLVector;
  1154. const sphereCenter: TGLVector; const SphereRadius: Single; var i1, i2: TGLVector): Integer; overload;
  1155. (* Compute intersection between a ray and a box.
  1156. Returns True if an intersection was found, the intersection point is
  1157. placed in intersectPoint if the reference is not nil *)
  1158. function RayCastBoxIntersect(const rayStart, rayVector, aMinExtent,
  1159. aMaxExtent: TAffineVector; intersectPoint: PAffineVector = nil): Boolean;
  1160. (* Some 2d intersection functions *)
  1161. // Determine if 2 rectanges intersect
  1162. function RectanglesIntersect(const ACenterOfRect1, ACenterOfRect2, ASizeOfRect1,
  1163. ASizeOfRect2: TVector2f): Boolean;
  1164. // Determine if BigRect completely contains SmallRect
  1165. function RectangleContains(const ACenterOfBigRect1, ACenterOfSmallRect2,
  1166. ASizeOfBigRect1, ASizeOfSmallRect2: TVector2f;
  1167. const AEps: Single = 0.0): Boolean;
  1168. (* Computes the visible radius of a sphere in a perspective projection.
  1169. This radius can be used for occlusion culling (cone extrusion) or 2D
  1170. intersection testing. *)
  1171. function SphereVisibleRadius(distance, radius: Single): Single;
  1172. // Extracts a TFrustum for combined modelview and projection matrices
  1173. function ExtractFrustumFromModelViewProjection(const modelViewProj: TGLMatrix): TFrustum;
  1174. // Determines if volume is clipped or not
  1175. function IsVolumeClipped(const objPos: TAffineVector; const objRadius: Single;
  1176. const Frustum: TFrustum): Boolean; overload;
  1177. function IsVolumeClipped(const objPos: TGLVector; const objRadius: Single;
  1178. const Frustum: TFrustum): Boolean; overload; inline;
  1179. function IsVolumeClipped(const min, max: TAffineVector; const Frustum: TFrustum): Boolean; overload; inline;
  1180. (* Misc funcs *)
  1181. (* Creates a parallel projection matrix.
  1182. Transformed points will projected on the plane along the specified direction *)
  1183. function MakeParallelProjectionMatrix(const plane: THmgPlane; const dir: TGLVector): TGLMatrix;
  1184. (* Creates a shadow projection matrix.
  1185. Shadows will be projected onto the plane defined by planePoint and planeNormal,
  1186. from lightPos *)
  1187. function MakeShadowMatrix(const planePoint, planeNormal, lightPos: TGLVector): TGLMatrix;
  1188. (* Builds a reflection matrix for the given plane.
  1189. Reflection matrix allow implementing planar reflectors (mirrors) *)
  1190. function MakeReflectionMatrix(const planePoint, planeNormal: TAffineVector): TGLMatrix;
  1191. (* Packs an homogeneous rotation matrix to 6 bytes.
  1192. The 6:64 (or 6:36) compression ratio is achieved by computing the quaternion
  1193. associated to the matrix and storing its Imaginary components at 16 bits
  1194. precision each. Deviation is typically below 0.01% and around 0.1% in worst case situations.
  1195. Note: quaternion conversion is faster and more robust than an angle decomposition *)
  1196. function PackRotationMatrix(const mat: TGLMatrix): TPackedRotationMatrix;
  1197. // Restores a packed rotation matrix. See PackRotationMatrix
  1198. function UnPackRotationMatrix(const packedMatrix: TPackedRotationMatrix): TGLMatrix;
  1199. (* Calculates the barycentric coordinates for the point p on the triangle
  1200. defined by the vertices v1, v2 and v3. That is, solves
  1201. p = u * v1 + v * v2 + (1-u-v) * v3
  1202. for u,v.
  1203. Returns true if the point is inside the triangle, false otherwise.
  1204. NOTE: This function assumes that the point lies on the plane defined by the triangle.
  1205. If this is not the case, the function will not work correctly! *)
  1206. function BarycentricCoordinates(const V1, V2, V3, p: TAffineVector; var u, V: Single): Boolean;
  1207. (*Calculates angles for the Camera.MoveAroundTarget(pitch, turn) procedure.
  1208. Initially from then GLCameraColtroller unit, requires AOriginalUpVector to contain only -1, 0 or 1.
  1209. Result contains pitch and turn angles *)
  1210. function GetSafeTurnAngle(const AOriginalPosition, AOriginalUpVector,
  1211. ATargetPosition, AMoveAroundTargetCenter: TGLVector): TVector2f; overload;
  1212. function GetSafeTurnAngle(const AOriginalPosition, AOriginalUpVector,
  1213. ATargetPosition, AMoveAroundTargetCenter: TAffineVector): TVector2f; overload;
  1214. // Extracted from Camera.MoveAroundTarget(pitch, turn)
  1215. function MoveObjectAround(const AMovingObjectPosition, AMovingObjectUp,
  1216. ATargetPosition: TGLVector; pitchDelta, turnDelta: Single): TGLVector;
  1217. // Calcualtes Angle between 2 Vectors: (A-CenterPoint) and (B-CenterPoint). In radians
  1218. function AngleBetweenVectors(const a, b, ACenterPoint: TGLVector): Single; overload;
  1219. function AngleBetweenVectors(const a, b, ACenterPoint: TAffineVector): Single; overload;
  1220. (*AOriginalPosition - Object initial position.
  1221. ACenter - some point, from which is should be distanced.
  1222. ADistance + AFromCenterSpot - distance, which object should keep from ACenter or
  1223. ADistance + not AFromCenterSpot - distance, which object should shift
  1224. from his current position away from center *)
  1225. function ShiftObjectFromCenter(const AOriginalPosition: TGLVector;
  1226. const ACenter: TGLVector; const ADistance: Single;
  1227. const AFromCenterSpot: Boolean): TGLVector; overload;
  1228. function ShiftObjectFromCenter(const AOriginalPosition: TAffineVector;
  1229. const ACenter: TAffineVector; const ADistance: Single;
  1230. const AFromCenterSpot: Boolean): TAffineVector; overload;
  1231. const
  1232. cPI: Single = 3.141592654;
  1233. cPIdiv180: Single = 0.017453292;
  1234. c180divPI: Single = 57.29577951;
  1235. c2PI: Single = 6.283185307;
  1236. cPIdiv2: Single = 1.570796326;
  1237. cPIdiv4: Single = 0.785398163;
  1238. c3PIdiv2: Single = 4.71238898;
  1239. c3PIdiv4: Single = 2.35619449;
  1240. cInv2PI: Single = 1 / 6.283185307;
  1241. cInv360: Single = 1 / 360;
  1242. c180: Single = 180;
  1243. c360: Single = 360;
  1244. cOneHalf: Single = 0.5;
  1245. cLn10: Single = 2.302585093;
  1246. // Ranges of the IEEE floating point types, including denormals
  1247. // with Math.pas compatible name
  1248. MinSingle = 1.5E-45;
  1249. MaxSingle = 3.4E+38;
  1250. MinDouble = 5.0E-324;
  1251. MaxDouble = 1.7E+308;
  1252. MinExtended = 3.4E-4932;
  1253. MaxExtended = MaxDouble; //1.1E+4932 <-Overflowing in c++;
  1254. MinComp = -9.223372036854775807E+18;
  1255. MaxComp = 9.223372036854775807E+18;
  1256. var
  1257. (* This var is adjusted during "initialization", current values are
  1258. + 0 : use standard optimized FPU code
  1259. + 1 : use 3DNow! optimized code (requires K6-2/3 CPU)
  1260. + 2 : use Intel SSE code (Pentium III, NOT IMPLEMENTED YET !) *)
  1261. vSIMD: Byte = 0;
  1262. // ==============================================================
  1263. implementation
  1264. // ==============================================================
  1265. const
  1266. {$IFDEF USE_ASM}
  1267. // FPU status flags (high order byte)
  1268. cwChop: Word = $1F3F;
  1269. {$ENDIF}
  1270. // to be used as descriptive indices
  1271. X = 0;
  1272. Y = 1;
  1273. Z = 2;
  1274. W = 3;
  1275. cZero: Single = 0.0;
  1276. cOne: Single = 1.0;
  1277. cOneDotFive: Single = 0.5;
  1278. function GeometryOptimizationMode: String;
  1279. begin
  1280. case vSIMD of
  1281. 0: result := 'FPU';
  1282. 1: result := '3DNow!';
  1283. 2: result := 'SSE';
  1284. else
  1285. result := '*ERR*';
  1286. end;
  1287. end;
  1288. var
  1289. vOldSIMD: Byte;
  1290. vFPUOnlySectionCounter: Integer;
  1291. procedure BeginFPUOnlySection;
  1292. begin
  1293. if vFPUOnlySectionCounter = 0 then
  1294. vOldSIMD := vSIMD;
  1295. Inc(vFPUOnlySectionCounter);
  1296. vSIMD := 0;
  1297. end;
  1298. procedure EndFPUOnlySection;
  1299. begin
  1300. Dec(vFPUOnlySectionCounter);
  1301. Assert(vFPUOnlySectionCounter >= 0);
  1302. if vFPUOnlySectionCounter = 0 then
  1303. vSIMD := vOldSIMD;
  1304. end;
  1305. // ------------------------------------------------------------------------------
  1306. // ----------------- vector functions -------------------------------------------
  1307. // ------------------------------------------------------------------------------
  1308. function TexPointMake(const S, T: Single): TTexPoint;
  1309. begin
  1310. result.S := S;
  1311. result.T := T;
  1312. end;
  1313. function AffineVectorMake(const X, Y, Z: Single): TAffineVector; overload;
  1314. begin
  1315. result.X := X;
  1316. result.Y := Y;
  1317. result.Z := Z;
  1318. end;
  1319. function AffineVectorMake(const V: TGLVector): TAffineVector;
  1320. begin
  1321. result.X := V.X;
  1322. result.Y := V.Y;
  1323. result.Z := V.Z;
  1324. end;
  1325. procedure SetAffineVector(out V: TAffineVector; const X, Y, Z: Single);
  1326. begin
  1327. V.X := X;
  1328. V.Y := Y;
  1329. V.Z := Z;
  1330. end;
  1331. procedure SetVector(out V: TAffineVector; const X, Y, Z: Single);
  1332. begin
  1333. V.X := X;
  1334. V.Y := Y;
  1335. V.Z := Z;
  1336. end;
  1337. procedure SetVector(out V: TAffineVector; const vSrc: TGLVector);
  1338. begin
  1339. V.X := vSrc.X;
  1340. V.Y := vSrc.Y;
  1341. V.Z := vSrc.Z;
  1342. end;
  1343. procedure SetVector(out V: TAffineVector; const vSrc: TAffineVector);
  1344. begin
  1345. V.X := vSrc.X;
  1346. V.Y := vSrc.Y;
  1347. V.Z := vSrc.Z;
  1348. end;
  1349. procedure SetVector(out V: TAffineDblVector; const vSrc: TAffineVector);
  1350. begin
  1351. V.X := vSrc.X;
  1352. V.Y := vSrc.Y;
  1353. V.Z := vSrc.Z;
  1354. end;
  1355. procedure SetVector(out V: TAffineDblVector; const vSrc: TGLVector);
  1356. begin
  1357. V.X := vSrc.X;
  1358. V.Y := vSrc.Y;
  1359. V.Z := vSrc.Z;
  1360. end;
  1361. function VectorMake(const V: TAffineVector; W: Single = 0): TGLVector;
  1362. begin
  1363. result.X := V.X;
  1364. result.Y := V.Y;
  1365. result.Z := V.Z;
  1366. result.W := W;
  1367. end;
  1368. function VectorMake(const X, Y, Z: Single; W: Single = 0): TGLVector;
  1369. begin
  1370. result.X := X;
  1371. result.Y := Y;
  1372. result.Z := Z;
  1373. result.W := W;
  1374. end;
  1375. function VectorMake(const Q: TQuaternion): TGLVector; overload; inline;
  1376. begin
  1377. result.X := Q.X;
  1378. result.Y := Q.Y;
  1379. result.Z := Q.Z;
  1380. result.W := Q.W;
  1381. end;
  1382. function PointMake(const X, Y, Z: Single): TGLVector; overload;
  1383. begin
  1384. result.X := X;
  1385. result.Y := Y;
  1386. result.Z := Z;
  1387. result.W := 1;
  1388. end;
  1389. function PointMake(const V: TAffineVector): TGLVector; overload;
  1390. begin
  1391. result.X := V.X;
  1392. result.Y := V.Y;
  1393. result.Z := V.Z;
  1394. result.W := 1;
  1395. end;
  1396. function PointMake(const V: TGLVector): TGLVector; overload;
  1397. begin
  1398. result.X := V.X;
  1399. result.Y := V.Y;
  1400. result.Z := V.Z;
  1401. result.W := 1;
  1402. end;
  1403. procedure SetVector(out V: TGLVector; const X, Y, Z: Single; W: Single = 0);
  1404. begin
  1405. V.X := X;
  1406. V.Y := Y;
  1407. V.Z := Z;
  1408. V.W := W;
  1409. end;
  1410. procedure SetVector(out V: TGLVector; const av: TAffineVector; W: Single = 0);
  1411. begin
  1412. V.X := av.X;
  1413. V.Y := av.Y;
  1414. V.Z := av.Z;
  1415. V.W := W;
  1416. end;
  1417. procedure SetVector(out V: TGLVector; const vSrc: TGLVector);
  1418. begin
  1419. // faster than memcpy, move or ':=' on the TGLVector...
  1420. V.X := vSrc.X;
  1421. V.Y := vSrc.Y;
  1422. V.Z := vSrc.Z;
  1423. V.W := vSrc.W;
  1424. end;
  1425. procedure MakePoint(out V: TGLVector; const X, Y, Z: Single);
  1426. begin
  1427. V.X := X;
  1428. V.Y := Y;
  1429. V.Z := Z;
  1430. V.W := 1.0;
  1431. end;
  1432. procedure MakePoint(out V: TGLVector; const av: TAffineVector);
  1433. begin
  1434. V.X := av.X;
  1435. V.Y := av.Y;
  1436. V.Z := av.Z;
  1437. V.W := 1.0; // cOne
  1438. end;
  1439. procedure MakePoint(out V: TGLVector; const av: TGLVector);
  1440. begin
  1441. V.X := av.X;
  1442. V.Y := av.Y;
  1443. V.Z := av.Z;
  1444. V.W := 1.0; // cOne
  1445. end;
  1446. procedure MakeVector(out V: TAffineVector; const X, Y, Z: Single); overload;
  1447. begin
  1448. V.X := X;
  1449. V.Y := Y;
  1450. V.Z := Z;
  1451. end;
  1452. procedure MakeVector(out V: TGLVector; const X, Y, Z: Single);
  1453. begin
  1454. V.X := X;
  1455. V.Y := Y;
  1456. V.Z := Z;
  1457. V.W := 0.0 // cZero;
  1458. end;
  1459. procedure MakeVector(out V: TGLVector; const av: TAffineVector);
  1460. begin
  1461. V.X := av.X;
  1462. V.Y := av.Y;
  1463. V.Z := av.Z;
  1464. V.W := 0.0 // cZero;
  1465. end;
  1466. procedure MakeVector(out V: TGLVector; const av: TGLVector);
  1467. begin
  1468. V.X := av.X;
  1469. V.Y := av.Y;
  1470. V.Z := av.Z;
  1471. V.W := 0.0; // cZero;
  1472. end;
  1473. procedure RstVector(var V: TAffineVector);
  1474. begin
  1475. V.X := 0;
  1476. V.Y := 0;
  1477. V.Z := 0;
  1478. end;
  1479. procedure RstVector(var V: TGLVector);
  1480. begin
  1481. V.X := 0;
  1482. V.Y := 0;
  1483. V.Z := 0;
  1484. V.W := 0;
  1485. end;
  1486. function VectorAdd(const V1, V2: TVector2f): TVector2f;
  1487. begin
  1488. result.X := V1.X + V2.X;
  1489. result.Y := V1.Y + V2.Y;
  1490. end;
  1491. function VectorAdd(const V1, V2: TAffineVector): TAffineVector;
  1492. begin
  1493. result.X := V1.X + V2.X;
  1494. result.Y := V1.Y + V2.Y;
  1495. result.Z := V1.Z + V2.Z;
  1496. end;
  1497. procedure VectorAdd(const V1, V2: TAffineVector; var vr: TAffineVector); overload;
  1498. begin
  1499. vr.X := V1.X + V2.X;
  1500. vr.Y := V1.Y + V2.Y;
  1501. vr.Z := V1.Z + V2.Z;
  1502. end;
  1503. procedure VectorAdd(const V1, V2: TAffineVector; vr: PAffineVector); overload;
  1504. begin
  1505. vr^.X := V1.X + V2.X;
  1506. vr^.Y := V1.Y + V2.Y;
  1507. vr^.Z := V1.Z + V2.Z;
  1508. end;
  1509. function VectorAdd(const V1, V2: TGLVector): TGLVector;
  1510. begin
  1511. result.X := V1.X + V2.X;
  1512. result.Y := V1.Y + V2.Y;
  1513. result.Z := V1.Z + V2.Z;
  1514. result.W := V1.W + V2.W;
  1515. end;
  1516. procedure VectorAdd(const V1, V2: TGLVector; var vr: TGLVector);
  1517. begin
  1518. vr.X := V1.X + V2.X;
  1519. vr.Y := V1.Y + V2.Y;
  1520. vr.Z := V1.Z + V2.Z;
  1521. vr.W := V1.W + V2.W;
  1522. end;
  1523. function VectorAdd(const V: TAffineVector; const f: Single): TAffineVector;
  1524. begin
  1525. result.X := V.X + f;
  1526. result.Y := V.Y + f;
  1527. result.Z := V.Z + f;
  1528. end;
  1529. function VectorAdd(const V: TGLVector; const f: Single): TGLVector;
  1530. begin
  1531. result.X := V.X + f;
  1532. result.Y := V.Y + f;
  1533. result.Z := V.Z + f;
  1534. result.W := V.W + f;
  1535. end;
  1536. function PointAdd(var V1: TGLVector; const V2: TGLVector): TGLVector;
  1537. begin
  1538. result.X := V1.X + V2.X;
  1539. result.Y := V1.Y + V2.Y;
  1540. result.Z := V1.Z + V2.Z;
  1541. result.W := 1;
  1542. end;
  1543. procedure AddVector(var V1: TAffineVector; const V2: TAffineVector);
  1544. begin
  1545. V1.X := V1.X + V2.X;
  1546. V1.Y := V1.Y + V2.Y;
  1547. V1.Z := V1.Z + V2.Z;
  1548. end;
  1549. procedure AddVector(var V1: TAffineVector; const V2: TGLVector);
  1550. begin
  1551. V1.X := V1.X + V2.X;
  1552. V1.Y := V1.Y + V2.Y;
  1553. V1.Z := V1.Z + V2.Z;
  1554. end;
  1555. procedure AddVector(var V1: TGLVector; const V2: TGLVector);
  1556. begin
  1557. V1.X := V1.X + V2.X;
  1558. V1.Y := V1.Y + V2.Y;
  1559. V1.Z := V1.Z + V2.Z;
  1560. V1.W := V1.W + V2.W;
  1561. end;
  1562. procedure AddVector(var V: TAffineVector; const f: Single);
  1563. begin
  1564. V.X := V.X + f;
  1565. V.Y := V.Y + f;
  1566. V.Z := V.Z + f;
  1567. end;
  1568. procedure AddVector(var V: TGLVector; const f: Single);
  1569. begin
  1570. V.X := V.X + f;
  1571. V.Y := V.Y + f;
  1572. V.Z := V.Z + f;
  1573. V.W := V.W + f;
  1574. end;
  1575. procedure AddPoint(var V1: TGLVector; const V2: TGLVector);
  1576. begin
  1577. V1.X := V1.X + V2.X;
  1578. V1.Y := V1.Y + V2.Y;
  1579. V1.Z := V1.Z + V2.Z;
  1580. V1.W := 1;
  1581. end;
  1582. procedure TexPointArrayAdd(const src: PTexPointArray; const delta: TTexPoint;
  1583. const nb: Integer; dest: PTexPointArray); overload;
  1584. var
  1585. i: Integer;
  1586. begin
  1587. for i := 0 to nb - 1 do
  1588. begin
  1589. dest^[i].S := src^[i].S + delta.S;
  1590. dest^[i].T := src^[i].T + delta.T;
  1591. end;
  1592. end;
  1593. procedure TexPointArrayScaleAndAdd(const src: PTexPointArray;
  1594. const delta: TTexPoint; const nb: Integer; const scale: TTexPoint;
  1595. dest: PTexPointArray); overload;
  1596. var
  1597. i: Integer;
  1598. begin
  1599. for i := 0 to nb - 1 do
  1600. begin
  1601. dest^[i].S := src^[i].S * scale.S + delta.S;
  1602. dest^[i].T := src^[i].T * scale.T + delta.T;
  1603. end;
  1604. end;
  1605. procedure VectorArrayAdd(const src: PAffineVectorArray;
  1606. const delta: TAffineVector; const nb: Integer; dest: PAffineVectorArray);
  1607. var
  1608. i: Integer;
  1609. begin
  1610. for i := 0 to nb - 1 do
  1611. begin
  1612. dest^[i].X := src^[i].X + delta.X;
  1613. dest^[i].Y := src^[i].Y + delta.Y;
  1614. dest^[i].Z := src^[i].Z + delta.Z;
  1615. end;
  1616. end;
  1617. function VectorSubtract(const V1, V2: TAffineVector): TAffineVector;
  1618. begin
  1619. result.X := V1.X - V2.X;
  1620. result.Y := V1.Y - V2.Y;
  1621. result.Z := V1.Z - V2.Z;
  1622. end;
  1623. function VectorSubtract(const V1, V2: TVector2f): TVector2f;
  1624. begin
  1625. result.X := V1.X - V2.X;
  1626. result.Y := V1.Y - V2.Y;
  1627. end;
  1628. procedure VectorSubtract(const V1, V2: TAffineVector;
  1629. var result: TAffineVector);
  1630. begin
  1631. result.X := V1.X - V2.X;
  1632. result.Y := V1.Y - V2.Y;
  1633. result.Z := V1.Z - V2.Z;
  1634. end;
  1635. procedure VectorSubtract(const V1, V2: TAffineVector; var result: TGLVector);
  1636. begin
  1637. result.X := V1.X - V2.X;
  1638. result.Y := V1.Y - V2.Y;
  1639. result.Z := V1.Z - V2.Z;
  1640. result.W := 0;
  1641. end;
  1642. procedure VectorSubtract(const V1: TGLVector; const V2: TAffineVector; var result: TGLVector);
  1643. begin
  1644. result.X := V1.X - V2.X;
  1645. result.Y := V1.Y - V2.Y;
  1646. result.Z := V1.Z - V2.Z;
  1647. result.W := V1.W;
  1648. end;
  1649. function VectorSubtract(const V1, V2: TGLVector): TGLVector;
  1650. begin
  1651. result.X := V1.X - V2.X;
  1652. result.Y := V1.Y - V2.Y;
  1653. result.Z := V1.Z - V2.Z;
  1654. result.W := V1.W - V2.W;
  1655. end;
  1656. procedure VectorSubtract(const V1, V2: TGLVector; var result: TGLVector);
  1657. begin
  1658. result.X := V1.X - V2.X;
  1659. result.Y := V1.Y - V2.Y;
  1660. result.Z := V1.Z - V2.Z;
  1661. result.W := V1.W - V2.W;
  1662. end;
  1663. procedure VectorSubtract(const V1, V2: TGLVector;
  1664. var result: TAffineVector); overload;
  1665. begin
  1666. result.X := V1.X - V2.X;
  1667. result.Y := V1.Y - V2.Y;
  1668. result.Z := V1.Z - V2.Z;
  1669. end;
  1670. function VectorSubtract(const V1: TAffineVector; delta: Single): TAffineVector;
  1671. begin
  1672. result.X := V1.X - delta;
  1673. result.Y := V1.Y - delta;
  1674. result.Z := V1.Z - delta;
  1675. end;
  1676. function VectorSubtract(const V1: TGLVector; delta: Single): TGLVector;
  1677. begin
  1678. result.X := V1.X - delta;
  1679. result.Y := V1.Y - delta;
  1680. result.Z := V1.Z - delta;
  1681. result.W := V1.W - delta;
  1682. end;
  1683. procedure SubtractVector(var V1: TAffineVector; const V2: TAffineVector);
  1684. begin
  1685. V1.X := V1.X - V2.X;
  1686. V1.Y := V1.Y - V2.Y;
  1687. V1.Z := V1.Z - V2.Z;
  1688. end;
  1689. procedure SubtractVector(var V1: TVector2f; const V2: TVector2f);
  1690. begin
  1691. V1.X := V1.X - V2.X;
  1692. V1.Y := V1.Y - V2.Y;
  1693. end;
  1694. procedure SubtractVector(var V1: TGLVector; const V2: TGLVector);
  1695. begin
  1696. V1.X := V1.X - V2.X;
  1697. V1.Y := V1.Y - V2.Y;
  1698. V1.Z := V1.Z - V2.Z;
  1699. V1.W := V1.W - V2.W;
  1700. end;
  1701. procedure CombineVector(var vr: TAffineVector; const V: TAffineVector;
  1702. var f: Single);
  1703. begin
  1704. vr.X := vr.X + V.X * f;
  1705. vr.Y := vr.Y + V.Y * f;
  1706. vr.Z := vr.Z + V.Z * f;
  1707. end;
  1708. procedure CombineVector(var vr: TAffineVector; const V: TAffineVector;
  1709. pf: PFloat);
  1710. begin
  1711. vr.X := vr.X + V.X * pf^;
  1712. vr.Y := vr.Y + V.Y * pf^;
  1713. vr.Z := vr.Z + V.Z * pf^;
  1714. end;
  1715. function TexPointCombine(const t1, t2: TTexPoint; f1, f2: Single): TTexPoint;
  1716. begin
  1717. result.S := (f1 * t1.S) + (f2 * t2.S);
  1718. result.T := (f1 * t1.T) + (f2 * t2.T);
  1719. end;
  1720. function VectorCombine(const V1, V2: TAffineVector; const f1, f2: Single)
  1721. : TAffineVector;
  1722. begin
  1723. result.V[X] := (f1 * V1.V[X]) + (f2 * V2.V[X]);
  1724. result.V[Y] := (f1 * V1.V[Y]) + (f2 * V2.V[Y]);
  1725. result.V[Z] := (f1 * V1.V[Z]) + (f2 * V2.V[Z]);
  1726. end;
  1727. function VectorCombine3(const V1, V2, V3: TAffineVector;
  1728. const f1, f2, F3: Single): TAffineVector;
  1729. begin
  1730. result.V[X] := (f1 * V1.V[X]) + (f2 * V2.V[X]) + (F3 * V3.V[X]);
  1731. result.V[Y] := (f1 * V1.V[Y]) + (f2 * V2.V[Y]) + (F3 * V3.V[Y]);
  1732. result.V[Z] := (f1 * V1.V[Z]) + (f2 * V2.V[Z]) + (F3 * V3.V[Z]);
  1733. end;
  1734. procedure VectorCombine3(const V1, V2, V3: TAffineVector;
  1735. const f1, f2, F3: Single; var vr: TAffineVector);
  1736. begin
  1737. vr.V[X] := (f1 * V1.V[X]) + (f2 * V2.V[X]) + (F3 * V3.V[X]);
  1738. vr.V[Y] := (f1 * V1.V[Y]) + (f2 * V2.V[Y]) + (F3 * V3.V[Y]);
  1739. vr.V[Z] := (f1 * V1.V[Z]) + (f2 * V2.V[Z]) + (F3 * V3.V[Z]);
  1740. end;
  1741. procedure CombineVector(var vr: TGLVector; const V: TGLVector;
  1742. var f: Single); overload;
  1743. begin
  1744. vr.X := vr.X + V.X * f;
  1745. vr.Y := vr.Y + V.Y * f;
  1746. vr.Z := vr.Z + V.Z * f;
  1747. vr.W := vr.W + V.W * f;
  1748. end;
  1749. procedure CombineVector(var vr: TGLVector; const V: TAffineVector;
  1750. var f: Single); overload;
  1751. begin
  1752. vr.X := vr.X + V.X * f;
  1753. vr.Y := vr.Y + V.Y * f;
  1754. vr.Z := vr.Z + V.Z * f;
  1755. end;
  1756. function VectorCombine(const V1, V2: TGLVector; const F1, F2: Single): TGLVector;
  1757. begin
  1758. result.V[X] := (F1 * V1.V[X]) + (F2 * V2.V[X]);
  1759. result.V[Y] := (F1 * V1.V[Y]) + (F2 * V2.V[Y]);
  1760. result.V[Z] := (F1 * V1.V[Z]) + (F2 * V2.V[Z]);
  1761. result.V[W] := (F1 * V1.V[W]) + (F2 * V2.V[W]);
  1762. end;
  1763. function VectorCombine(const V1: TGLVector; const V2: TAffineVector;
  1764. const F1, F2: Single): TGLVector; overload;
  1765. begin
  1766. result.V[X] := (F1 * V1.V[X]) + (F2 * V2.V[X]);
  1767. result.V[Y] := (F1 * V1.V[Y]) + (F2 * V2.V[Y]);
  1768. result.V[Z] := (F1 * V1.V[Z]) + (F2 * V2.V[Z]);
  1769. result.V[W] := F1 * V1.V[W];
  1770. end;
  1771. procedure VectorCombine(const V1, V2: TGLVector; const F1, F2: Single;
  1772. var vr: TGLVector); overload;
  1773. begin
  1774. vr.X := (F1 * V1.X) + (F2 * V2.X);
  1775. vr.Y := (F1 * V1.Y) + (F2 * V2.Y);
  1776. vr.Z := (F1 * V1.Z) + (F2 * V2.Z);
  1777. vr.W := (F1 * V1.W) + (F2 * V2.W);
  1778. end;
  1779. procedure VectorCombine(const V1, V2: TGLVector; const f2: Single;
  1780. var vr: TGLVector); overload;
  1781. begin // 201283
  1782. vr.X := V1.X + (f2 * V2.X);
  1783. vr.Y := V1.Y + (f2 * V2.Y);
  1784. vr.Z := V1.Z + (f2 * V2.Z);
  1785. vr.W := V1.W + (f2 * V2.W);
  1786. end;
  1787. procedure VectorCombine(const V1: TGLVector; const V2: TAffineVector;
  1788. const F1, F2: Single; var vr: TGLVector);
  1789. begin
  1790. vr.V[X] := (F1 * V1.V[X]) + (F2 * V2.V[X]);
  1791. vr.V[Y] := (F1 * V1.V[Y]) + (F2 * V2.V[Y]);
  1792. vr.V[Z] := (F1 * V1.V[Z]) + (F2 * V2.V[Z]);
  1793. vr.V[W] := F1 * V1.V[W];
  1794. end;
  1795. function VectorCombine3(const V1, V2, V3: TGLVector;
  1796. const F1, F2, F3: Single): TGLVector;
  1797. begin
  1798. result.V[X] := (F1 * V1.V[X]) + (F2 * V2.V[X]) + (F3 * V3.V[X]);
  1799. result.V[Y] := (F1 * V1.V[Y]) + (F2 * V2.V[Y]) + (F3 * V3.V[Y]);
  1800. result.V[Z] := (F1 * V1.V[Z]) + (F2 * V2.V[Z]) + (F3 * V3.V[Z]);
  1801. result.V[W] := (F1 * V1.V[W]) + (F2 * V2.V[W]) + (F3 * V3.V[W]);
  1802. end;
  1803. procedure VectorCombine3(const V1, V2, V3: TGLVector; const F1, F2, F3: Single;
  1804. var vr: TGLVector);
  1805. begin
  1806. vr.V[X] := (F1 * V1.V[X]) + (F2 * V2.V[X]) + (F3 * V3.V[X]);
  1807. vr.V[Y] := (F1 * V1.V[Y]) + (F2 * V2.V[Y]) + (F3 * V3.V[Y]);
  1808. vr.V[Z] := (F1 * V1.V[Z]) + (F2 * V2.V[Z]) + (F3 * V3.V[Z]);
  1809. vr.V[W] := (F1 * V1.V[W]) + (F2 * V2.V[W]) + (F3 * V3.V[W]);
  1810. end;
  1811. function VectorDotProduct(const V1, V2: TVector2f): Single;
  1812. begin
  1813. result := V1.X * V2.X + V1.Y * V2.Y;
  1814. end;
  1815. function VectorDotProduct(const V1, V2: TAffineVector): Single;
  1816. begin
  1817. result := V1.X * V2.X + V1.Y * V2.Y + V1.Z * V2.Z;
  1818. end;
  1819. function VectorDotProduct(const V1, V2: TGLVector): Single;
  1820. begin
  1821. result := V1.X * V2.X + V1.Y * V2.Y + V1.Z * V2.Z + V1.W * V2.W;
  1822. end;
  1823. function VectorDotProduct(const V1: TGLVector; const V2: TAffineVector): Single;
  1824. begin
  1825. result := V1.X * V2.X + V1.Y * V2.Y + V1.Z * V2.Z;
  1826. end;
  1827. function PointProject(const p, origin, direction: TAffineVector): Single;
  1828. begin
  1829. result := direction.X * (p.X - origin.X) + direction.Y *
  1830. (p.Y - origin.Y) + direction.Z * (p.Z - origin.Z);
  1831. end;
  1832. function PointProject(const p, origin, direction: TGLVector): Single;
  1833. begin
  1834. result := direction.X * (p.X - origin.X) + direction.Y *
  1835. (p.Y - origin.Y) + direction.Z * (p.Z - origin.Z);
  1836. end;
  1837. function VectorCrossProduct(const V1, V2: TAffineVector): TAffineVector;
  1838. begin
  1839. result.X := V1.Y * V2.Z - V1.Z * V2.Y;
  1840. result.Y := V1.Z * V2.X - V1.X * V2.Z;
  1841. result.Z := V1.X * V2.Y - V1.Y * V2.X;
  1842. end;
  1843. function VectorCrossProduct(const V1, V2: TGLVector): TGLVector;
  1844. begin
  1845. result.X := V1.Y * V2.Z - V1.Z * V2.Y;
  1846. result.Y := V1.Z * V2.X - V1.X * V2.Z;
  1847. result.Z := V1.X * V2.Y - V1.Y * V2.X;
  1848. result.W := 0;
  1849. end;
  1850. procedure VectorCrossProduct(const V1, V2: TGLVector; var vr: TGLVector);
  1851. begin
  1852. vr.X := V1.Y * V2.Z - V1.Z * V2.Y;
  1853. vr.Y := V1.Z * V2.X - V1.X * V2.Z;
  1854. vr.Z := V1.X * V2.Y - V1.Y * V2.X;
  1855. vr.W := 0;
  1856. end;
  1857. procedure VectorCrossProduct(const V1, V2: TAffineVector;
  1858. var vr: TGLVector); overload;
  1859. begin
  1860. vr.X := V1.Y * V2.Z - V1.Z * V2.Y;
  1861. vr.Y := V1.Z * V2.X - V1.X * V2.Z;
  1862. vr.Z := V1.X * V2.Y - V1.Y * V2.X;
  1863. vr.W := 0;
  1864. end;
  1865. procedure VectorCrossProduct(const V1, V2: TGLVector;
  1866. var vr: TAffineVector); overload;
  1867. begin
  1868. vr.V[X] := V1.V[Y] * V2.V[Z] - V1.V[Z] * V2.V[Y];
  1869. vr.V[Y] := V1.V[Z] * V2.V[X] - V1.V[X] * V2.V[Z];
  1870. vr.V[Z] := V1.V[X] * V2.V[Y] - V1.V[Y] * V2.V[X];
  1871. end;
  1872. procedure VectorCrossProduct(const V1, V2: TAffineVector;
  1873. var vr: TAffineVector); overload;
  1874. begin
  1875. vr.V[X] := V1.V[Y] * V2.V[Z] - V1.V[Z] * V2.V[Y];
  1876. vr.V[Y] := V1.V[Z] * V2.V[X] - V1.V[X] * V2.V[Z];
  1877. vr.V[Z] := V1.V[X] * V2.V[Y] - V1.V[Y] * V2.V[X];
  1878. end;
  1879. function Lerp(const start, stop, T: Single): Single;
  1880. begin
  1881. result := start + (stop - start) * T;
  1882. end;
  1883. function AngleLerp(start, stop, T: Single): Single;
  1884. var
  1885. d: Single;
  1886. begin
  1887. start := NormalizeAngle(start);
  1888. stop := NormalizeAngle(stop);
  1889. d := stop - start;
  1890. if d > PI then
  1891. begin
  1892. // positive d, angle on opposite side, becomes negative i.e. changes direction
  1893. d := -d - c2PI;
  1894. end
  1895. else if d < -PI then
  1896. begin
  1897. // negative d, angle on opposite side, becomes positive i.e. changes direction
  1898. d := d + c2PI;
  1899. end;
  1900. result := start + d * T;
  1901. end;
  1902. function DistanceBetweenAngles(angle1, angle2: Single): Single;
  1903. begin
  1904. angle1 := NormalizeAngle(angle1);
  1905. angle2 := NormalizeAngle(angle2);
  1906. result := Abs(angle2 - angle1);
  1907. if result > PI then
  1908. result := c2PI - result;
  1909. end;
  1910. function TexPointLerp(const t1, t2: TTexPoint; T: Single): TTexPoint; overload;
  1911. begin
  1912. result.S := t1.S + (t2.S - t1.S) * T;
  1913. result.T := t1.T + (t2.T - t1.T) * T;
  1914. end;
  1915. function VectorLerp(const V1, V2: TAffineVector; T: Single): TAffineVector;
  1916. begin
  1917. result.X := V1.X + (V2.X - V1.X) * T;
  1918. result.Y := V1.Y + (V2.Y - V1.Y) * T;
  1919. result.Z := V1.Z + (V2.Z - V1.Z) * T;
  1920. end;
  1921. procedure VectorLerp(const V1, V2: TAffineVector; T: Single;
  1922. var vr: TAffineVector);
  1923. begin
  1924. vr.X := V1.X + (V2.X - V1.X) * T;
  1925. vr.Y := V1.Y + (V2.Y - V1.Y) * T;
  1926. vr.Z := V1.Z + (V2.Z - V1.Z) * T;
  1927. end;
  1928. function VectorLerp(const V1, V2: TGLVector; T: Single): TGLVector;
  1929. begin
  1930. result.X := V1.X + (V2.X - V1.X) * T;
  1931. result.Y := V1.Y + (V2.Y - V1.Y) * T;
  1932. result.Z := V1.Z + (V2.Z - V1.Z) * T;
  1933. result.W := V1.W + (V2.W - V1.W) * T;
  1934. end;
  1935. procedure VectorLerp(const V1, V2: TGLVector; T: Single; var vr: TGLVector);
  1936. begin
  1937. vr.X := V1.X + (V2.X - V1.X) * T;
  1938. vr.Y := V1.Y + (V2.Y - V1.Y) * T;
  1939. vr.Z := V1.Z + (V2.Z - V1.Z) * T;
  1940. vr.W := V1.W + (V2.W - V1.W) * T;
  1941. end;
  1942. function VectorAngleLerp(const V1, V2: TAffineVector; T: Single): TAffineVector;
  1943. var
  1944. q1, q2, qR: TQuaternion;
  1945. M: TGLMatrix;
  1946. Tran: TTransformations;
  1947. begin
  1948. if VectorEquals(V1, V2) then
  1949. begin
  1950. result := V1;
  1951. end
  1952. else
  1953. begin
  1954. q1 := QuaternionFromEuler(RadToDeg(V1.X), RadToDeg(V1.Y),
  1955. RadToDeg(V1.Z), eulZYX);
  1956. q2 := QuaternionFromEuler(RadToDeg(V2.X), RadToDeg(V2.Y),
  1957. RadToDeg(V2.Z), eulZYX);
  1958. qR := QuaternionSlerp(q1, q2, T);
  1959. M := QuaternionToMatrix(qR);
  1960. MatrixDecompose(M, Tran);
  1961. result.X := Tran[ttRotateX];
  1962. result.Y := Tran[ttRotateY];
  1963. result.Z := Tran[ttRotateZ];
  1964. end;
  1965. end;
  1966. function VectorAngleCombine(const V1, V2: TAffineVector; f: Single)
  1967. : TAffineVector;
  1968. begin
  1969. result := VectorCombine(V1, V2, 1, f);
  1970. end;
  1971. procedure VectorArrayLerp(const src1, src2: PVectorArray; T: Single; n: Integer;
  1972. dest: PVectorArray);
  1973. var
  1974. i: Integer;
  1975. begin
  1976. for i := 0 to n - 1 do
  1977. begin
  1978. dest^[i].X := src1^[i].X + (src2^[i].X - src1^[i].X) * T;
  1979. dest^[i].Y := src1^[i].Y + (src2^[i].Y - src1^[i].Y) * T;
  1980. dest^[i].Z := src1^[i].Z + (src2^[i].Z - src1^[i].Z) * T;
  1981. dest^[i].W := src1^[i].W + (src2^[i].W - src1^[i].W) * T;
  1982. end;
  1983. end;
  1984. procedure VectorArrayLerp(const src1, src2: PAffineVectorArray; T: Single;
  1985. n: Integer; dest: PAffineVectorArray);
  1986. var
  1987. i: Integer;
  1988. begin
  1989. for i := 0 to n - 1 do
  1990. begin
  1991. dest^[i].X := src1^[i].X + (src2^[i].X - src1^[i].X) * T;
  1992. dest^[i].Y := src1^[i].Y + (src2^[i].Y - src1^[i].Y) * T;
  1993. dest^[i].Z := src1^[i].Z + (src2^[i].Z - src1^[i].Z) * T;
  1994. end;
  1995. end;
  1996. procedure VectorArrayLerp(const src1, src2: PTexPointArray; T: Single;
  1997. n: Integer; dest: PTexPointArray);
  1998. var
  1999. i: Integer;
  2000. begin
  2001. for i := 0 to n - 1 do
  2002. begin
  2003. dest^[i].S := src1^[i].S + (src2^[i].S - src1^[i].S) * T;
  2004. dest^[i].T := src1^[i].T + (src2^[i].T - src1^[i].T) * T;
  2005. end;
  2006. end;
  2007. function InterpolateCombined(const start, stop, delta: Single;
  2008. const DistortionDegree: Single;
  2009. const InterpolationType: TGLInterpolationType): Single;
  2010. begin
  2011. case InterpolationType of
  2012. itLinear:
  2013. result := Lerp(start, stop, delta);
  2014. itPower:
  2015. result := InterpolatePower(start, stop, delta, DistortionDegree);
  2016. itSin:
  2017. result := InterpolateSin(start, stop, delta);
  2018. itSinAlt:
  2019. result := InterpolateSinAlt(start, stop, delta);
  2020. itTan:
  2021. result := InterpolateTan(start, stop, delta);
  2022. itLn:
  2023. result := InterpolateLn(start, stop, delta, DistortionDegree);
  2024. itExp:
  2025. result := InterpolateExp(start, stop, delta, DistortionDegree);
  2026. else
  2027. begin
  2028. result := -1;
  2029. Assert(False);
  2030. end;
  2031. end;
  2032. end;
  2033. function InterpolateCombinedFastPower(const OriginalStart, OriginalStop,
  2034. OriginalCurrent: Single; const TargetStart, TargetStop: Single;
  2035. const DistortionDegree: Single): Single;
  2036. begin
  2037. result := InterpolatePower(TargetStart, TargetStop,
  2038. (OriginalCurrent - OriginalStart) / (OriginalStop - OriginalStart),
  2039. DistortionDegree);
  2040. end;
  2041. function InterpolateCombinedSafe(const OriginalStart, OriginalStop,
  2042. OriginalCurrent: Single; const TargetStart, TargetStop: Single;
  2043. const DistortionDegree: Single;
  2044. const InterpolationType: TGLInterpolationType): Single;
  2045. var
  2046. ChangeDelta: Single;
  2047. begin
  2048. if OriginalStop = OriginalStart then
  2049. result := TargetStart
  2050. else
  2051. begin
  2052. ChangeDelta := (OriginalCurrent - OriginalStart) /
  2053. (OriginalStop - OriginalStart);
  2054. result := InterpolateCombined(TargetStart, TargetStop, ChangeDelta,
  2055. DistortionDegree, InterpolationType);
  2056. end;
  2057. end;
  2058. function InterpolateCombinedFast(const OriginalStart, OriginalStop,
  2059. OriginalCurrent: Single; const TargetStart, TargetStop: Single;
  2060. const DistortionDegree: Single;
  2061. const InterpolationType: TGLInterpolationType): Single;
  2062. var
  2063. ChangeDelta: Single;
  2064. begin
  2065. ChangeDelta := (OriginalCurrent - OriginalStart) /
  2066. (OriginalStop - OriginalStart);
  2067. result := InterpolateCombined(TargetStart, TargetStop, ChangeDelta,
  2068. DistortionDegree, InterpolationType);
  2069. end;
  2070. function InterpolateLn(const start, stop, delta: Single;
  2071. const DistortionDegree: Single): Single;
  2072. begin
  2073. result := (stop - start) * Ln(1 + delta * DistortionDegree) /
  2074. Ln(1 + DistortionDegree) + start;
  2075. end;
  2076. function InterpolateExp(const start, stop, delta: Single;
  2077. const DistortionDegree: Single): Single;
  2078. begin
  2079. result := (stop - start) * Exp(-DistortionDegree * (1 - delta)) + start;
  2080. end;
  2081. function InterpolateSinAlt(const start, stop, delta: Single): Single;
  2082. begin
  2083. result := (stop - start) * delta * Sin(delta * PI / 2) + start;
  2084. end;
  2085. function InterpolateSin(const start, stop, delta: Single): Single;
  2086. begin
  2087. result := (stop - start) * Sin(delta * PI / 2) + start;
  2088. end;
  2089. function InterpolateTan(const start, stop, delta: Single): Single;
  2090. begin
  2091. result := (stop - start) * Tan(delta * PI / 4) + start;
  2092. end;
  2093. function InterpolatePower(const start, stop, delta: Single;
  2094. const DistortionDegree: Single): Single;
  2095. var
  2096. i: Integer;
  2097. begin
  2098. if (Round(DistortionDegree) <> DistortionDegree) and (delta < 0) then
  2099. begin
  2100. i := Round(DistortionDegree);
  2101. result := (stop - start) * PowerInteger(delta, i) + start;
  2102. end
  2103. else
  2104. result := (stop - start) * Power(delta, DistortionDegree) + start;
  2105. end;
  2106. function MatrixLerp(const m1, m2: TGLMatrix; const delta: Single): TGLMatrix;
  2107. var
  2108. i, J: Integer;
  2109. begin
  2110. for J := 0 to 3 do
  2111. for i := 0 to 3 do
  2112. result.V[i].V[J] := m1.V[i].V[J] + (m2.V[i].V[J] - m1.V[i].V[J]) * delta;
  2113. end;
  2114. function RSqrt(V: Single): Single;
  2115. begin
  2116. result := 1 / Sqrt(V);
  2117. end;
  2118. function VectorLength(const V: array of Single): Single;
  2119. var
  2120. i: Integer;
  2121. begin
  2122. result := 0;
  2123. for i := Low(V) to High(V) do
  2124. result := result + Sqr(V[i]);
  2125. result := Sqrt(result);
  2126. end;
  2127. function VectorLength(const X, Y: Single): Single;
  2128. begin
  2129. result := Sqrt(X * X + Y * Y);
  2130. end;
  2131. function VectorLength(const X, Y, Z: Single): Single;
  2132. begin
  2133. result := Sqrt(X * X + Y * Y + Z * Z);
  2134. end;
  2135. function VectorLength(const V: TVector2f): Single;
  2136. begin
  2137. result := Sqrt(VectorNorm(V.X, V.Y));
  2138. end;
  2139. function VectorLength(const V: TAffineVector): Single;
  2140. begin
  2141. result := Sqrt(VectorNorm(V));
  2142. end;
  2143. function VectorLength(const V: TGLVector): Single;
  2144. begin
  2145. result := Sqrt(VectorNorm(V));
  2146. end;
  2147. function VectorNorm(const X, Y: Single): Single;
  2148. begin
  2149. result := Sqr(X) + Sqr(Y);
  2150. end;
  2151. function VectorNorm(const V: TAffineVector): Single;
  2152. begin
  2153. result := V.X * V.X + V.Y * V.Y + V.Z * V.Z;
  2154. end;
  2155. function VectorNorm(const V: TGLVector): Single;
  2156. begin
  2157. result := V.X * V.X + V.Y * V.Y + V.Z * V.Z;
  2158. end;
  2159. function VectorNorm(var V: array of Single): Single;
  2160. var
  2161. i: Integer;
  2162. begin
  2163. result := 0;
  2164. for i := Low(V) to High(V) do
  2165. result := result + V[i] * V[i];
  2166. end;
  2167. procedure NormalizeVector(var V: TVector2f);
  2168. var
  2169. invLen: Single;
  2170. vn: Single;
  2171. begin
  2172. vn := VectorNorm(V.X, V.Y);
  2173. if vn > 0 then
  2174. begin
  2175. invLen := RSqrt(vn);
  2176. V.X := V.X * invLen;
  2177. V.Y := V.Y * invLen;
  2178. end;
  2179. end;
  2180. procedure NormalizeVector(var V: TAffineVector);
  2181. var
  2182. invLen: Single;
  2183. vn: Single;
  2184. begin
  2185. vn := VectorNorm(V);
  2186. if vn > 0 then
  2187. begin
  2188. invLen := RSqrt(vn);
  2189. V.X := V.X * invLen;
  2190. V.Y := V.Y * invLen;
  2191. V.Z := V.Z * invLen;
  2192. end;
  2193. end;
  2194. function VectorNormalize(const V: TVector2f): TVector2f;
  2195. var
  2196. invLen: Single;
  2197. vn: Single;
  2198. begin
  2199. vn := VectorNorm(V.X, V.Y);
  2200. if vn = 0 then
  2201. result := V
  2202. else
  2203. begin
  2204. invLen := RSqrt(vn);
  2205. result.X := V.X * invLen;
  2206. result.Y := V.Y * invLen;
  2207. end;
  2208. end;
  2209. function VectorNormalize(const V: TAffineVector): TAffineVector;
  2210. var
  2211. invLen: Single;
  2212. vn: Single;
  2213. begin
  2214. vn := VectorNorm(V);
  2215. if vn = 0 then
  2216. SetVector(result, V)
  2217. else
  2218. begin
  2219. invLen := RSqrt(vn);
  2220. result.X := V.X * invLen;
  2221. result.Y := V.Y * invLen;
  2222. result.Z := V.Z * invLen;
  2223. end;
  2224. end;
  2225. procedure NormalizeVectorArray(list: PAffineVectorArray; n: Integer);
  2226. var
  2227. i: Integer;
  2228. begin
  2229. for i := 0 to n - 1 do
  2230. NormalizeVector(list^[i]);
  2231. end;
  2232. procedure NormalizeVector(var V: TGLVector);
  2233. var
  2234. invLen: Single;
  2235. vn: Single;
  2236. begin
  2237. vn := VectorNorm(V);
  2238. if vn > 0 then
  2239. begin
  2240. invLen := RSqrt(vn);
  2241. V.X := V.X * invLen;
  2242. V.Y := V.Y * invLen;
  2243. V.Z := V.Z * invLen;
  2244. end;
  2245. V.W := 0;
  2246. end;
  2247. function VectorNormalize(const V: TGLVector): TGLVector;
  2248. var
  2249. invLen: Single;
  2250. vn: Single;
  2251. begin
  2252. vn := VectorNorm(V);
  2253. if vn = 0 then
  2254. SetVector(result, V)
  2255. else
  2256. begin
  2257. invLen := RSqrt(vn);
  2258. result.X := V.X * invLen;
  2259. result.Y := V.Y * invLen;
  2260. result.Z := V.Z * invLen;
  2261. end;
  2262. result.W := 0;
  2263. end;
  2264. function VectorAngleCosine(const V1, V2: TAffineVector): Single;
  2265. begin
  2266. result := VectorDotProduct(V1, V2) / (VectorLength(V1) * VectorLength(V2));
  2267. end;
  2268. function VectorAngleCosine(const V1, V2: TGLVector): Single;
  2269. begin
  2270. result := VectorDotProduct(V1, V2) / (VectorLength(V1) * VectorLength(V2));
  2271. end;
  2272. function VectorNegate(const Vector: TAffineVector): TAffineVector;
  2273. begin
  2274. result.X := -Vector.X;
  2275. result.Y := -Vector.Y;
  2276. result.Z := -Vector.Z;
  2277. end;
  2278. function VectorNegate(const Vector: TGLVector): TGLVector;
  2279. begin
  2280. result.X := -Vector.X;
  2281. result.Y := -Vector.Y;
  2282. result.Z := -Vector.Z;
  2283. result.W := -Vector.W;
  2284. end;
  2285. procedure NegateVector(var V: TAffineVector);
  2286. begin
  2287. V.X := -V.X;
  2288. V.Y := -V.Y;
  2289. V.Z := -V.Z;
  2290. end;
  2291. procedure NegateVector(var V: TGLVector);
  2292. begin
  2293. V.X := -V.X;
  2294. V.Y := -V.Y;
  2295. V.Z := -V.Z;
  2296. V.W := -V.W;
  2297. end;
  2298. procedure NegateVector(var V: array of Single);
  2299. var
  2300. i: Integer;
  2301. begin
  2302. for i := Low(V) to High(V) do
  2303. V[i] := -V[i];
  2304. end;
  2305. procedure ScaleVector(var V: TVector2f; factor: Single);
  2306. begin
  2307. V.X := V.X * factor;
  2308. V.Y := V.Y * factor;
  2309. end;
  2310. procedure ScaleVector(var V: TAffineVector; factor: Single);
  2311. begin
  2312. V.X := V.X * factor;
  2313. V.Y := V.Y * factor;
  2314. V.Z := V.Z * factor;
  2315. end;
  2316. procedure ScaleVector(var V: TGLVector; factor: Single);
  2317. begin
  2318. V.X := V.X * factor;
  2319. V.Y := V.Y * factor;
  2320. V.Z := V.Z * factor;
  2321. V.W := V.W * factor;
  2322. end;
  2323. procedure ScaleVector(var V: TAffineVector; const factor: TAffineVector);
  2324. begin
  2325. V.X := V.X * factor.X;
  2326. V.Y := V.Y * factor.Y;
  2327. V.Z := V.Z * factor.Z;
  2328. end;
  2329. procedure ScaleVector(var V: TGLVector; const factor: TGLVector);
  2330. begin
  2331. V.X := V.X * factor.X;
  2332. V.Y := V.Y * factor.Y;
  2333. V.Z := V.Z * factor.Z;
  2334. V.W := V.W * factor.W;
  2335. end;
  2336. function VectorScale(const V: TVector2f; factor: Single): TVector2f;
  2337. begin
  2338. result.X := V.X * factor;
  2339. result.Y := V.Y * factor;
  2340. end;
  2341. function VectorScale(const V: TAffineVector; factor: Single): TAffineVector;
  2342. begin
  2343. result.X := V.X * factor;
  2344. result.Y := V.Y * factor;
  2345. result.Z := V.Z * factor;
  2346. end;
  2347. procedure VectorScale(const V: TAffineVector; factor: Single;
  2348. var vr: TAffineVector);
  2349. begin
  2350. vr.X := V.X * factor;
  2351. vr.Y := V.Y * factor;
  2352. vr.Z := V.Z * factor;
  2353. end;
  2354. function VectorScale(const V: TGLVector; factor: Single): TGLVector;
  2355. begin
  2356. result.X := V.X * factor;
  2357. result.Y := V.Y * factor;
  2358. result.Z := V.Z * factor;
  2359. result.W := V.W * factor;
  2360. end;
  2361. procedure VectorScale(const V: TGLVector; factor: Single; var vr: TGLVector);
  2362. begin
  2363. vr.X := V.X * factor;
  2364. vr.Y := V.Y * factor;
  2365. vr.Z := V.Z * factor;
  2366. vr.W := V.W * factor;
  2367. end;
  2368. procedure VectorScale(const V: TGLVector; factor: Single; var vr: TAffineVector);
  2369. begin
  2370. vr.X := V.X * factor;
  2371. vr.Y := V.Y * factor;
  2372. vr.Z := V.Z * factor;
  2373. end;
  2374. function VectorScale(const V: TAffineVector; const factor: TAffineVector)
  2375. : TAffineVector;
  2376. begin
  2377. result.X := V.X * factor.X;
  2378. result.Y := V.Y * factor.Y;
  2379. result.Z := V.Z * factor.Z;
  2380. end;
  2381. function VectorScale(const V: TGLVector; const factor: TGLVector): TGLVector;
  2382. begin
  2383. result.X := V.X * factor.X;
  2384. result.Y := V.Y * factor.Y;
  2385. result.Z := V.Z * factor.Z;
  2386. result.W := V.W * factor.W;
  2387. end;
  2388. procedure DivideVector(var V: TGLVector; const divider: TGLVector);
  2389. begin
  2390. V.X := V.X / divider.X;
  2391. V.Y := V.Y / divider.Y;
  2392. V.Z := V.Z / divider.Z;
  2393. V.W := V.W / divider.W;
  2394. end;
  2395. procedure DivideVector(var V: TAffineVector;
  2396. const divider: TAffineVector); overload;
  2397. begin
  2398. V.X := V.X / divider.X;
  2399. V.Y := V.Y / divider.Y;
  2400. V.Z := V.Z / divider.Z;
  2401. end;
  2402. function VectorDivide(const V: TGLVector; const divider: TGLVector)
  2403. : TGLVector; overload;
  2404. begin
  2405. result.X := V.X / divider.X;
  2406. result.Y := V.Y / divider.Y;
  2407. result.Z := V.Z / divider.Z;
  2408. result.W := V.W / divider.W;
  2409. end;
  2410. function VectorDivide(const V: TAffineVector; const divider: TAffineVector)
  2411. : TAffineVector; overload;
  2412. begin
  2413. result.X := V.X / divider.X;
  2414. result.Y := V.Y / divider.Y;
  2415. result.Z := V.Z / divider.Z;
  2416. end;
  2417. function TexpointEquals(const p1, p2: TTexPoint): Boolean;
  2418. begin
  2419. result := (p1.S = p2.S) and (p1.T = p2.T);
  2420. end;
  2421. function RectEquals(const Rect1, Rect2: TRect): Boolean;
  2422. begin
  2423. result := (Rect1.Left = Rect2.Left) and (Rect1.Right = Rect2.Right) and
  2424. (Rect1.Top = Rect2.Top) and (Rect1.Bottom = Rect2.Bottom);
  2425. end;
  2426. function VectorEquals(const V1, V2: TGLVector): Boolean;
  2427. begin
  2428. result := (V1.X = V2.X) and (V1.Y = V2.Y) and (V1.Z = V2.Z)
  2429. and (V1.W = V2.W);
  2430. end;
  2431. function VectorEquals(const V1, V2: TAffineVector): Boolean;
  2432. begin
  2433. result := (V1.X = V2.X) and (V1.Y = V2.Y) and (V1.Z = V2.Z);
  2434. end;
  2435. function AffineVectorEquals(const V1, V2: TGLVector): Boolean;
  2436. begin
  2437. result := (V1.X = V2.X) and (V1.Y = V2.Y) and (V1.Z = V2.Z);
  2438. end;
  2439. function VectorIsNull(const V: TGLVector): Boolean;
  2440. begin
  2441. result := ((V.X = 0) and (V.Y = 0) and (V.Z = 0));
  2442. end;
  2443. function VectorIsNull(const V: TAffineVector): Boolean; overload;
  2444. begin
  2445. result := ((V.X = 0) and (V.Y = 0) and (V.Z = 0));
  2446. end;
  2447. function VectorSpacing(const V1, V2: TTexPoint): Single; overload;
  2448. begin
  2449. result := Abs(V2.S - V1.S) + Abs(V2.T - V1.T);
  2450. end;
  2451. function VectorSpacing(const V1, V2: TAffineVector): Single;
  2452. begin
  2453. result := Abs(V2.X - V1.X) + Abs(V2.Y - V1.Y) +
  2454. Abs(V2.Z - V1.Z);
  2455. end;
  2456. function VectorSpacing(const V1, V2: TGLVector): Single;
  2457. begin
  2458. result := Abs(V2.X - V1.X) + Abs(V2.Y - V1.Y) +
  2459. Abs(V2.Z - V1.Z) + Abs(V2.W - V1.W);
  2460. end;
  2461. function VectorDistance(const V1, V2: TAffineVector): Single;
  2462. begin
  2463. result := Sqrt(Sqr(V2.X - V1.X) + Sqr(V2.Y - V1.Y) + Sqr(V2.Z - V1.Z));
  2464. end;
  2465. function VectorDistance(const V1, V2: TGLVector): Single;
  2466. begin
  2467. result := Sqrt(Sqr(V2.X - V1.X) + Sqr(V2.Y - V1.Y) + Sqr(V2.Z - V1.Z));
  2468. end;
  2469. function VectorDistance2(const V1, V2: TAffineVector): Single;
  2470. begin
  2471. result := Sqr(V2.X - V1.X) + Sqr(V2.Y - V1.Y) + Sqr(V2.Z - V1.Z);
  2472. end;
  2473. function VectorDistance2(const V1, V2: TGLVector): Single;
  2474. begin
  2475. result := Sqr(V2.X - V1.X) + Sqr(V2.Y - V1.Y) + Sqr(V2.Z - V1.Z);
  2476. end;
  2477. function VectorPerpendicular(const V, n: TAffineVector): TAffineVector;
  2478. var
  2479. dot: Single;
  2480. begin
  2481. dot := VectorDotProduct(V, n);
  2482. result.X := V.X - dot * n.X;
  2483. result.Y := V.Y - dot * n.Y;
  2484. result.Z := V.Z - dot * n.Z;
  2485. end;
  2486. function VectorReflect(const V, n: TAffineVector): TAffineVector;
  2487. begin
  2488. result := VectorCombine(V, n, 1, -2 * VectorDotProduct(V, n));
  2489. end;
  2490. procedure RotateVector(var Vector: TGLVector; const axis: TAffineVector;
  2491. angle: Single);
  2492. var
  2493. rotMatrix: TMatrix4f;
  2494. begin
  2495. rotMatrix := CreateRotationMatrix(axis, angle);
  2496. Vector := VectorTransform(Vector, rotMatrix);
  2497. end;
  2498. procedure RotateVector(var Vector: TGLVector; const axis: TGLVector;
  2499. angle: Single); overload;
  2500. var
  2501. rotMatrix: TMatrix4f;
  2502. begin
  2503. rotMatrix := CreateRotationMatrix(PAffineVector(@axis)^, angle);
  2504. Vector := VectorTransform(Vector, rotMatrix);
  2505. end;
  2506. procedure RotateVectorAroundY(var V: TAffineVector; alpha: Single);
  2507. var
  2508. c, S, v0: Single;
  2509. begin
  2510. SinCosine(alpha, S, c);
  2511. v0 := V.X;
  2512. V.X := c * v0 + S * V.Z;
  2513. V.Z := c * V.Z - S * v0;
  2514. end;
  2515. function VectorRotateAroundX(const V: TAffineVector; alpha: Single)
  2516. : TAffineVector;
  2517. var
  2518. c, S: Single;
  2519. begin
  2520. SinCosine(alpha, S, c);
  2521. result.X := V.X;
  2522. result.Y := c * V.Y + S * V.Z;
  2523. result.Z := c * V.Z - S * V.Y;
  2524. end;
  2525. function VectorRotateAroundY(const V: TAffineVector; alpha: Single)
  2526. : TAffineVector;
  2527. var
  2528. c, S: Single;
  2529. begin
  2530. SinCosine(alpha, S, c);
  2531. result.Y := V.Y;
  2532. result.X := c * V.X + S * V.Z;
  2533. result.Z := c * V.Z - S * V.X;
  2534. end;
  2535. procedure VectorRotateAroundY(const V: TAffineVector; alpha: Single;
  2536. var vr: TAffineVector);
  2537. var
  2538. c, S: Single;
  2539. begin
  2540. SinCosine(alpha, S, c);
  2541. vr.Y := V.Y;
  2542. vr.X := c * V.X + S * V.Z;
  2543. vr.Z := c * V.Z - S * V.X;
  2544. end;
  2545. function VectorRotateAroundZ(const V: TAffineVector; alpha: Single)
  2546. : TAffineVector;
  2547. var
  2548. c, S: Single;
  2549. begin
  2550. SinCosine(alpha, S, c);
  2551. result.X := c * V.X + S * V.Y;
  2552. result.Y := c * V.Y - S * V.X;
  2553. result.Z := V.Z;
  2554. end;
  2555. procedure AbsVector(var V: TGLVector);
  2556. begin
  2557. V.X := Abs(V.X);
  2558. V.Y := Abs(V.Y);
  2559. V.Z := Abs(V.Z);
  2560. V.W := Abs(V.W);
  2561. end;
  2562. procedure AbsVector(var V: TAffineVector);
  2563. begin
  2564. V.X := Abs(V.X);
  2565. V.Y := Abs(V.Y);
  2566. V.Z := Abs(V.Z);
  2567. end;
  2568. function VectorAbs(const V: TGLVector): TGLVector;
  2569. begin
  2570. result.X := Abs(V.X);
  2571. result.Y := Abs(V.Y);
  2572. result.Z := Abs(V.Z);
  2573. result.W := Abs(V.W);
  2574. end;
  2575. function VectorAbs(const V: TAffineVector): TAffineVector;
  2576. begin
  2577. result.X := Abs(V.X);
  2578. result.Y := Abs(V.Y);
  2579. result.Z := Abs(V.Z);
  2580. end;
  2581. function IsColinear(const V1, V2: TVector2f): Boolean; overload;
  2582. var
  2583. a, b, c: Single;
  2584. begin
  2585. a := VectorDotProduct(V1, V1);
  2586. b := VectorDotProduct(V1, V2);
  2587. c := VectorDotProduct(V2, V2);
  2588. result := (a * c - b * b) < cColinearBias;
  2589. end;
  2590. function IsColinear(const V1, V2: TAffineVector): Boolean; overload;
  2591. var
  2592. a, b, c: Single;
  2593. begin
  2594. a := VectorDotProduct(V1, V1);
  2595. b := VectorDotProduct(V1, V2);
  2596. c := VectorDotProduct(V2, V2);
  2597. result := (a * c - b * b) < cColinearBias;
  2598. end;
  2599. function IsColinear(const V1, V2: TGLVector): Boolean; overload;
  2600. var
  2601. a, b, c: Single;
  2602. begin
  2603. a := VectorDotProduct(V1, V1);
  2604. b := VectorDotProduct(V1, V2);
  2605. c := VectorDotProduct(V2, V2);
  2606. result := (a * c - b * b) < cColinearBias;
  2607. end;
  2608. procedure SetMatrix(var dest: THomogeneousDblMatrix; const src: TGLMatrix);
  2609. var
  2610. i: Integer;
  2611. begin
  2612. for i := X to W do
  2613. begin
  2614. dest.V[i].X := src.V[i].X;
  2615. dest.V[i].Y := src.V[i].Y;
  2616. dest.V[i].Z := src.V[i].Z;
  2617. dest.V[i].W := src.V[i].W;
  2618. end;
  2619. end;
  2620. procedure SetMatrix(var dest: TAffineMatrix; const src: TGLMatrix);
  2621. begin
  2622. dest.X.X := src.X.X;
  2623. dest.X.Y := src.X.Y;
  2624. dest.X.Z := src.X.Z;
  2625. dest.Y.X := src.Y.X;
  2626. dest.Y.Y := src.Y.Y;
  2627. dest.Y.Z := src.Y.Z;
  2628. dest.Z.X := src.Z.X;
  2629. dest.Z.Y := src.Z.Y;
  2630. dest.Z.Z := src.Z.Z;
  2631. end;
  2632. procedure SetMatrix(var dest: TGLMatrix; const src: TAffineMatrix);
  2633. begin
  2634. dest.X.X := src.X.X;
  2635. dest.X.Y := src.X.Y;
  2636. dest.X.Z := src.X.Z;
  2637. dest.X.W := 0;
  2638. dest.Y.X := src.Y.X;
  2639. dest.Y.Y := src.Y.Y;
  2640. dest.Y.Z := src.Y.Z;
  2641. dest.Y.W := 0;
  2642. dest.Z.X := src.Z.X;
  2643. dest.Z.Y := src.Z.Y;
  2644. dest.Z.Z := src.Z.Z;
  2645. dest.Z.W := 0;
  2646. dest.W.X := 0;
  2647. dest.W.Y := 0;
  2648. dest.W.Z := 0;
  2649. dest.W.W := 1;
  2650. end;
  2651. procedure SetMatrixRow(var dest: TGLMatrix; rowNb: Integer; const aRow: TGLVector);
  2652. begin
  2653. dest.X.V[rowNb] := aRow.X;
  2654. dest.Y.V[rowNb] := aRow.Y;
  2655. dest.Z.V[rowNb] := aRow.Z;
  2656. dest.W.V[rowNb] := aRow.W;
  2657. end;
  2658. function CreateScaleMatrix(const V: TAffineVector): TGLMatrix;
  2659. begin
  2660. result := IdentityHmgMatrix;
  2661. result.X.X := V.V[X];
  2662. result.Y.Y := V.V[Y];
  2663. result.Z.Z := V.V[Z];
  2664. end;
  2665. function CreateScaleMatrix(const V: TGLVector): TGLMatrix;
  2666. begin
  2667. result := IdentityHmgMatrix;
  2668. result.X.X := V.V[X];
  2669. result.Y.Y := V.V[Y];
  2670. result.Z.Z := V.V[Z];
  2671. end;
  2672. function CreateTranslationMatrix(const V: TAffineVector): TGLMatrix;
  2673. begin
  2674. result := IdentityHmgMatrix;
  2675. result.W.X := V.V[X];
  2676. result.W.Y := V.V[Y];
  2677. result.W.Z := V.V[Z];
  2678. end;
  2679. function CreateTranslationMatrix(const V: TGLVector): TGLMatrix;
  2680. begin
  2681. result := IdentityHmgMatrix;
  2682. result.W.X := V.V[X];
  2683. result.W.Y := V.V[Y];
  2684. result.W.Z := V.V[Z];
  2685. end;
  2686. function CreateScaleAndTranslationMatrix(const scale, offset: TGLVector): TGLMatrix;
  2687. begin
  2688. result := IdentityHmgMatrix;
  2689. result.X.X := scale.V[X];
  2690. result.W.X := offset.V[X];
  2691. result.Y.Y := scale.V[Y];
  2692. result.W.Y := offset.V[Y];
  2693. result.Z.Z := scale.V[Z];
  2694. result.W.Z := offset.V[Z];
  2695. end;
  2696. function CreateRotationMatrixX(const sine, cosine: Single): TGLMatrix;
  2697. begin
  2698. result := EmptyHmgMatrix;
  2699. result.X.X := 1;
  2700. result.Y.Y := cosine;
  2701. result.Y.Z := sine;
  2702. result.Z.Y := -sine;
  2703. result.Z.Z := cosine;
  2704. result.W.W := 1;
  2705. end;
  2706. function CreateRotationMatrixX(const angle: Single): TGLMatrix;
  2707. var
  2708. S, c: Single;
  2709. begin
  2710. SinCosine(angle, S, c);
  2711. result := CreateRotationMatrixX(S, c);
  2712. end;
  2713. function CreateRotationMatrixY(const sine, cosine: Single): TGLMatrix;
  2714. begin
  2715. result := EmptyHmgMatrix;
  2716. result.X.X := cosine;
  2717. result.X.Z := -sine;
  2718. result.Y.Y := 1;
  2719. result.Z.X := sine;
  2720. result.Z.Z := cosine;
  2721. result.W.W := 1;
  2722. end;
  2723. function CreateRotationMatrixY(const angle: Single): TGLMatrix;
  2724. var
  2725. S, c: Single;
  2726. begin
  2727. SinCosine(angle, S, c);
  2728. result := CreateRotationMatrixY(S, c);
  2729. end;
  2730. function CreateRotationMatrixZ(const sine, cosine: Single): TGLMatrix;
  2731. begin
  2732. result := EmptyHmgMatrix;
  2733. result.X.X := cosine;
  2734. result.X.Y := sine;
  2735. result.Y.X := -sine;
  2736. result.Y.Y := cosine;
  2737. result.Z.Z := 1;
  2738. result.W.W := 1;
  2739. end;
  2740. function CreateRotationMatrixZ(const angle: Single): TGLMatrix;
  2741. var
  2742. S, c: Single;
  2743. begin
  2744. SinCosine(angle, S, c);
  2745. result := CreateRotationMatrixZ(S, c);
  2746. end;
  2747. function CreateRotationMatrix(const anAxis: TAffineVector;
  2748. angle: Single): TGLMatrix;
  2749. var
  2750. axis: TAffineVector;
  2751. cosine, sine, one_minus_cosine: Single;
  2752. begin
  2753. SinCosine(angle, sine, cosine);
  2754. one_minus_cosine := 1 - cosine;
  2755. axis := VectorNormalize(anAxis);
  2756. result.X.X := (one_minus_cosine * axis.X * axis.X) + cosine;
  2757. result.X.Y := (one_minus_cosine * axis.X * axis.Y) - (axis.Z * sine);
  2758. result.X.Z := (one_minus_cosine * axis.Z * axis.X) + (axis.Y * sine);
  2759. result.X.W := 0;
  2760. result.Y.X := (one_minus_cosine * axis.X * axis.Y) + (axis.Z * sine);
  2761. result.Y.Y := (one_minus_cosine * axis.Y * axis.Y) + cosine;
  2762. result.Y.Z := (one_minus_cosine * axis.Y * axis.Z) - (axis.X * sine);
  2763. result.Y.W := 0;
  2764. result.Z.X := (one_minus_cosine * axis.Z * axis.X) - (axis.Y * sine);
  2765. result.Z.Y := (one_minus_cosine * axis.Y * axis.Z) + (axis.X * sine);
  2766. result.Z.Z := (one_minus_cosine * axis.Z * axis.Z) + cosine;
  2767. result.Z.W := 0;
  2768. result.W.X := 0;
  2769. result.W.Y := 0;
  2770. result.W.Z := 0;
  2771. result.W.W := 1;
  2772. end;
  2773. function CreateRotationMatrix(const anAxis: TGLVector; angle: Single): TGLMatrix;
  2774. begin
  2775. result := CreateRotationMatrix(PAffineVector(@anAxis)^, angle);
  2776. end;
  2777. function CreateAffineRotationMatrix(const anAxis: TAffineVector; angle: Single)
  2778. : TAffineMatrix;
  2779. var
  2780. axis: TAffineVector;
  2781. cosine, sine, one_minus_cosine: Single;
  2782. begin
  2783. SinCosine(angle, sine, cosine);
  2784. one_minus_cosine := 1 - cosine;
  2785. axis := VectorNormalize(anAxis);
  2786. result.X.X := (one_minus_cosine * Sqr(axis.X)) + cosine;
  2787. result.X.Y := (one_minus_cosine * axis.X * axis.Y) - (axis.Z * sine);
  2788. result.X.Z := (one_minus_cosine * axis.Z * axis.X) + (axis.Y * sine);
  2789. result.Y.X := (one_minus_cosine * axis.X * axis.Y) + (axis.Z * sine);
  2790. result.Y.Y := (one_minus_cosine * Sqr(axis.Y)) + cosine;
  2791. result.Y.Z := (one_minus_cosine * axis.Y * axis.Z) - (axis.X * sine);
  2792. result.Z.X := (one_minus_cosine * axis.Z * axis.X) - (axis.Y * sine);
  2793. result.Z.Y := (one_minus_cosine * axis.Y * axis.Z) + (axis.X * sine);
  2794. result.Z.Z := (one_minus_cosine * Sqr(axis.Z)) + cosine;
  2795. end;
  2796. function MatrixMultiply(const m1, m2: TAffineMatrix): TAffineMatrix;
  2797. begin
  2798. result.X.X := m1.X.X * m2.X.X + m1.X.Y * m2.Y.X + m1.X.Z * m2.Z.X;
  2799. result.X.Y := m1.X.X * m2.X.Y + m1.X.Y * m2.Y.Y + m1.X.Z * m2.Z.Y;
  2800. result.X.Z := m1.X.X * m2.X.Z + m1.X.Y * m2.Y.Z + m1.X.Z * m2.Z.Z;
  2801. result.Y.X := m1.Y.X * m2.X.X + m1.Y.Y * m2.Y.X + m1.Y.Z * m2.Z.X;
  2802. result.Y.Y := m1.Y.X * m2.X.Y + m1.Y.Y * m2.Y.Y + m1.Y.Z * m2.Z.Y;
  2803. result.Y.Z := m1.Y.X * m2.X.Z + m1.Y.Y * m2.Y.Z + m1.Y.Z * m2.Z.Z;
  2804. result.Z.X := m1.Z.X * m2.X.X + m1.Z.Y * m2.Y.X + m1.Z.Z * m2.Z.X;
  2805. result.Z.Y := m1.Z.X * m2.X.Y + m1.Z.Y * m2.Y.Y + m1.Z.Z * m2.Z.Y;
  2806. result.Z.Z := m1.Z.X * m2.X.Z + m1.Z.Y * m2.Y.Z + m1.Z.Z * m2.Z.Z;
  2807. end;
  2808. function MatrixMultiply(const m1, m2: TGLMatrix): TGLMatrix;
  2809. begin
  2810. result.X.X := m1.X.X * m2.X.X + m1.X.Y * m2.Y.X + m1.X.Z * m2.Z.X +
  2811. m1.X.W * m2.W.X;
  2812. result.X.Y := m1.X.X * m2.X.Y + m1.X.Y * m2.Y.Y + m1.X.Z * m2.Z.Y +
  2813. m1.X.W * m2.W.Y;
  2814. result.X.Z := m1.X.X * m2.X.Z + m1.X.Y * m2.Y.Z + m1.X.Z * m2.Z.Z +
  2815. m1.X.W * m2.W.Z;
  2816. result.X.W := m1.X.X * m2.X.W + m1.X.Y * m2.Y.W + m1.X.Z * m2.Z.W +
  2817. m1.X.W * m2.W.W;
  2818. result.Y.X := m1.Y.X * m2.X.X + m1.Y.Y * m2.Y.X + m1.Y.Z * m2.Z.X +
  2819. m1.Y.W * m2.W.X;
  2820. result.Y.Y := m1.Y.X * m2.X.Y + m1.Y.Y * m2.Y.Y + m1.Y.Z * m2.Z.Y +
  2821. m1.Y.W * m2.W.Y;
  2822. result.Y.Z := m1.Y.X * m2.X.Z + m1.Y.Y * m2.Y.Z + m1.Y.Z * m2.Z.Z +
  2823. m1.Y.W * m2.W.Z;
  2824. result.Y.W := m1.Y.X * m2.X.W + m1.Y.Y * m2.Y.W + m1.Y.Z * m2.Z.W +
  2825. m1.Y.W * m2.W.W;
  2826. result.Z.X := m1.Z.X * m2.X.X + m1.Z.Y * m2.Y.X + m1.Z.Z * m2.Z.X +
  2827. m1.Z.W * m2.W.X;
  2828. result.Z.Y := m1.Z.X * m2.X.Y + m1.Z.Y * m2.Y.Y + m1.Z.Z * m2.Z.Y +
  2829. m1.Z.W * m2.W.Y;
  2830. result.Z.Z := m1.Z.X * m2.X.Z + m1.Z.Y * m2.Y.Z + m1.Z.Z * m2.Z.Z +
  2831. m1.Z.W * m2.W.Z;
  2832. result.Z.W := m1.Z.X * m2.X.W + m1.Z.Y * m2.Y.W + m1.Z.Z * m2.Z.W +
  2833. m1.Z.W * m2.W.W;
  2834. result.W.X := m1.W.X * m2.X.X + m1.W.Y * m2.Y.X + m1.W.Z * m2.Z.X +
  2835. m1.W.W * m2.W.X;
  2836. result.W.Y := m1.W.X * m2.X.Y + m1.W.Y * m2.Y.Y + m1.W.Z * m2.Z.Y +
  2837. m1.W.W * m2.W.Y;
  2838. result.W.Z := m1.W.X * m2.X.Z + m1.W.Y * m2.Y.Z + m1.W.Z * m2.Z.Z +
  2839. m1.W.W * m2.W.Z;
  2840. result.W.W := m1.W.X * m2.X.W + m1.W.Y * m2.Y.W + m1.W.Z * m2.Z.W +
  2841. m1.W.W * m2.W.W;
  2842. end;
  2843. procedure MatrixMultiply(const m1, m2: TGLMatrix; var MResult: TGLMatrix);
  2844. begin
  2845. MResult.X.X := m1.X.X * m2.X.X + m1.X.Y * m2.Y.X + m1.X.Z * m2.Z.X + m1.X.W * m2.W.X;
  2846. MResult.X.Y := m1.X.X * m2.X.Y + m1.X.Y * m2.Y.Y + m1.X.Z * m2.Z.Y + m1.X.W * m2.W.Y;
  2847. MResult.X.Z := m1.X.X * m2.X.Z + m1.X.Y * m2.Y.Z + m1.X.Z * m2.Z.Z + m1.X.W * m2.W.Z;
  2848. MResult.X.W := m1.X.X * m2.X.W + m1.X.Y * m2.Y.W + m1.X.Z * m2.Z.W + m1.X.W * m2.W.W;
  2849. MResult.Y.X := m1.Y.X * m2.X.X + m1.Y.Y * m2.Y.X + m1.Y.Z * m2.Z.X + m1.Y.W * m2.W.X;
  2850. MResult.Y.Y := m1.Y.X * m2.X.Y + m1.Y.Y * m2.Y.Y + m1.Y.Z * m2.Z.Y + m1.Y.W * m2.W.Y;
  2851. MResult.Y.Z := m1.Y.X * m2.X.Z + m1.Y.Y * m2.Y.Z + m1.Y.Z * m2.Z.Z + m1.Y.W * m2.W.Z;
  2852. MResult.Y.W := m1.Y.X * m2.X.W + m1.Y.Y * m2.Y.W + m1.Y.Z * m2.Z.W + m1.Y.W * m2.W.W;
  2853. MResult.Z.X := m1.Z.X * m2.X.X + m1.Z.Y * m2.Y.X + m1.Z.Z * m2.Z.X + m1.Z.W * m2.W.X;
  2854. MResult.Z.Y := m1.Z.X * m2.X.Y + m1.Z.Y * m2.Y.Y + m1.Z.Z * m2.Z.Y + m1.Z.W * m2.W.Y;
  2855. MResult.Z.Z := m1.Z.X * m2.X.Z + m1.Z.Y * m2.Y.Z + m1.Z.Z * m2.Z.Z + m1.Z.W * m2.W.Z;
  2856. MResult.Z.W := m1.Z.X * m2.X.W + m1.Z.Y * m2.Y.W + m1.Z.Z * m2.Z.W + m1.Z.W * m2.W.W;
  2857. MResult.W.X := m1.W.X * m2.X.X + m1.W.Y * m2.Y.X + m1.W.Z * m2.Z.X + m1.W.W * m2.W.X;
  2858. MResult.W.Y := m1.W.X * m2.X.Y + m1.W.Y * m2.Y.Y + m1.W.Z * m2.Z.Y + m1.W.W * m2.W.Y;
  2859. MResult.W.Z := m1.W.X * m2.X.Z + m1.W.Y * m2.Y.Z + m1.W.Z * m2.Z.Z + m1.W.W * m2.W.Z;
  2860. MResult.W.W := m1.W.X * m2.X.W + m1.W.Y * m2.Y.W + m1.W.Z * m2.Z.W + m1.W.W * m2.W.W;
  2861. end;
  2862. function VectorTransform(const V: TGLVector; const M: TGLMatrix): TGLVector;
  2863. begin
  2864. result.V[X] := V.V[X] * M.X.X + V.V[Y] * M.Y.X + V.V[Z] * M.Z.X + V.V[W] * M.W.X;
  2865. result.V[Y] := V.V[X] * M.X.Y + V.V[Y] * M.Y.Y + V.V[Z] * M.Z.Y + V.V[W] * M.W.Y;
  2866. result.V[Z] := V.V[X] * M.X.Z + V.V[Y] * M.Y.Z + V.V[Z] * M.Z.Z + V.V[W] * M.W.Z;
  2867. result.V[W] := V.V[X] * M.X.W + V.V[Y] * M.Y.W + V.V[Z] * M.Z.W + V.V[W] * M.W.W;
  2868. end;
  2869. function VectorTransform(const V: TGLVector; const M: TAffineMatrix): TGLVector;
  2870. begin
  2871. result.X := V.X * M.V[X].X + V.Y * M.V[Y].X + V.Z * M.V[Z].X;
  2872. result.Y := V.X * M.V[X].Y + V.Y * M.V[Y].Y + V.Z * M.V[Z].Y;
  2873. result.Z := V.X * M.V[X].Z + V.Y * M.V[Y].Z + V.Z * M.V[Z].Z;
  2874. result.W := V.W;
  2875. end;
  2876. function VectorTransform(const V: TAffineVector; const M: TGLMatrix)
  2877. : TAffineVector;
  2878. begin
  2879. result.X := V.X * M.V[X].X + V.Y * M.V[Y].X + V.Z * M.V[Z].X + M.V[W].X;
  2880. result.Y := V.X * M.V[X].Y + V.Y * M.V[Y].Y + V.Z * M.V[Z].Y + M.V[W].Y;
  2881. result.Z := V.X * M.V[X].Z + V.Y * M.V[Y].Z + V.Z * M.V[Z].Z + M.V[W].Z;
  2882. end;
  2883. function VectorTransform(const V: TAffineVector; const M: TAffineMatrix)
  2884. : TAffineVector;
  2885. begin
  2886. result.V[X] := V.V[X] * M.X.X + V.V[Y] * M.Y.X + V.V[Z] * M.Z.X;
  2887. result.V[Y] := V.V[X] * M.X.Y + V.V[Y] * M.Y.Y + V.V[Z] * M.Z.Y;
  2888. result.V[Z] := V.V[X] * M.X.Z + V.V[Y] * M.Y.Z + V.V[Z] * M.Z.Z;
  2889. end;
  2890. function MatrixDeterminant(const M: TAffineMatrix): Single;
  2891. begin
  2892. result := M.X.X * (M.Y.Y * M.Z.Z - M.Z.Y * M.Y.Z) - M.X.Y *
  2893. (M.Y.X * M.Z.Z - M.Z.X * M.Y.Z) + M.X.Z * (M.Y.X * M.Z.Y - M.Z.X * M.Y.Y);
  2894. end;
  2895. function MatrixDetInternal(const a1, a2, a3, b1, b2, b3, c1, c2,
  2896. c3: Single): Single;
  2897. // internal version for the determinant of a 3x3 matrix
  2898. begin
  2899. result := a1 * (b2 * c3 - b3 * c2) - b1 * (a2 * c3 - a3 * c2) + c1 *
  2900. (a2 * b3 - a3 * b2);
  2901. end;
  2902. function MatrixDeterminant(const M: TGLMatrix): Single;
  2903. begin
  2904. result := M.X.X * MatrixDetInternal(M.Y.Y, M.Z.Y, M.W.Y, M.Y.Z, M.Z.Z, M.W.Z,
  2905. M.Y.W, M.Z.W, M.W.W) - M.X.Y * MatrixDetInternal(M.Y.X, M.Z.X, M.W.X, M.Y.Z,
  2906. M.Z.Z, M.W.Z, M.Y.W, M.Z.W, M.W.W) + M.X.Z * MatrixDetInternal(M.Y.X, M.Z.X,
  2907. M.W.X, M.Y.Y, M.Z.Y, M.W.Y, M.Y.W, M.Z.W, M.W.W) - M.X.W *
  2908. MatrixDetInternal(M.Y.X, M.Z.X, M.W.X, M.Y.Y, M.Z.Y, M.W.Y, M.Y.Z,
  2909. M.Z.Z, M.W.Z);
  2910. end;
  2911. procedure AdjointMatrix(var M: TGLMatrix);
  2912. var
  2913. a1, a2, a3, a4, b1, b2, b3, b4, c1, c2, c3, c4, d1, d2, d3, d4: Single;
  2914. begin
  2915. a1 := M.X.X;
  2916. b1 := M.X.Y;
  2917. c1 := M.X.Z;
  2918. d1 := M.X.W;
  2919. a2 := M.Y.X;
  2920. b2 := M.Y.Y;
  2921. c2 := M.Y.Z;
  2922. d2 := M.Y.W;
  2923. a3 := M.Z.X;
  2924. b3 := M.Z.Y;
  2925. c3 := M.Z.Z;
  2926. d3 := M.Z.W;
  2927. a4 := M.W.X;
  2928. b4 := M.W.Y;
  2929. c4 := M.W.Z;
  2930. d4 := M.W.W;
  2931. // row column labeling reversed since we transpose rows & columns
  2932. M.X.X := MatrixDetInternal(b2, b3, b4, c2, c3, c4, d2, d3, d4);
  2933. M.Y.X := -MatrixDetInternal(a2, a3, a4, c2, c3, c4, d2, d3, d4);
  2934. M.Z.X := MatrixDetInternal(a2, a3, a4, b2, b3, b4, d2, d3, d4);
  2935. M.W.X := -MatrixDetInternal(a2, a3, a4, b2, b3, b4, c2, c3, c4);
  2936. M.X.Y := -MatrixDetInternal(b1, b3, b4, c1, c3, c4, d1, d3, d4);
  2937. M.Y.Y := MatrixDetInternal(a1, a3, a4, c1, c3, c4, d1, d3, d4);
  2938. M.Z.Y := -MatrixDetInternal(a1, a3, a4, b1, b3, b4, d1, d3, d4);
  2939. M.W.Y := MatrixDetInternal(a1, a3, a4, b1, b3, b4, c1, c3, c4);
  2940. M.X.Z := MatrixDetInternal(b1, b2, b4, c1, c2, c4, d1, d2, d4);
  2941. M.Y.Z := -MatrixDetInternal(a1, a2, a4, c1, c2, c4, d1, d2, d4);
  2942. M.Z.Z := MatrixDetInternal(a1, a2, a4, b1, b2, b4, d1, d2, d4);
  2943. M.W.Z := -MatrixDetInternal(a1, a2, a4, b1, b2, b4, c1, c2, c4);
  2944. M.X.W := -MatrixDetInternal(b1, b2, b3, c1, c2, c3, d1, d2, d3);
  2945. M.Y.W := MatrixDetInternal(a1, a2, a3, c1, c2, c3, d1, d2, d3);
  2946. M.Z.W := -MatrixDetInternal(a1, a2, a3, b1, b2, b3, d1, d2, d3);
  2947. M.W.W := MatrixDetInternal(a1, a2, a3, b1, b2, b3, c1, c2, c3);
  2948. end;
  2949. procedure AdjointMatrix(var M: TAffineMatrix);
  2950. var
  2951. a1, a2, a3, b1, b2, b3, c1, c2, c3: Single;
  2952. begin
  2953. a1 := M.X.X;
  2954. a2 := M.X.Y;
  2955. a3 := M.X.Z;
  2956. b1 := M.Y.X;
  2957. b2 := M.Y.Y;
  2958. b3 := M.Y.Z;
  2959. c1 := M.Z.X;
  2960. c2 := M.Z.Y;
  2961. c3 := M.Z.Z;
  2962. M.X.X := (b2 * c3 - c2 * b3);
  2963. M.Y.X := -(b1 * c3 - c1 * b3);
  2964. M.Z.X := (b1 * c2 - c1 * b2);
  2965. M.X.Y := -(a2 * c3 - c2 * a3);
  2966. M.Y.Y := (a1 * c3 - c1 * a3);
  2967. M.Z.Y := -(a1 * c2 - c1 * a2);
  2968. M.X.Z := (a2 * b3 - b2 * a3);
  2969. M.Y.Z := -(a1 * b3 - b1 * a3);
  2970. M.Z.Z := (a1 * b2 - b1 * a2);
  2971. end;
  2972. procedure ScaleMatrix(var M: TAffineMatrix; const factor: Single);
  2973. var
  2974. i: Integer;
  2975. begin
  2976. for i := 0 to 2 do
  2977. begin
  2978. M.V[i].X := M.V[i].X * factor;
  2979. M.V[i].Y := M.V[i].Y * factor;
  2980. M.V[i].Z := M.V[i].Z * factor;
  2981. end;
  2982. end;
  2983. procedure ScaleMatrix(var M: TGLMatrix; const factor: Single);
  2984. var
  2985. i: Integer;
  2986. begin
  2987. for i := 0 to 3 do
  2988. begin
  2989. M.V[i].X := M.V[i].X * factor;
  2990. M.V[i].Y := M.V[i].Y * factor;
  2991. M.V[i].Z := M.V[i].Z * factor;
  2992. M.V[i].W := M.V[i].W * factor;
  2993. end;
  2994. end;
  2995. procedure TranslateMatrix(var M: TGLMatrix; const V: TAffineVector);
  2996. begin
  2997. M.W.X := M.W.X + V.X;
  2998. M.W.Y := M.W.Y + V.Y;
  2999. M.W.Z := M.W.Z + V.Z;
  3000. end;
  3001. procedure TranslateMatrix(var M: TGLMatrix; const V: TGLVector);
  3002. begin
  3003. M.W.X := M.W.X + V.X;
  3004. M.W.Y := M.W.Y + V.Y;
  3005. M.W.Z := M.W.Z + V.Z;
  3006. end;
  3007. procedure NormalizeMatrix(var M: TGLMatrix);
  3008. begin
  3009. M.X.W := 0;
  3010. NormalizeVector(M.X);
  3011. M.Y.W := 0;
  3012. NormalizeVector(M.Y);
  3013. M.Z := VectorCrossProduct(M.X, M.Y);
  3014. M.X := VectorCrossProduct(M.Y, M.Z);
  3015. M.W := WHmgVector;
  3016. end;
  3017. procedure TransposeMatrix(var M: TAffineMatrix);
  3018. var
  3019. f: Single;
  3020. begin
  3021. f := M.X.Y;
  3022. M.X.Y := M.Y.X;
  3023. M.Y.X := f;
  3024. f := M.X.Z;
  3025. M.X.Z := M.Z.X;
  3026. M.Z.X := f;
  3027. f := M.Y.Z;
  3028. M.Y.Z := M.Z.Y;
  3029. M.Z.Y := f;
  3030. end;
  3031. procedure TransposeMatrix(var M: TGLMatrix);
  3032. var
  3033. f: Single;
  3034. begin
  3035. f := M.X.Y;
  3036. M.X.Y := M.Y.X;
  3037. M.Y.X := f;
  3038. f := M.X.Z;
  3039. M.X.Z := M.Z.X;
  3040. M.Z.X := f;
  3041. f := M.X.W;
  3042. M.X.W := M.W.X;
  3043. M.W.X := f;
  3044. f := M.Y.Z;
  3045. M.Y.Z := M.Z.Y;
  3046. M.Z.Y := f;
  3047. f := M.Y.W;
  3048. M.Y.W := M.W.Y;
  3049. M.W.Y := f;
  3050. f := M.Z.W;
  3051. M.Z.W := M.W.Z;
  3052. M.W.Z := f;
  3053. end;
  3054. procedure InvertMatrix(var M: TGLMatrix);
  3055. var
  3056. det: Single;
  3057. begin
  3058. det := MatrixDeterminant(M);
  3059. if Abs(det) < EPSILON then
  3060. M := IdentityHmgMatrix
  3061. else
  3062. begin
  3063. AdjointMatrix(M);
  3064. ScaleMatrix(M, 1 / det);
  3065. end;
  3066. end;
  3067. function MatrixInvert(const M: TGLMatrix): TGLMatrix;
  3068. begin
  3069. result := M;
  3070. InvertMatrix(result);
  3071. end;
  3072. procedure InvertMatrix(var M: TAffineMatrix);
  3073. var
  3074. det: Single;
  3075. begin
  3076. det := MatrixDeterminant(M);
  3077. if Abs(det) < EPSILON then
  3078. M := IdentityMatrix
  3079. else
  3080. begin
  3081. AdjointMatrix(M);
  3082. ScaleMatrix(M, 1 / det);
  3083. end;
  3084. end;
  3085. function MatrixInvert(const M: TAffineMatrix): TAffineMatrix;
  3086. begin
  3087. result := M;
  3088. InvertMatrix(result);
  3089. end;
  3090. procedure Transpose_Scale_M33(const src: TGLMatrix; var dest: TGLMatrix;
  3091. var scale: Single);
  3092. begin
  3093. dest.X.X := scale * src.X.X;
  3094. dest.Y.X := scale * src.X.Y;
  3095. dest.Z.X := scale * src.X.Z;
  3096. dest.X.Y := scale * src.Y.X;
  3097. dest.Y.Y := scale * src.Y.Y;
  3098. dest.Z.Y := scale * src.Y.Z;
  3099. dest.X.Z := scale * src.Z.X;
  3100. dest.Y.Z := scale * src.Z.Y;
  3101. dest.Z.Z := scale * src.Z.Z;
  3102. end;
  3103. function AnglePreservingMatrixInvert(const mat: TGLMatrix): TGLMatrix;
  3104. var
  3105. scale: Single;
  3106. begin
  3107. scale := VectorNorm(mat.X);
  3108. // Is the submatrix A singular?
  3109. if Abs(scale) < EPSILON then
  3110. begin
  3111. // Matrix M has no inverse
  3112. result := IdentityHmgMatrix;
  3113. Exit;
  3114. end
  3115. else
  3116. begin
  3117. // Calculate the inverse of the square of the isotropic scale factor
  3118. scale := 1.0 / scale;
  3119. end;
  3120. // Fill in last row while CPU is busy with the division
  3121. result.X.W := 0.0;
  3122. result.Y.W := 0.0;
  3123. result.Z.W := 0.0;
  3124. result.W.W := 1.0;
  3125. // Transpose and scale the 3 by 3 upper-left submatrix
  3126. Transpose_Scale_M33(mat, result, scale);
  3127. // Calculate -(transpose(A) / s*s) C
  3128. result.W.X := -(result.X.X * mat.W.X + result.Y.X *
  3129. mat.W.Y + result.Z.X * mat.W.Z);
  3130. result.W.Y := -(result.X.Y * mat.W.X + result.Y.Y *
  3131. mat.W.Y + result.Z.Y * mat.W.Z);
  3132. result.W.Z := -(result.X.Z * mat.W.X + result.Y.Z *
  3133. mat.W.Y + result.Z.Z * mat.W.Z);
  3134. end;
  3135. function MatrixDecompose(const M: TGLMatrix; var Tran: TTransformations): Boolean;
  3136. var
  3137. I, J: Integer;
  3138. LocMat, pmat, invpmat: TGLMatrix;
  3139. prhs, psol: TGLVector;
  3140. row0, row1, row2: TAffineVector;
  3141. f: Single;
  3142. begin
  3143. Result := False;
  3144. LocMat := M;
  3145. // normalize the matrix
  3146. if LocMat.W.W = 0 then
  3147. Exit;
  3148. for I := 0 to 3 do
  3149. for J := 0 to 3 do
  3150. LocMat.V[I].V[J] := LocMat.V[I].V[J] / LocMat.W.W;
  3151. // pmat is used to solve for perspective, but it also provides
  3152. // an easy way to test for singularity of the upper 3x3 component.
  3153. pmat := LocMat;
  3154. for I := 0 to 2 do
  3155. pmat.V[I].V[W] := 0;
  3156. pmat.W.W := 1;
  3157. if MatrixDeterminant(pmat) = 0 then
  3158. Exit;
  3159. // First, isolate perspective. This is the messiest.
  3160. if (LocMat.X.W <> 0) or (LocMat.Y.W <> 0) or (LocMat.Z.W <> 0) then
  3161. begin
  3162. // prhs is the right hand side of the equation.
  3163. prhs.X := LocMat.X.W;
  3164. prhs.Y := LocMat.Y.W;
  3165. prhs.Z := LocMat.Z.W;
  3166. prhs.W := LocMat.W.W;
  3167. // Solve the equation by inverting pmat and multiplying
  3168. // prhs by the inverse. (This is the easiest way, not
  3169. // necessarily the best.)
  3170. invpmat := pmat;
  3171. InvertMatrix(invpmat);
  3172. TransposeMatrix(invpmat);
  3173. psol := VectorTransform(prhs, invpmat);
  3174. // stuff the answer away
  3175. Tran[ttPerspectiveX] := psol.X;
  3176. Tran[ttPerspectiveY] := psol.Y;
  3177. Tran[ttPerspectiveZ] := psol.Z;
  3178. Tran[ttPerspectiveW] := psol.W;
  3179. // clear the perspective partition
  3180. LocMat.X.W := 0;
  3181. LocMat.Y.W := 0;
  3182. LocMat.Z.W := 0;
  3183. LocMat.W.W := 1;
  3184. end
  3185. else
  3186. begin
  3187. // no perspective
  3188. Tran[ttPerspectiveX] := 0;
  3189. Tran[ttPerspectiveY] := 0;
  3190. Tran[ttPerspectiveZ] := 0;
  3191. Tran[ttPerspectiveW] := 0;
  3192. end;
  3193. // next take care of translation (easy)
  3194. for I := 0 to 2 do
  3195. begin
  3196. Tran[TTransType(Ord(ttTranslateX) + I)] := LocMat.V[W].V[I];
  3197. LocMat.V[W].V[I] := 0;
  3198. end;
  3199. // now get scale and shear
  3200. SetVector(row0, LocMat.X);
  3201. SetVector(row1, LocMat.Y);
  3202. SetVector(row2, LocMat.Z);
  3203. // compute X scale factor and normalize first row
  3204. Tran[ttScaleX] := VectorNorm(row0);
  3205. VectorScale(row0, RSqrt(Tran[ttScaleX]));
  3206. // compute XY shear factor and make 2nd row orthogonal to 1st
  3207. Tran[ttShearXY] := VectorDotProduct(row0, row1);
  3208. f := -Tran[ttShearXY];
  3209. CombineVector(row1, row0, f);
  3210. // now, compute Y scale and normalize 2nd row
  3211. Tran[ttScaleY] := VectorNorm(row1);
  3212. VectorScale(row1, RSqrt(Tran[ttScaleY]));
  3213. Tran[ttShearXY] := Tran[ttShearXY] / Tran[ttScaleY];
  3214. // compute XZ and YZ shears, orthogonalize 3rd row
  3215. Tran[ttShearXZ] := VectorDotProduct(row0, row2);
  3216. f := -Tran[ttShearXZ];
  3217. CombineVector(row2, row0, f);
  3218. Tran[ttShearYZ] := VectorDotProduct(row1, row2);
  3219. f := -Tran[ttShearYZ];
  3220. CombineVector(row2, row1, f);
  3221. // next, get Z scale and normalize 3rd row
  3222. Tran[ttScaleZ] := VectorNorm(row2);
  3223. VectorScale(row2, RSqrt(Tran[ttScaleZ]));
  3224. Tran[ttShearXZ] := Tran[ttShearXZ] / Tran[ttScaleZ];
  3225. Tran[ttShearYZ] := Tran[ttShearYZ] / Tran[ttScaleZ];
  3226. // At this point, the matrix (in rows[]) is orthonormal.
  3227. // Check for a coordinate system flip. If the determinant
  3228. // is -1, then negate the matrix and the scaling factors.
  3229. if VectorDotProduct(row0, VectorCrossProduct(row1, row2)) < 0 then
  3230. begin
  3231. for I := 0 to 2 do
  3232. Tran[TTransType(Ord(ttScaleX) + I)] :=
  3233. -Tran[TTransType(Ord(ttScaleX) + I)];
  3234. NegateVector(row0);
  3235. NegateVector(row1);
  3236. NegateVector(row2);
  3237. end;
  3238. // now, get the rotations out, as described in the gem
  3239. Tran[ttRotateY] := ArcSin(-row0.Z);
  3240. if Cos(Tran[ttRotateY]) <> 0 then
  3241. begin
  3242. Tran[ttRotateX] := ArcTan2(row1.V[Z], row2.V[Z]);
  3243. Tran[ttRotateZ] := ArcTan2(row0.V[Y], row0.V[X]);
  3244. end
  3245. else
  3246. begin
  3247. Tran[ttRotateX] := ArcTan2(row1.V[X], row1.V[Y]);
  3248. Tran[ttRotateZ] := 0;
  3249. end;
  3250. // All done!
  3251. result := True;
  3252. end;
  3253. function CreateLookAtMatrix(const eye, center, normUp: TGLVector): TGLMatrix;
  3254. var
  3255. XAxis, YAxis, ZAxis, negEye: TGLVector;
  3256. begin
  3257. ZAxis := VectorSubtract(center, eye);
  3258. NormalizeVector(ZAxis);
  3259. XAxis := VectorCrossProduct(ZAxis, normUp);
  3260. NormalizeVector(XAxis);
  3261. YAxis := VectorCrossProduct(XAxis, ZAxis);
  3262. result.X := XAxis;
  3263. result.Y := YAxis;
  3264. result.Z := ZAxis;
  3265. NegateVector(result.Z);
  3266. result.W := NullHmgPoint;
  3267. TransposeMatrix(result);
  3268. negEye := eye;
  3269. NegateVector(negEye);
  3270. negEye.W := 1;
  3271. negEye := VectorTransform(negEye, result);
  3272. result.W := negEye;
  3273. end;
  3274. function CreateMatrixFromFrustum(Left, Right, Bottom, Top, ZNear,
  3275. ZFar: Single): TGLMatrix;
  3276. begin
  3277. result.X.X := 2 * ZNear / (Right - Left);
  3278. result.X.Y := 0;
  3279. result.X.Z := 0;
  3280. result.X.W := 0;
  3281. result.Y.X := 0;
  3282. result.Y.Y := 2 * ZNear / (Top - Bottom);
  3283. result.Y.Z := 0;
  3284. result.Y.W := 0;
  3285. result.Z.X := (Right + Left) / (Right - Left);
  3286. result.Z.Y := (Top + Bottom) / (Top - Bottom);
  3287. result.Z.Z := -(ZFar + ZNear) / (ZFar - ZNear);
  3288. result.Z.W := -1;
  3289. result.W.X := 0;
  3290. result.W.Y := 0;
  3291. result.W.Z := -2 * ZFar * ZNear / (ZFar - ZNear);
  3292. result.W.W := 0;
  3293. end;
  3294. function CreatePerspectiveMatrix(FOV, Aspect, ZNear, ZFar: Single): TGLMatrix;
  3295. var
  3296. X, Y: Single;
  3297. begin
  3298. FOV := MinFloat(179.9, MaxFloat(0, FOV));
  3299. Y := ZNear * Tangent(DegToRadian(FOV) * 0.5);
  3300. X := Y * Aspect;
  3301. result := CreateMatrixFromFrustum(-X, X, -Y, Y, ZNear, ZFar);
  3302. end;
  3303. function CreateOrthoMatrix(Left, Right, Bottom, Top, ZNear,
  3304. ZFar: Single): TGLMatrix;
  3305. begin
  3306. result.X.X := 2 / (Right - Left);
  3307. result.X.Y := 0;
  3308. result.X.Z := 0;
  3309. result.X.W := 0;
  3310. result.Y.X := 0;
  3311. result.Y.Y := 2 / (Top - Bottom);
  3312. result.Y.Z := 0;
  3313. result.Y.W := 0;
  3314. result.Z.X := 0;
  3315. result.Z.Y := 0;
  3316. result.Z.Z := -2 / (ZFar - ZNear);
  3317. result.Z.W := 0;
  3318. result.W.X := (Left + Right) / (Left - Right);
  3319. result.W.Y := (Bottom + Top) / (Bottom - Top);
  3320. result.W.Z := (ZNear + ZFar) / (ZNear - ZFar);
  3321. result.W.W := 1;
  3322. end;
  3323. function CreatePickMatrix(X, Y, deltax, deltay: Single;
  3324. const viewport: TVector4i): TGLMatrix;
  3325. begin
  3326. if (deltax <= 0) or (deltay <= 0) then
  3327. begin
  3328. result := IdentityHmgMatrix;
  3329. Exit;
  3330. end;
  3331. // Translate and scale the picked region to the entire window
  3332. result := CreateTranslationMatrix
  3333. (AffineVectorMake((viewport.Z - 2 * (X - viewport.X)) / deltax,
  3334. (viewport.W - 2 * (Y - viewport.Y)) / deltay, 0.0));
  3335. result.X.X := viewport.Z / deltax;
  3336. result.Y.Y := viewport.W / deltay;
  3337. end;
  3338. function Project(objectVector: TGLVector; const ViewProjMatrix: TGLMatrix;
  3339. const viewport: TVector4i; out WindowVector: TGLVector): Boolean;
  3340. begin
  3341. result := False;
  3342. objectVector.W := 1.0;
  3343. WindowVector := VectorTransform(objectVector, ViewProjMatrix);
  3344. if WindowVector.W = 0.0 then
  3345. Exit;
  3346. WindowVector.X := WindowVector.X / WindowVector.W;
  3347. WindowVector.Y := WindowVector.Y / WindowVector.W;
  3348. WindowVector.Z := WindowVector.Z / WindowVector.W;
  3349. // Map x, y and z to range 0-1
  3350. WindowVector.X := WindowVector.X * 0.5 + 0.5;
  3351. WindowVector.Y := WindowVector.Y * 0.5 + 0.5;
  3352. WindowVector.Z := WindowVector.Z * 0.5 + 0.5;
  3353. // Map x,y to viewport
  3354. WindowVector.X := WindowVector.X * viewport.Z + viewport.X;
  3355. WindowVector.Y := WindowVector.Y * viewport.W + viewport.Y;
  3356. result := True;
  3357. end;
  3358. function UnProject(WindowVector: TGLVector; ViewProjMatrix: TGLMatrix;
  3359. const viewport: TVector4i; out objectVector: TGLVector): Boolean;
  3360. begin
  3361. result := False;
  3362. InvertMatrix(ViewProjMatrix);
  3363. WindowVector.W := 1.0;
  3364. // Map x and y from window coordinates
  3365. WindowVector.X := (WindowVector.X - viewport.X) / viewport.Z;
  3366. WindowVector.Y := (WindowVector.Y - viewport.Y) / viewport.W;
  3367. // Map to range -1 to 1
  3368. WindowVector.X := WindowVector.X * 2 - 1;
  3369. WindowVector.Y := WindowVector.Y * 2 - 1;
  3370. WindowVector.Z := WindowVector.Z * 2 - 1;
  3371. objectVector := VectorTransform(WindowVector, ViewProjMatrix);
  3372. if objectVector.W = 0.0 then
  3373. Exit;
  3374. objectVector.X := objectVector.X / objectVector.W;
  3375. objectVector.Y := objectVector.Y / objectVector.W;
  3376. objectVector.Z := objectVector.Z / objectVector.W;
  3377. result := True;
  3378. end;
  3379. function CalcPlaneNormal(const p1, p2, p3: TAffineVector): TAffineVector;
  3380. var
  3381. V1, V2: TAffineVector;
  3382. begin
  3383. VectorSubtract(p2, p1, V1);
  3384. VectorSubtract(p3, p1, V2);
  3385. VectorCrossProduct(V1, V2, result);
  3386. NormalizeVector(result);
  3387. end;
  3388. procedure CalcPlaneNormal(const p1, p2, p3: TAffineVector; var vr: TAffineVector);
  3389. var
  3390. V1, V2: TAffineVector;
  3391. begin
  3392. VectorSubtract(p2, p1, V1);
  3393. VectorSubtract(p3, p1, V2);
  3394. VectorCrossProduct(V1, V2, vr);
  3395. NormalizeVector(vr);
  3396. end;
  3397. procedure CalcPlaneNormal(const p1, p2, p3: TGLVector; var vr: TAffineVector); overload;
  3398. var
  3399. V1, V2: TGLVector;
  3400. begin
  3401. VectorSubtract(p2, p1, V1);
  3402. VectorSubtract(p3, p1, V2);
  3403. VectorCrossProduct(V1, V2, vr);
  3404. NormalizeVector(vr);
  3405. end;
  3406. function PlaneMake(const point, normal: TAffineVector): THmgPlane;
  3407. begin
  3408. PAffineVector(@result)^ := normal;
  3409. result.W := -VectorDotProduct(point, normal);
  3410. end;
  3411. function PlaneMake(const point, normal: TGLVector): THmgPlane;
  3412. begin
  3413. PAffineVector(@result)^ := PAffineVector(@normal)^;
  3414. Result.W := -VectorDotProduct(PAffineVector(@point)^, PAffineVector(@normal)^);
  3415. end;
  3416. function PlaneMake(const p1, p2, p3: TAffineVector): THmgPlane;
  3417. begin
  3418. CalcPlaneNormal(p1, p2, p3, PAffineVector(@result)^);
  3419. result.W := -VectorDotProduct(p1, PAffineVector(@result)^);
  3420. end;
  3421. function PlaneMake(const p1, p2, p3: TGLVector): THmgPlane;
  3422. begin
  3423. CalcPlaneNormal(p1, p2, p3, PAffineVector(@result)^);
  3424. result.W := -VectorDotProduct(p1, PAffineVector(@result)^);
  3425. end;
  3426. procedure SetPlane(var dest: TDoubleHmgPlane; const src: THmgPlane);
  3427. begin
  3428. dest.X := src.X;
  3429. dest.Y := src.Y;
  3430. dest.Z := src.Z;
  3431. dest.W := src.W;
  3432. end;
  3433. procedure NormalizePlane(var plane: THmgPlane);
  3434. var
  3435. n: Single;
  3436. begin
  3437. n := RSqrt(plane.X * plane.X + plane.Y * plane.Y + plane.Z *
  3438. plane.Z);
  3439. ScaleVector(plane, n);
  3440. end;
  3441. function PlaneEvaluatePoint(const plane: THmgPlane; const point: TAffineVector): Single;
  3442. begin
  3443. result := plane.X * point.X + plane.Y * point.Y + plane.Z *
  3444. point.Z + plane.W;
  3445. end;
  3446. function PlaneEvaluatePoint(const plane: THmgPlane;
  3447. const point: TGLVector): Single;
  3448. begin
  3449. result := plane.X * point.X + plane.Y * point.Y + plane.Z * point.Z + plane.W;
  3450. end;
  3451. function PointIsInHalfSpace(const point, planePoint, planeNormal: TGLVector): Boolean;
  3452. begin
  3453. result := (PointPlaneDistance(point, planePoint, planeNormal) > 0); // 44
  3454. end;
  3455. function PointIsInHalfSpace(const point, planePoint,
  3456. planeNormal: TAffineVector): Boolean;
  3457. begin
  3458. result := (PointPlaneDistance(point, planePoint, planeNormal) > 0);
  3459. end;
  3460. function PointIsInHalfSpace(const point: TAffineVector;
  3461. const plane: THmgPlane): Boolean;
  3462. begin
  3463. result := (PointPlaneDistance(point, plane) > 0);
  3464. end;
  3465. function PointPlaneDistance(const point, planePoint,
  3466. planeNormal: TGLVector): Single;
  3467. begin
  3468. result := (point.X - planePoint.X) * planeNormal.X +
  3469. (point.Y - planePoint.Y) * planeNormal.Y +
  3470. (point.Z - planePoint.Z) * planeNormal.Z;
  3471. end;
  3472. function PointPlaneDistance(const point, planePoint,
  3473. planeNormal: TAffineVector): Single;
  3474. begin
  3475. result := (point.X - planePoint.X) * planeNormal.X +
  3476. (point.Y - planePoint.Y) * planeNormal.Y +
  3477. (point.Z - planePoint.Z) * planeNormal.Z;
  3478. end;
  3479. function PointPlaneDistance(const point: TAffineVector;
  3480. const plane: THmgPlane): Single;
  3481. begin
  3482. result := PlaneEvaluatePoint(plane, point);
  3483. end;
  3484. function PointPlaneOrthoProjection(const point: TAffineVector;
  3485. const plane: THmgPlane; var inter: TAffineVector;
  3486. bothface: Boolean = True): Boolean;
  3487. var
  3488. h: Single;
  3489. normal: TAffineVector;
  3490. begin
  3491. result := False;
  3492. h := PointPlaneDistance(point, plane);
  3493. if (not bothface) and (h < 0) then
  3494. Exit;
  3495. normal := Vector3fMake(plane);
  3496. inter := VectorAdd(point, VectorScale(normal, -h));
  3497. result := True;
  3498. end;
  3499. function PointPlaneProjection(const point, direction: TAffineVector;
  3500. const plane: THmgPlane; var inter: TAffineVector;
  3501. bothface: Boolean = True): Boolean;
  3502. var
  3503. h, dot: Single;
  3504. normal: TAffineVector;
  3505. begin
  3506. result := False;
  3507. normal := Vector3fMake(plane);
  3508. dot := VectorDotProduct(VectorNormalize(direction), normal);
  3509. if (not bothface) and (dot > 0) then
  3510. Exit;
  3511. if Abs(dot) >= 0.000000001 then
  3512. begin
  3513. h := PointPlaneDistance(point, plane);
  3514. inter := VectorAdd(point, VectorScale(direction, -h / dot));
  3515. result := True;
  3516. end;
  3517. end;
  3518. function SegmentPlaneIntersection(const ptA, ptB: TAffineVector;
  3519. const plane: THmgPlane; var inter: TAffineVector): Boolean;
  3520. var
  3521. hA, hB, dot: Single;
  3522. normal, direction: TVector3f;
  3523. begin
  3524. result := False;
  3525. hA := PointPlaneDistance(ptA, plane);
  3526. hB := PointPlaneDistance(ptB, plane);
  3527. if hA * hB <= 0 then
  3528. begin
  3529. normal := Vector3fMake(plane);
  3530. direction := VectorNormalize(VectorSubtract(ptB, ptA));
  3531. dot := VectorDotProduct(direction, normal);
  3532. if Abs(dot) >= 0.000000001 then
  3533. begin
  3534. inter := VectorAdd(ptA, VectorScale(direction, -hA / dot));
  3535. result := True;
  3536. end;
  3537. end;
  3538. end;
  3539. function PointTriangleOrthoProjection(const point, ptA, ptB, ptC: TAffineVector;
  3540. var inter: TAffineVector; bothface: Boolean = True): Boolean;
  3541. var
  3542. plane: THmgPlane;
  3543. begin
  3544. result := False;
  3545. plane := PlaneMake(ptA, ptB, ptC);
  3546. if not IsLineIntersectTriangle(point, Vector3fMake(plane), ptA, ptB, ptC) then
  3547. Exit;
  3548. result := PointPlaneOrthoProjection(point, plane, inter, bothface);
  3549. end;
  3550. function PointTriangleProjection(const point, direction, ptA, ptB,
  3551. ptC: TAffineVector; var inter: TAffineVector;
  3552. bothface: Boolean = True): Boolean;
  3553. var
  3554. plane: THmgPlane;
  3555. begin
  3556. result := False;
  3557. if not IsLineIntersectTriangle(point, direction, ptA, ptB, ptC) then
  3558. Exit;
  3559. plane := PlaneMake(ptA, ptB, ptC);
  3560. result := PointPlaneProjection(point, direction, plane, inter, bothface);
  3561. end;
  3562. function IsLineIntersectTriangle(const point, direction, ptA, ptB,
  3563. ptC: TAffineVector): Boolean;
  3564. var
  3565. PA, PB, PC: TAffineVector;
  3566. crossAB, crossBC, crossCA: TAffineVector;
  3567. begin
  3568. result := False;
  3569. PA := VectorSubtract(ptA, point);
  3570. PB := VectorSubtract(ptB, point);
  3571. PC := VectorSubtract(ptC, point);
  3572. crossAB := VectorCrossProduct(PA, PB);
  3573. crossBC := VectorCrossProduct(PB, PC);
  3574. if VectorDotProduct(crossAB, direction) > 0 then
  3575. begin
  3576. if VectorDotProduct(crossBC, direction) > 0 then
  3577. begin
  3578. crossCA := VectorCrossProduct(PC, PA);
  3579. if VectorDotProduct(crossCA, direction) > 0 then
  3580. result := True;
  3581. end;
  3582. end
  3583. else if VectorDotProduct(crossBC, direction) < 0 then
  3584. begin
  3585. crossCA := VectorCrossProduct(PC, PA);
  3586. if VectorDotProduct(crossCA, direction) < 0 then
  3587. result := True;
  3588. end
  3589. end;
  3590. function PointQuadOrthoProjection(const point, ptA, ptB, ptC,
  3591. ptD: TAffineVector; var inter: TAffineVector;
  3592. bothface: Boolean = True): Boolean;
  3593. var
  3594. plane: THmgPlane;
  3595. begin
  3596. result := False;
  3597. plane := PlaneMake(ptA, ptB, ptC);
  3598. if not IsLineIntersectQuad(point, Vector3fMake(plane), ptA, ptB, ptC, ptD)
  3599. then
  3600. Exit;
  3601. result := PointPlaneOrthoProjection(point, plane, inter, bothface);
  3602. end;
  3603. function PointQuadProjection(const point, direction, ptA, ptB, ptC,
  3604. ptD: TAffineVector; var inter: TAffineVector;
  3605. bothface: Boolean = True): Boolean;
  3606. var
  3607. plane: THmgPlane;
  3608. begin
  3609. result := False;
  3610. if not IsLineIntersectQuad(point, direction, ptA, ptB, ptC, ptD) then
  3611. Exit;
  3612. plane := PlaneMake(ptA, ptB, ptC);
  3613. result := PointPlaneProjection(point, direction, plane, inter, bothface);
  3614. end;
  3615. function IsLineIntersectQuad(const point, direction, ptA, ptB, ptC,
  3616. ptD: TAffineVector): Boolean;
  3617. var
  3618. PA, PB, PC, PD: TAffineVector;
  3619. crossAB, crossBC, crossCD, crossDA: TAffineVector;
  3620. begin
  3621. result := False;
  3622. PA := VectorSubtract(ptA, point);
  3623. PB := VectorSubtract(ptB, point);
  3624. PC := VectorSubtract(ptC, point);
  3625. PD := VectorSubtract(ptD, point);
  3626. crossAB := VectorCrossProduct(PA, PB);
  3627. crossBC := VectorCrossProduct(PB, PC);
  3628. if VectorDotProduct(crossAB, direction) > 0 then
  3629. begin
  3630. if VectorDotProduct(crossBC, direction) > 0 then
  3631. begin
  3632. crossCD := VectorCrossProduct(PC, PD);
  3633. if VectorDotProduct(crossCD, direction) > 0 then
  3634. begin
  3635. crossDA := VectorCrossProduct(PD, PA);
  3636. if VectorDotProduct(crossDA, direction) > 0 then
  3637. result := True;
  3638. end;
  3639. end;
  3640. end
  3641. else if VectorDotProduct(crossBC, direction) < 0 then
  3642. begin
  3643. crossCD := VectorCrossProduct(PC, PD);
  3644. if VectorDotProduct(crossCD, direction) < 0 then
  3645. begin
  3646. crossDA := VectorCrossProduct(PD, PA);
  3647. if VectorDotProduct(crossDA, direction) < 0 then
  3648. result := True;
  3649. end;
  3650. end
  3651. end;
  3652. function PointDiskOrthoProjection(const point, center, up: TAffineVector;
  3653. const radius: Single; var inter: TAffineVector;
  3654. bothface: Boolean = True): Boolean;
  3655. begin
  3656. if PointPlaneOrthoProjection(point, PlaneMake(center, up), inter, bothface)
  3657. then
  3658. result := (VectorDistance2(inter, center) <= radius * radius)
  3659. else
  3660. result := False;
  3661. end;
  3662. function PointDiskProjection(const point, direction, center, up: TAffineVector;
  3663. const radius: Single; var inter: TAffineVector;
  3664. bothface: Boolean = True): Boolean;
  3665. begin
  3666. if PointPlaneProjection(point, direction, PlaneMake(center, up), inter,
  3667. bothface) then
  3668. result := VectorDistance2(inter, center) <= radius * radius
  3669. else
  3670. result := False;
  3671. end;
  3672. function PointLineClosestPoint(const point, linePoint, lineDirection
  3673. : TAffineVector): TAffineVector;
  3674. var
  3675. W: TAffineVector;
  3676. c1, c2, b: Single;
  3677. begin
  3678. W := VectorSubtract(point, linePoint);
  3679. c1 := VectorDotProduct(W, lineDirection);
  3680. c2 := VectorDotProduct(lineDirection, lineDirection);
  3681. b := c1 / c2;
  3682. VectorAdd(linePoint, VectorScale(lineDirection, b), result);
  3683. end;
  3684. function PointLineDistance(const point, linePoint, lineDirection: TAffineVector): Single;
  3685. var
  3686. PB: TAffineVector;
  3687. begin
  3688. PB := PointLineClosestPoint(point, linePoint, lineDirection);
  3689. result := VectorDistance(point, PB);
  3690. end;
  3691. function PointSegmentClosestPoint(const point, segmentStart,
  3692. segmentStop: TGLVector): TGLVector;
  3693. var
  3694. W, lineDirection: TGLVector;
  3695. c1, c2, b: Single;
  3696. begin
  3697. lineDirection := VectorSubtract(segmentStop, segmentStart);
  3698. W := VectorSubtract(point, segmentStart);
  3699. c1 := VectorDotProduct(W, lineDirection);
  3700. c2 := VectorDotProduct(lineDirection, lineDirection);
  3701. b := ClampValue(c1 / c2, 0, 1);
  3702. VectorAdd(segmentStart, VectorScale(lineDirection, b), result);
  3703. end;
  3704. function PointSegmentClosestPoint(const point, segmentStart,
  3705. segmentStop: TAffineVector): TAffineVector;
  3706. var
  3707. W, lineDirection: TAffineVector;
  3708. c1, c2, b: Single;
  3709. begin
  3710. lineDirection := VectorSubtract(segmentStop, segmentStart);
  3711. W := VectorSubtract(point, segmentStart);
  3712. c1 := VectorDotProduct(W, lineDirection);
  3713. c2 := VectorDotProduct(lineDirection, lineDirection);
  3714. b := ClampValue(c1 / c2, 0, 1);
  3715. VectorAdd(segmentStart, VectorScale(lineDirection, b), result);
  3716. end;
  3717. function PointSegmentDistance(const point, segmentStart,
  3718. segmentStop: TAffineVector): Single;
  3719. var
  3720. PB: TAffineVector;
  3721. begin
  3722. PB := PointSegmentClosestPoint(point, segmentStart, segmentStop);
  3723. result := VectorDistance(point, PB);
  3724. end;
  3725. // http://geometryalgorithms.com/Archive/algorithm_0104/algorithm_0104B.htm
  3726. procedure SegmentSegmentClosestPoint(const S0Start, S0Stop, S1Start,
  3727. S1Stop: TAffineVector; var Segment0Closest, Segment1Closest: TAffineVector);
  3728. const
  3729. cSMALL_NUM = 0.000000001;
  3730. var
  3731. u, V, W: TAffineVector;
  3732. a, b, c, smalld, e, largeD, sc, sn, sD, tc, tN, tD: Single;
  3733. begin
  3734. VectorSubtract(S0Stop, S0Start, u);
  3735. VectorSubtract(S1Stop, S1Start, V);
  3736. VectorSubtract(S0Start, S1Start, W);
  3737. a := VectorDotProduct(u, u);
  3738. b := VectorDotProduct(u, V);
  3739. c := VectorDotProduct(V, V);
  3740. smalld := VectorDotProduct(u, W);
  3741. e := VectorDotProduct(V, W);
  3742. largeD := a * c - b * b;
  3743. sD := largeD;
  3744. tD := largeD;
  3745. if largeD < cSMALL_NUM then
  3746. begin
  3747. sn := 0.0;
  3748. sD := 1.0;
  3749. tN := e;
  3750. tD := c;
  3751. end
  3752. else
  3753. begin
  3754. sn := (b * e - c * smalld);
  3755. tN := (a * e - b * smalld);
  3756. if (sn < 0.0) then
  3757. begin
  3758. sn := 0.0;
  3759. tN := e;
  3760. tD := c;
  3761. end
  3762. else if (sn > sD) then
  3763. begin
  3764. sn := sD;
  3765. tN := e + b;
  3766. tD := c;
  3767. end;
  3768. end;
  3769. if (tN < 0.0) then
  3770. begin
  3771. tN := 0.0;
  3772. // recompute sc for this edge
  3773. if (-smalld < 0.0) then
  3774. sn := 0.0
  3775. else if (-smalld > a) then
  3776. sn := sD
  3777. else
  3778. begin
  3779. sn := -smalld;
  3780. sD := a;
  3781. end;
  3782. end
  3783. else if (tN > tD) then
  3784. begin
  3785. tN := tD;
  3786. // recompute sc for this edge
  3787. if ((-smalld + b) < 0.0) then
  3788. sn := 0
  3789. else if ((-smalld + b) > a) then
  3790. sn := sD
  3791. else
  3792. begin
  3793. sn := (-smalld + b);
  3794. sD := a;
  3795. end;
  3796. end;
  3797. // finally do the division to get sc and tc
  3798. // sc := (abs(sN) < SMALL_NUM ? 0.0 : sN / sD);
  3799. if Abs(sn) < cSMALL_NUM then
  3800. sc := 0
  3801. else
  3802. sc := sn / sD;
  3803. // tc := (abs(tN) < SMALL_NUM ? 0.0 : tN / tD);
  3804. if Abs(tN) < cSMALL_NUM then
  3805. tc := 0
  3806. else
  3807. tc := tN / tD;
  3808. // get the difference of the two closest points
  3809. // Vector dP = w + (sc * u) - (tc * v); // = S0(sc) - S1(tc)
  3810. Segment0Closest := VectorAdd(S0Start, VectorScale(u, sc));
  3811. Segment1Closest := VectorAdd(S1Start, VectorScale(V, tc));
  3812. end;
  3813. function SegmentSegmentDistance(const S0Start, S0Stop, S1Start,
  3814. S1Stop: TAffineVector): Single;
  3815. var
  3816. Pb0, PB1: TAffineVector;
  3817. begin
  3818. SegmentSegmentClosestPoint(S0Start, S0Stop, S1Start, S1Stop, Pb0, PB1);
  3819. result := VectorDistance(Pb0, PB1);
  3820. end;
  3821. function LineLineDistance(const linePt0, lineDir0, linePt1,
  3822. lineDir1: TAffineVector): Single;
  3823. const
  3824. cBIAS = 0.000000001;
  3825. var
  3826. det: Single;
  3827. begin
  3828. det := Abs((linePt1.X - linePt0.X) * (lineDir0.Y * lineDir1.Z -
  3829. lineDir1.Y * lineDir0.Z) - (linePt1.Y - linePt0.Y) *
  3830. (lineDir0.X * lineDir1.Z - lineDir1.X * lineDir0.Z) +
  3831. (linePt1.Z - linePt0.Z) * (lineDir0.X * lineDir1.Y -
  3832. lineDir1.X * lineDir0.Y));
  3833. if det < cBIAS then
  3834. result := PointLineDistance(linePt0, linePt1, lineDir1)
  3835. else
  3836. result := det / VectorLength(VectorCrossProduct(lineDir0, lineDir1));
  3837. end;
  3838. function QuaternionMake(const Imag: array of Single; Real: Single): TQuaternion;
  3839. var
  3840. n: Integer;
  3841. begin
  3842. n := Length(Imag);
  3843. if n >= 1 then
  3844. result.ImagPart.X := Imag[0];
  3845. if n >= 2 then
  3846. result.ImagPart.Y := Imag[1];
  3847. if n >= 3 then
  3848. result.ImagPart.Z := Imag[2];
  3849. result.RealPart := Real;
  3850. end;
  3851. function QuaternionMake(const X,Y,Z,W: Single): TQuaternion; overload;
  3852. begin
  3853. Result.X := X;
  3854. Result.Y := Y;
  3855. Result.Z := Z;
  3856. Result.W := W;
  3857. end;
  3858. function QuaternionMake(const V: TGLVector): TQuaternion; overload;
  3859. begin
  3860. Result.X := V.X;
  3861. Result.Y := V.Y;
  3862. Result.Z := V.Z;
  3863. Result.W := V.W;
  3864. end;
  3865. function QuaternionConjugate(const Q: TQuaternion): TQuaternion;
  3866. begin
  3867. result.ImagPart.X := -Q.ImagPart.X;
  3868. result.ImagPart.Y := -Q.ImagPart.Y;
  3869. result.ImagPart.Z := -Q.ImagPart.Z;
  3870. result.RealPart := Q.RealPart;
  3871. end;
  3872. function QuaternionMagnitude(const Q: TQuaternion): Single;
  3873. begin
  3874. result := Sqrt(VectorNorm(Q.ImagPart) + Sqr(Q.RealPart));
  3875. end;
  3876. procedure NormalizeQuaternion(var Q: TQuaternion);
  3877. var
  3878. M, f: Single;
  3879. begin
  3880. M := QuaternionMagnitude(Q);
  3881. if M > EPSILON2 then
  3882. begin
  3883. f := 1 / M;
  3884. ScaleVector(Q.ImagPart, f);
  3885. Q.RealPart := Q.RealPart * f;
  3886. end
  3887. else
  3888. Q := IdentityQuaternion;
  3889. end;
  3890. function QuaternionFromPoints(const V1, V2: TAffineVector): TQuaternion;
  3891. begin
  3892. result.ImagPart := VectorCrossProduct(V1, V2);
  3893. result.RealPart := Sqrt((VectorDotProduct(V1, V2) + 1) / 2);
  3894. end;
  3895. function QuaternionFromMatrix(const mat: TGLMatrix): TQuaternion;
  3896. // the matrix must be a rotation matrix!
  3897. var
  3898. traceMat, S, invS: Double;
  3899. begin
  3900. traceMat := 1 + mat.X.X + mat.Y.Y + mat.Z.Z;
  3901. if traceMat > EPSILON2 then
  3902. begin
  3903. S := Sqrt(traceMat) * 2;
  3904. invS := 1 / S;
  3905. result.ImagPart.X := (mat.Y.Z - mat.Z.Y) * invS;
  3906. result.ImagPart.Y := (mat.Z.X - mat.X.Z) * invS;
  3907. result.ImagPart.Z := (mat.X.Y - mat.Y.X) * invS;
  3908. result.RealPart := 0.25 * S;
  3909. end
  3910. else if (mat.X.X > mat.Y.Y) and (mat.X.X > mat.Z.Z)
  3911. then
  3912. begin // Row 0:
  3913. S := Sqrt(MaxFloat(EPSILON2, cOne + mat.X.X - mat.Y.Y -
  3914. mat.Z.Z)) * 2;
  3915. invS := 1 / S;
  3916. result.ImagPart.X := 0.25 * S;
  3917. result.ImagPart.Y := (mat.X.Y + mat.Y.X) * invS;
  3918. result.ImagPart.Z := (mat.Z.X + mat.X.Z) * invS;
  3919. result.RealPart := (mat.Y.Z - mat.Z.Y) * invS;
  3920. end
  3921. else if (mat.Y.Y > mat.Z.Z) then
  3922. begin // Row 1:
  3923. S := Sqrt(MaxFloat(EPSILON2, cOne + mat.Y.Y - mat.X.X -
  3924. mat.Z.Z)) * 2;
  3925. invS := 1 / S;
  3926. result.ImagPart.X := (mat.X.Y + mat.Y.X) * invS;
  3927. result.ImagPart.Y := 0.25 * S;
  3928. result.ImagPart.Z := (mat.Y.Z + mat.Z.Y) * invS;
  3929. result.RealPart := (mat.Z.X - mat.X.Z) * invS;
  3930. end
  3931. else
  3932. begin // Row 2:
  3933. S := Sqrt(MaxFloat(EPSILON2, cOne + mat.Z.Z - mat.X.X -
  3934. mat.Y.Y)) * 2;
  3935. invS := 1 / S;
  3936. result.ImagPart.X := (mat.Z.X + mat.X.Z) * invS;
  3937. result.ImagPart.Y := (mat.Y.Z + mat.Z.Y) * invS;
  3938. result.ImagPart.Z := 0.25 * S;
  3939. result.RealPart := (mat.X.Y - mat.Y.X) * invS;
  3940. end;
  3941. NormalizeQuaternion(result);
  3942. end;
  3943. function QuaternionMultiply(const qL, qR: TQuaternion): TQuaternion;
  3944. var
  3945. Temp: TQuaternion;
  3946. begin
  3947. Temp.RealPart := qL.RealPart * qR.RealPart - qL.ImagPart.V[X] * qR.ImagPart.V
  3948. [X] - qL.ImagPart.V[Y] * qR.ImagPart.V[Y] - qL.ImagPart.V[Z] *
  3949. qR.ImagPart.V[Z];
  3950. Temp.ImagPart.V[X] := qL.RealPart * qR.ImagPart.V[X] + qL.ImagPart.V[X] *
  3951. qR.RealPart + qL.ImagPart.V[Y] * qR.ImagPart.V[Z] - qL.ImagPart.V[Z] *
  3952. qR.ImagPart.V[Y];
  3953. Temp.ImagPart.V[Y] := qL.RealPart * qR.ImagPart.V[Y] + qL.ImagPart.V[Y] *
  3954. qR.RealPart + qL.ImagPart.V[Z] * qR.ImagPart.V[X] - qL.ImagPart.V[X] *
  3955. qR.ImagPart.V[Z];
  3956. Temp.ImagPart.V[Z] := qL.RealPart * qR.ImagPart.V[Z] + qL.ImagPart.V[Z] *
  3957. qR.RealPart + qL.ImagPart.V[X] * qR.ImagPart.V[Y] - qL.ImagPart.V[Y] *
  3958. qR.ImagPart.V[X];
  3959. result := Temp;
  3960. end;
  3961. function QuaternionToMatrix(quat: TQuaternion): TGLMatrix;
  3962. var
  3963. W, X, Y, Z, xx, xy, xz, xw, yy, yz, yw, zz, zw: Single;
  3964. begin
  3965. NormalizeQuaternion(quat);
  3966. W := quat.RealPart;
  3967. X := quat.ImagPart.X;
  3968. Y := quat.ImagPart.Y;
  3969. Z := quat.ImagPart.Z;
  3970. xx := X * X;
  3971. xy := X * Y;
  3972. xz := X * Z;
  3973. xw := X * W;
  3974. yy := Y * Y;
  3975. yz := Y * Z;
  3976. yw := Y * W;
  3977. zz := Z * Z;
  3978. zw := Z * W;
  3979. result.X.X := 1 - 2 * (yy + zz);
  3980. result.Y.X := 2 * (xy - zw);
  3981. result.Z.X := 2 * (xz + yw);
  3982. result.W.X := 0;
  3983. result.X.Y := 2 * (xy + zw);
  3984. result.Y.Y := 1 - 2 * (xx + zz);
  3985. result.Z.Y := 2 * (yz - xw);
  3986. result.W.Y := 0;
  3987. result.X.Z := 2 * (xz - yw);
  3988. result.Y.Z := 2 * (yz + xw);
  3989. result.Z.Z := 1 - 2 * (xx + yy);
  3990. result.W.Z := 0;
  3991. result.X.W := 0;
  3992. result.Y.W := 0;
  3993. result.Z.W := 0;
  3994. result.W.W := 1;
  3995. end;
  3996. function QuaternionToAffineMatrix(quat: TQuaternion): TAffineMatrix;
  3997. var
  3998. W, X, Y, Z, xx, xy, xz, xw, yy, yz, yw, zz, zw: Single;
  3999. begin
  4000. NormalizeQuaternion(quat);
  4001. W := quat.RealPart;
  4002. X := quat.ImagPart.X;
  4003. Y := quat.ImagPart.Y;
  4004. Z := quat.ImagPart.Z;
  4005. xx := X * X;
  4006. xy := X * Y;
  4007. xz := X * Z;
  4008. xw := X * W;
  4009. yy := Y * Y;
  4010. yz := Y * Z;
  4011. yw := Y * W;
  4012. zz := Z * Z;
  4013. zw := Z * W;
  4014. result.X.X := 1 - 2 * (yy + zz);
  4015. result.Y.X := 2 * (xy - zw);
  4016. result.Z.X := 2 * (xz + yw);
  4017. result.X.Y := 2 * (xy + zw);
  4018. result.Y.Y := 1 - 2 * (xx + zz);
  4019. result.Z.Y := 2 * (yz - xw);
  4020. result.X.Z := 2 * (xz - yw);
  4021. result.Y.Z := 2 * (yz + xw);
  4022. result.Z.Z := 1 - 2 * (xx + yy);
  4023. end;
  4024. function QuaternionFromAngleAxis(const angle: Single; const axis: TAffineVector)
  4025. : TQuaternion;
  4026. var
  4027. f, S, c: Single;
  4028. begin
  4029. SinCosine(DegToRadian(angle * cOneDotFive), S, c);
  4030. result.RealPart := c;
  4031. f := S / VectorLength(axis);
  4032. result.ImagPart.X := axis.X * f;
  4033. result.ImagPart.Y := axis.Y * f;
  4034. result.ImagPart.Z := axis.Z * f;
  4035. end;
  4036. function QuaternionFromRollPitchYaw(const r, p, Y: Single): TQuaternion;
  4037. var
  4038. qp, qy: TQuaternion;
  4039. begin
  4040. result := QuaternionFromAngleAxis(r, ZVector);
  4041. qp := QuaternionFromAngleAxis(p, XVector);
  4042. qy := QuaternionFromAngleAxis(Y, YVector);
  4043. result := QuaternionMultiply(qp, result);
  4044. result := QuaternionMultiply(qy, result);
  4045. end;
  4046. function QuaternionFromEuler(const X, Y, Z: Single; eulerOrder: TEulerOrder): TQuaternion;
  4047. // input angles in degrees
  4048. var
  4049. gimbalLock: Boolean;
  4050. quat1, quat2: TQuaternion;
  4051. function EulerToQuat(const X, Y, Z: Single; eulerOrder: TEulerOrder)
  4052. : TQuaternion;
  4053. const
  4054. cOrder: array [Low(TEulerOrder) .. High(TEulerOrder)] of array [1 .. 3]
  4055. of Byte = ((1, 2, 3), (1, 3, 2), (2, 1, 3), // eulXYZ, eulXZY, eulYXZ,
  4056. (3, 1, 2), (2, 3, 1), (3, 2, 1)); // eulYZX, eulZXY, eulZYX
  4057. var
  4058. Q: array [1 .. 3] of TQuaternion;
  4059. begin
  4060. Q[cOrder[eulerOrder][1]] := QuaternionFromAngleAxis(X, XVector);
  4061. Q[cOrder[eulerOrder][2]] := QuaternionFromAngleAxis(Y, YVector);
  4062. Q[cOrder[eulerOrder][3]] := QuaternionFromAngleAxis(Z, ZVector);
  4063. result := QuaternionMultiply(Q[2], Q[3]);
  4064. result := QuaternionMultiply(Q[1], result);
  4065. end;
  4066. const
  4067. SMALL_ANGLE = 0.001;
  4068. begin
  4069. NormalizeDegAngle(X);
  4070. NormalizeDegAngle(Y);
  4071. NormalizeDegAngle(Z);
  4072. case eulerOrder of
  4073. eulXYZ, eulZYX:
  4074. gimbalLock := Abs(Abs(Y) - 90.0) <= EPSILON2; // cos(Y) = 0;
  4075. eulYXZ, eulZXY:
  4076. gimbalLock := Abs(Abs(X) - 90.0) <= EPSILON2; // cos(X) = 0;
  4077. eulXZY, eulYZX:
  4078. gimbalLock := Abs(Abs(Z) - 90.0) <= EPSILON2; // cos(Z) = 0;
  4079. else
  4080. Assert(False);
  4081. gimbalLock := False;
  4082. end;
  4083. if gimbalLock then
  4084. begin
  4085. case eulerOrder of
  4086. eulXYZ, eulZYX:
  4087. quat1 := EulerToQuat(X, Y - SMALL_ANGLE, Z, eulerOrder);
  4088. eulYXZ, eulZXY:
  4089. quat1 := EulerToQuat(X - SMALL_ANGLE, Y, Z, eulerOrder);
  4090. eulXZY, eulYZX:
  4091. quat1 := EulerToQuat(X, Y, Z - SMALL_ANGLE, eulerOrder);
  4092. end;
  4093. case eulerOrder of
  4094. eulXYZ, eulZYX:
  4095. quat2 := EulerToQuat(X, Y + SMALL_ANGLE, Z, eulerOrder);
  4096. eulYXZ, eulZXY:
  4097. quat2 := EulerToQuat(X + SMALL_ANGLE, Y, Z, eulerOrder);
  4098. eulXZY, eulYZX:
  4099. quat2 := EulerToQuat(X, Y, Z + SMALL_ANGLE, eulerOrder);
  4100. end;
  4101. result := QuaternionSlerp(quat1, quat2, 0.5);
  4102. end
  4103. else
  4104. begin
  4105. result := EulerToQuat(X, Y, Z, eulerOrder);
  4106. end;
  4107. end;
  4108. procedure QuaternionToPoints(const Q: TQuaternion;
  4109. var ArcFrom, ArcTo: TAffineVector);
  4110. var
  4111. S, invS: Single;
  4112. begin
  4113. S := Q.ImagPart.V[X] * Q.ImagPart.V[X] + Q.ImagPart.V[Y] * Q.ImagPart.V[Y];
  4114. if S = 0 then
  4115. SetAffineVector(ArcFrom, 0, 1, 0)
  4116. else
  4117. begin
  4118. invS := RSqrt(S);
  4119. SetAffineVector(ArcFrom, -Q.ImagPart.V[Y] * invS,
  4120. Q.ImagPart.V[X] * invS, 0);
  4121. end;
  4122. ArcTo.V[X] := Q.RealPart * ArcFrom.V[X] - Q.ImagPart.V[Z] * ArcFrom.V[Y];
  4123. ArcTo.V[Y] := Q.RealPart * ArcFrom.V[Y] + Q.ImagPart.V[Z] * ArcFrom.V[X];
  4124. ArcTo.V[Z] := Q.ImagPart.V[X] * ArcFrom.V[Y] - Q.ImagPart.V[Y] * ArcFrom.V[X];
  4125. if Q.RealPart < 0 then
  4126. SetAffineVector(ArcFrom, -ArcFrom.V[X], -ArcFrom.V[Y], 0);
  4127. end;
  4128. function Logarithm2(const X: Single): Single;
  4129. begin
  4130. result := Log2(X);
  4131. end;
  4132. function PowerSingle(const Base, Exponent: Single): Single;
  4133. begin
  4134. {$HINTS OFF}
  4135. if Exponent = cZero then
  4136. result := cOne
  4137. else if (Base = cZero) and (Exponent > cZero) then
  4138. result := cZero
  4139. else if RoundInt(Exponent) = Exponent then
  4140. result := Power(Base, Integer(Round(Exponent)))
  4141. else
  4142. result := Exp(Exponent * Ln(Base));
  4143. {$HINTS ON}
  4144. end;
  4145. function PowerInteger(Base: Single; Exponent: Integer): Single;
  4146. begin
  4147. {$HINTS OFF}
  4148. result := Power(Base, Exponent);
  4149. {$HINTS ON}
  4150. end;
  4151. function PowerInt64(Base: Single; Exponent: Int64): Single;
  4152. begin
  4153. {$HINTS OFF}
  4154. result := System.Math.Power(Base, Exponent);
  4155. {$HINTS ON}
  4156. end;
  4157. function DegToRadian(const Degrees: Extended): Extended;
  4158. begin
  4159. result := Degrees * (PI / 180);
  4160. end;
  4161. function DegToRadian(const Degrees: Single): Single;
  4162. begin
  4163. result := Degrees * cPIdiv180;
  4164. end;
  4165. function RadianToDeg(const Radians: Extended): Extended;
  4166. begin
  4167. result := Radians * (180 / PI);
  4168. end;
  4169. function RadianToDeg(const Radians: Single): Single;
  4170. begin
  4171. result := Radians * c180divPI;
  4172. end;
  4173. function NormalizeAngle(angle: Single): Single;
  4174. begin
  4175. result := angle - Int(angle * cInv2PI) * c2PI;
  4176. if result > PI then
  4177. result := result - 2 * PI
  4178. else if result < -PI then
  4179. result := result + 2 * PI;
  4180. end;
  4181. function NormalizeDegAngle(angle: Single): Single;
  4182. begin
  4183. result := angle - Int(angle * cInv360) * c360;
  4184. if result > c180 then
  4185. result := result - c360
  4186. else if result < -c180 then
  4187. result := result + c360;
  4188. end;
  4189. {$IFDEF USE_PLATFORM_HAS_EXTENDED}
  4190. procedure SinCosine(const Theta: Extended; out Sin, Cos: Extended);
  4191. begin
  4192. Math.SinCos(Theta, Sin, Cos);
  4193. end;
  4194. {$ENDIF GLS_PLATFORM_HAS_EXTENDED}
  4195. procedure SinCosine(const Theta: Double; out Sin, Cos: Double);
  4196. var
  4197. S, c: Extended;
  4198. begin
  4199. SinCos(Theta, S, c);
  4200. {$HINTS OFF}
  4201. Sin := S;
  4202. Cos := c;
  4203. {$HINTS ON}
  4204. end;
  4205. procedure SinCosine(const Theta: Single; out Sin, Cos: Single);
  4206. var
  4207. S, c: Extended;
  4208. begin
  4209. SinCos(Theta, S, c);
  4210. {$HINTS OFF}
  4211. Sin := S;
  4212. Cos := c;
  4213. {$HINTS ON}
  4214. end;
  4215. {$IFDEF USE_PLATFORM_HAS_EXTENDED}
  4216. procedure SinCosine(const Theta, radius: Double; out Sin, Cos: Extended);
  4217. var
  4218. S, c: Extended;
  4219. begin
  4220. SinCos(Theta, S, c);
  4221. Sin := S * radius;
  4222. Cos := c * radius;
  4223. end;
  4224. {$ENDIF GLS_PLATFORM_HAS_EXTENDED}
  4225. procedure SinCosine(const Theta, radius: Double; out Sin, Cos: Double);
  4226. var
  4227. S, c: Extended;
  4228. begin
  4229. SinCos(Theta, S, c);
  4230. Sin := S * radius;
  4231. Cos := c * radius;
  4232. end;
  4233. procedure SinCosine(const Theta, radius: Single; out Sin, Cos: Single);
  4234. var
  4235. S, c: Extended;
  4236. begin
  4237. SinCos(Theta, S, c);
  4238. Sin := S * radius;
  4239. Cos := c * radius;
  4240. end;
  4241. procedure PrepareSinCosCache(var S, c: array of Single;
  4242. startAngle, stopAngle: Single);
  4243. var
  4244. i: Integer;
  4245. d, alpha, beta: Single;
  4246. begin
  4247. Assert((High(S) = High(c)) and (Low(S) = Low(c)));
  4248. stopAngle := stopAngle + 1E-5;
  4249. if High(S) > Low(S) then
  4250. d := cPIdiv180 * (stopAngle - startAngle) / (High(S) - Low(S))
  4251. else
  4252. d := 0;
  4253. if High(S) - Low(S) < 1000 then
  4254. begin
  4255. // Fast computation (approx 5.5x)
  4256. alpha := 2 * Sqr(Sin(d * 0.5));
  4257. beta := Sin(d);
  4258. SinCos(startAngle * cPIdiv180, S[Low(S)], c[Low(S)]);
  4259. for i := Low(S) to High(S) - 1 do
  4260. begin
  4261. // Make use of the incremental formulae:
  4262. // cos (theta+delta) = cos(theta) - [alpha*cos(theta) + beta*sin(theta)]
  4263. // sin (theta+delta) = sin(theta) - [alpha*sin(theta) - beta*cos(theta)]
  4264. c[i + 1] := c[i] - alpha * c[i] - beta * S[i];
  4265. S[i + 1] := S[i] - alpha * S[i] + beta * c[i];
  4266. end;
  4267. end
  4268. else
  4269. begin
  4270. // Slower, but maintains precision when steps are small
  4271. startAngle := startAngle * cPIdiv180;
  4272. for i := Low(S) to High(S) do
  4273. SinCos((i - Low(S)) * d + startAngle, S[i], c[i]);
  4274. end;
  4275. end;
  4276. function ArcCosine(const X: Extended): Extended; overload;
  4277. begin
  4278. {$HINTS OFF}
  4279. result := ArcCos(X);
  4280. {$HINTS ON}
  4281. end;
  4282. function ArcSinus(const X: Extended): Extended; overload;
  4283. begin
  4284. {$HINTS OFF}
  4285. result := ArcSin(X);
  4286. {$HINTS ON}
  4287. end;
  4288. function FastArcTangent2(Y, X: Single): Single;
  4289. // accuracy of about 0.07 rads
  4290. const
  4291. cEpsilon: Single = 1E-10;
  4292. var
  4293. abs_y: Single;
  4294. begin
  4295. abs_y := Abs(Y) + cEpsilon; // prevent 0/0 condition
  4296. if Y < 0 then
  4297. begin
  4298. if X >= 0 then
  4299. result := cPIdiv4 * (X - abs_y) / (X + abs_y) - cPIdiv4
  4300. else
  4301. result := cPIdiv4 * (X + abs_y) / (abs_y - X) - c3PIdiv4;
  4302. end
  4303. else
  4304. begin
  4305. if X >= 0 then
  4306. result := cPIdiv4 - cPIdiv4 * (X - abs_y) / (X + abs_y)
  4307. else
  4308. result := c3PIdiv4 - cPIdiv4 * (X + abs_y) / (abs_y - X);
  4309. end;
  4310. end;
  4311. function ISqrt(i: Integer): Integer;
  4312. begin
  4313. {$HINTS OFF}
  4314. result := Round(Sqrt(i));
  4315. {$HINTS ON}
  4316. end;
  4317. function ILength(X, Y: Integer): Integer;
  4318. begin
  4319. {$HINTS OFF}
  4320. result := Round(Sqrt(X * X + Y * Y));
  4321. {$HINTS ON}
  4322. end;
  4323. function ILength(X, Y, Z: Integer): Integer;
  4324. begin
  4325. {$HINTS OFF}
  4326. result := Round(Sqrt(X * X + Y * Y + Z * Z));
  4327. {$HINTS ON}
  4328. end;
  4329. function RLength(X, Y: Single): Single;
  4330. begin
  4331. result := 1 / Sqrt(X * X + Y * Y);
  4332. end;
  4333. procedure RandomPointOnSphere(var p: TAffineVector);
  4334. var
  4335. T, W: Single;
  4336. begin
  4337. p.Z := 2 * Random - 1;
  4338. T := 2 * PI * Random;
  4339. W := Sqrt(1 - p.Z * p.Z);
  4340. SinCosine(T, W, p.Y, p.X);
  4341. end;
  4342. function RoundInt(V: Single): Single;
  4343. begin
  4344. {$HINTS OFF}
  4345. result := Int(V + 0.5);
  4346. {$HINTS ON}
  4347. end;
  4348. function RoundInt(V: Extended): Extended;
  4349. begin
  4350. result := Int(V + 0.5);
  4351. end;
  4352. function SignStrict(X: Single): Integer;
  4353. begin
  4354. if X < 0 then
  4355. result := -1
  4356. else
  4357. result := 1
  4358. end;
  4359. function ScaleAndRound(i: Integer; var S: Single): Integer;
  4360. begin
  4361. {$HINTS OFF}
  4362. result := Round(i * S);
  4363. {$HINTS ON}
  4364. end;
  4365. function IsInRange(const X, a, b: Single): Boolean;
  4366. begin
  4367. if a < b then
  4368. result := (a <= X) and (X <= b)
  4369. else
  4370. result := (b <= X) and (X <= a);
  4371. end;
  4372. function IsInRange(const X, a, b: Double): Boolean;
  4373. begin
  4374. if a < b then
  4375. result := (a <= X) and (X <= b)
  4376. else
  4377. result := (b <= X) and (X <= a);
  4378. end;
  4379. function IsInCube(const p, d: TAffineVector): Boolean; overload;
  4380. begin
  4381. result := ((p.X >= -d.X) and (p.X <= d.X)) and
  4382. ((p.Y >= -d.Y) and (p.Y <= d.Y)) and
  4383. ((p.Z >= -d.Z) and (p.Z <= d.Z));
  4384. end;
  4385. function IsInCube(const p, d: TGLVector): Boolean; overload;
  4386. begin
  4387. result := ((p.X >= -d.X) and (p.X <= d.X)) and
  4388. ((p.Y >= -d.Y) and (p.Y <= d.Y)) and
  4389. ((p.Z >= -d.Z) and (p.Z <= d.Z));
  4390. end;
  4391. function MinFloat(values: PSingleArray; nbItems: Integer): Single;
  4392. var
  4393. i, k: Integer;
  4394. begin
  4395. if nbItems > 0 then
  4396. begin
  4397. k := 0;
  4398. for i := 1 to nbItems - 1 do
  4399. if values^[i] < values^[k] then
  4400. k := i;
  4401. result := values^[k];
  4402. end
  4403. else
  4404. result := 0;
  4405. end;
  4406. function MinFloat(values: PDoubleArray; nbItems: Integer): Double;
  4407. var
  4408. i, k: Integer;
  4409. begin
  4410. if nbItems > 0 then
  4411. begin
  4412. k := 0;
  4413. for i := 1 to nbItems - 1 do
  4414. if values^[i] < values^[k] then
  4415. k := i;
  4416. result := values^[k];
  4417. end
  4418. else
  4419. result := 0;
  4420. end;
  4421. function MinFloat(values: PExtendedArray; nbItems: Integer): Extended;
  4422. var
  4423. i, k: Integer;
  4424. begin
  4425. if nbItems > 0 then
  4426. begin
  4427. k := 0;
  4428. for i := 1 to nbItems - 1 do
  4429. if values^[i] < values^[k] then
  4430. k := i;
  4431. result := values^[k];
  4432. end
  4433. else
  4434. result := 0;
  4435. end;
  4436. function MinFloat(const V: array of Single): Single;
  4437. var
  4438. i: Integer;
  4439. begin
  4440. if Length(V) > 0 then
  4441. begin
  4442. result := V[0];
  4443. for i := 1 to High(V) do
  4444. if V[i] < result then
  4445. result := V[i];
  4446. end
  4447. else
  4448. result := 0;
  4449. end;
  4450. function MinFloat(const V1, V2: Single): Single;
  4451. begin
  4452. if V1 < V2 then
  4453. result := V1
  4454. else
  4455. result := V2;
  4456. end;
  4457. function MinFloat(const V1, V2: Double): Double;
  4458. begin
  4459. if V1 < V2 then
  4460. result := V1
  4461. else
  4462. result := V2;
  4463. end;
  4464. function MinFloat(const V1, V2: Extended): Extended; overload;
  4465. begin
  4466. if V1 < V2 then
  4467. result := V1
  4468. else
  4469. result := V2;
  4470. end;
  4471. function MinFloat(const V1, V2, V3: Single): Single;
  4472. begin
  4473. if V1 <= V2 then
  4474. if V1 <= V3 then
  4475. result := V1
  4476. else if V3 <= V2 then
  4477. result := V3
  4478. else
  4479. result := V2
  4480. else if V2 <= V3 then
  4481. result := V2
  4482. else if V3 <= V1 then
  4483. result := V3
  4484. else
  4485. result := V1;
  4486. end;
  4487. function MinFloat(const V1, V2, V3: Double): Double;
  4488. begin
  4489. if V1 <= V2 then
  4490. if V1 <= V3 then
  4491. result := V1
  4492. else if V3 <= V2 then
  4493. result := V3
  4494. else
  4495. result := V2
  4496. else if V2 <= V3 then
  4497. result := V2
  4498. else if V3 <= V1 then
  4499. result := V3
  4500. else
  4501. result := V1;
  4502. end;
  4503. function MinFloat(const V1, V2, V3: Extended): Extended; overload;
  4504. begin
  4505. if V1 <= V2 then
  4506. if V1 <= V3 then
  4507. result := V1
  4508. else if V3 <= V2 then
  4509. result := V3
  4510. else
  4511. result := V2
  4512. else if V2 <= V3 then
  4513. result := V2
  4514. else if V3 <= V1 then
  4515. result := V3
  4516. else
  4517. result := V1;
  4518. end;
  4519. function MaxFloat(values: PSingleArray; nbItems: Integer): Single; overload;
  4520. var
  4521. i, k: Integer;
  4522. begin
  4523. if nbItems > 0 then
  4524. begin
  4525. k := 0;
  4526. for i := 1 to nbItems - 1 do
  4527. if values^[i] > values^[k] then
  4528. k := i;
  4529. result := values^[k];
  4530. end
  4531. else
  4532. result := 0;
  4533. end;
  4534. function MaxFloat(values: PDoubleArray; nbItems: Integer): Double; overload;
  4535. var
  4536. i, k: Integer;
  4537. begin
  4538. if nbItems > 0 then
  4539. begin
  4540. k := 0;
  4541. for i := 1 to nbItems - 1 do
  4542. if values^[i] > values^[k] then
  4543. k := i;
  4544. result := values^[k];
  4545. end
  4546. else
  4547. result := 0;
  4548. end;
  4549. function MaxFloat(values: PExtendedArray; nbItems: Integer): Extended; overload;
  4550. var
  4551. i, k: Integer;
  4552. begin
  4553. if nbItems > 0 then
  4554. begin
  4555. k := 0;
  4556. for i := 1 to nbItems - 1 do
  4557. if values^[i] > values^[k] then
  4558. k := i;
  4559. result := values^[k];
  4560. end
  4561. else
  4562. result := 0;
  4563. end;
  4564. function MaxFloat(const V: array of Single): Single;
  4565. var
  4566. i: Integer;
  4567. begin
  4568. if Length(V) > 0 then
  4569. begin
  4570. result := V[0];
  4571. for i := 1 to High(V) do
  4572. if V[i] > result then
  4573. result := V[i];
  4574. end
  4575. else
  4576. result := 0;
  4577. end;
  4578. function MaxFloat(const V1, V2: Single): Single;
  4579. begin
  4580. if V1 > V2 then
  4581. result := V1
  4582. else
  4583. result := V2;
  4584. end;
  4585. function MaxFloat(const V1, V2: Double): Double;
  4586. begin
  4587. if V1 > V2 then
  4588. result := V1
  4589. else
  4590. result := V2;
  4591. end;
  4592. function MaxFloat(const V1, V2: Extended): Extended; overload;
  4593. begin
  4594. if V1 > V2 then
  4595. result := V1
  4596. else
  4597. result := V2;
  4598. end;
  4599. function MaxFloat(const V1, V2, V3: Single): Single;
  4600. begin
  4601. if V1 >= V2 then
  4602. if V1 >= V3 then
  4603. result := V1
  4604. else if V3 >= V2 then
  4605. result := V3
  4606. else
  4607. result := V2
  4608. else if V2 >= V3 then
  4609. result := V2
  4610. else if V3 >= V1 then
  4611. result := V3
  4612. else
  4613. result := V1;
  4614. end;
  4615. function MaxFloat(const V1, V2, V3: Double): Double;
  4616. begin
  4617. if V1 >= V2 then
  4618. if V1 >= V3 then
  4619. result := V1
  4620. else if V3 >= V2 then
  4621. result := V3
  4622. else
  4623. result := V2
  4624. else if V2 >= V3 then
  4625. result := V2
  4626. else if V3 >= V1 then
  4627. result := V3
  4628. else
  4629. result := V1;
  4630. end;
  4631. function MaxFloat(const V1, V2, V3: Extended): Extended; overload;
  4632. begin
  4633. if V1 >= V2 then
  4634. if V1 >= V3 then
  4635. result := V1
  4636. else if V3 >= V2 then
  4637. result := V3
  4638. else
  4639. result := V2
  4640. else if V2 >= V3 then
  4641. result := V2
  4642. else if V3 >= V1 then
  4643. result := V3
  4644. else
  4645. result := V1;
  4646. end;
  4647. function MinInteger(const V1, V2: Integer): Integer;
  4648. begin
  4649. if V1 < V2 then
  4650. result := V1
  4651. else
  4652. result := V2;
  4653. end;
  4654. function MinInteger(const V1, V2: Cardinal): Cardinal;
  4655. begin
  4656. if V1 < V2 then
  4657. result := V1
  4658. else
  4659. result := V2;
  4660. end;
  4661. function MinInteger(const V1, V2, V3: Integer): Integer;
  4662. begin
  4663. if V1 <= V2 then
  4664. if V1 <= V3 then
  4665. result := V1
  4666. else if V3 <= V2 then
  4667. result := V3
  4668. else
  4669. result := V2
  4670. else if V2 <= V3 then
  4671. result := V2
  4672. else if V3 <= V1 then
  4673. result := V3
  4674. else
  4675. result := V1;
  4676. end;
  4677. function MinInteger(const V1, V2, V3: Cardinal): Cardinal;
  4678. begin
  4679. if V1 <= V2 then
  4680. if V1 <= V3 then
  4681. result := V1
  4682. else if V3 <= V2 then
  4683. result := V3
  4684. else
  4685. result := V2
  4686. else if V2 <= V3 then
  4687. result := V2
  4688. else if V3 <= V1 then
  4689. result := V3
  4690. else
  4691. result := V1;
  4692. end;
  4693. function MaxInteger(const V1, V2: Integer): Integer;
  4694. begin
  4695. if V1 > V2 then
  4696. result := V1
  4697. else
  4698. result := V2;
  4699. end;
  4700. function MaxInteger(const V1, V2: Cardinal): Cardinal;
  4701. begin
  4702. if V1 > V2 then
  4703. result := V1
  4704. else
  4705. result := V2;
  4706. end;
  4707. function MaxInteger(const V1, V2, V3: Integer): Integer;
  4708. begin
  4709. if V1 >= V2 then
  4710. if V1 >= V3 then
  4711. result := V1
  4712. else if V3 >= V2 then
  4713. result := V3
  4714. else
  4715. result := V2
  4716. else if V2 >= V3 then
  4717. result := V2
  4718. else if V3 >= V1 then
  4719. result := V3
  4720. else
  4721. result := V1;
  4722. end;
  4723. function MaxInteger(const V1, V2, V3: Cardinal): Cardinal;
  4724. begin
  4725. if V1 >= V2 then
  4726. if V1 >= V3 then
  4727. result := V1
  4728. else if V3 >= V2 then
  4729. result := V3
  4730. else
  4731. result := V2
  4732. else if V2 >= V3 then
  4733. result := V2
  4734. else if V3 >= V1 then
  4735. result := V3
  4736. else
  4737. result := V1;
  4738. end;
  4739. function ClampInteger(const value, min, max: Integer): Integer;
  4740. begin
  4741. result := MinInteger(MaxInteger(value, min), max);
  4742. end;
  4743. function ClampInteger(const value, min, max: Cardinal): Cardinal;
  4744. begin
  4745. result := MinInteger(MaxInteger(value, min), max);
  4746. end;
  4747. function TriangleArea(const p1, p2, p3: TAffineVector): Single;
  4748. begin
  4749. result := 0.5 * VectorLength(VectorCrossProduct(VectorSubtract(p2, p1),
  4750. VectorSubtract(p3, p1)));
  4751. end;
  4752. function PolygonArea(const p: PAffineVectorArray; nSides: Integer): Single;
  4753. var
  4754. r: TAffineVector;
  4755. i: Integer;
  4756. p1, p2, p3: PAffineVector;
  4757. begin
  4758. result := 0;
  4759. if nSides > 2 then
  4760. begin
  4761. RstVector(r);
  4762. p1 := @p[0];
  4763. p2 := @p[1];
  4764. for i := 2 to nSides - 1 do
  4765. begin
  4766. p3 := @p[i];
  4767. AddVector(r, VectorCrossProduct(VectorSubtract(p2^, p1^),
  4768. VectorSubtract(p3^, p1^)));
  4769. p2 := p3;
  4770. end;
  4771. result := VectorLength(r) * 0.5;
  4772. end;
  4773. end;
  4774. function TriangleSignedArea(const p1, p2, p3: TAffineVector): Single;
  4775. begin
  4776. result := 0.5 * ((p2.X - p1.X) * (p3.Y - p1.Y) -
  4777. (p3.X - p1.X) * (p2.Y - p1.Y));
  4778. end;
  4779. function PolygonSignedArea(const p: PAffineVectorArray;
  4780. nSides: Integer): Single;
  4781. var
  4782. i: Integer;
  4783. p1, p2, p3: PAffineVector;
  4784. begin
  4785. result := 0;
  4786. if nSides > 2 then
  4787. begin
  4788. p1 := @(p^[0]);
  4789. p2 := @(p^[1]);
  4790. for i := 2 to nSides - 1 do
  4791. begin
  4792. p3 := @(p^[i]);
  4793. result := result + (p2^.X - p1^.X) * (p3^.Y - p1^.Y) -
  4794. (p3^.X - p1^.X) * (p2^.Y - p1^.Y);
  4795. p2 := p3;
  4796. end;
  4797. result := result * 0.5;
  4798. end;
  4799. end;
  4800. procedure ScaleFloatArray(values: PSingleArray; nb: Integer;
  4801. var factor: Single);
  4802. var
  4803. i: Integer;
  4804. begin
  4805. for i := 0 to nb - 1 do
  4806. values^[i] := values^[i] * factor;
  4807. end;
  4808. procedure ScaleFloatArray(var values: TSingleArray; factor: Single);
  4809. begin
  4810. if Length(values) > 0 then
  4811. ScaleFloatArray(@values[0], Length(values), factor);
  4812. end;
  4813. procedure OffsetFloatArray(values: PSingleArray; nb: Integer;
  4814. var delta: Single);
  4815. var
  4816. i: Integer;
  4817. begin
  4818. for i := 0 to nb - 1 do
  4819. values^[i] := values^[i] + delta;
  4820. end;
  4821. procedure OffsetFloatArray(var values: array of Single; delta: Single);
  4822. begin
  4823. if Length(values) > 0 then
  4824. ScaleFloatArray(@values[0], Length(values), delta);
  4825. end;
  4826. procedure OffsetFloatArray(valuesDest, valuesDelta: PSingleArray; nb: Integer);
  4827. var
  4828. i: Integer;
  4829. begin
  4830. for i := 0 to nb - 1 do
  4831. valuesDest^[i] := valuesDest^[i] + valuesDelta^[i];
  4832. end;
  4833. function MaxXYZComponent(const V: TGLVector): Single; overload;
  4834. begin
  4835. result := MaxFloat(V.X, V.Y, V.Z);
  4836. end;
  4837. function MaxXYZComponent(const V: TAffineVector): Single; overload;
  4838. begin
  4839. result := MaxFloat(V.X, V.Y, V.Z);
  4840. end;
  4841. function MinXYZComponent(const V: TGLVector): Single; overload;
  4842. begin
  4843. if V.X <= V.Y then
  4844. if V.X <= V.Z then
  4845. result := V.X
  4846. else if V.Z <= V.Y then
  4847. result := V.Z
  4848. else
  4849. result := V.Y
  4850. else if V.Y <= V.Z then
  4851. result := V.Y
  4852. else if V.Z <= V.X then
  4853. result := V.Z
  4854. else
  4855. result := V.X;
  4856. end;
  4857. function MinXYZComponent(const V: TAffineVector): Single; overload;
  4858. begin
  4859. result := MinFloat(V.X, V.Y, V.Z);
  4860. end;
  4861. function MaxAbsXYZComponent(V: TGLVector): Single;
  4862. begin
  4863. AbsVector(V);
  4864. result := MaxXYZComponent(V);
  4865. end;
  4866. function MinAbsXYZComponent(V: TGLVector): Single;
  4867. begin
  4868. AbsVector(V);
  4869. result := MinXYZComponent(V);
  4870. end;
  4871. procedure MaxVector(var V: TGLVector; const V1: TGLVector);
  4872. begin
  4873. if V1.X > V.X then
  4874. V.X := V1.X;
  4875. if V1.Y > V.Y then
  4876. V.Y := V1.Y;
  4877. if V1.Z > V.Z then
  4878. V.Z := V1.Z;
  4879. if V1.W > V.W then
  4880. V.W := V1.W;
  4881. end;
  4882. procedure MaxVector(var V: TAffineVector; const V1: TAffineVector); overload;
  4883. begin
  4884. if V1.X > V.X then
  4885. V.X := V1.X;
  4886. if V1.Y > V.Y then
  4887. V.Y := V1.Y;
  4888. if V1.Z > V.Z then
  4889. V.Z := V1.Z;
  4890. end;
  4891. procedure MinVector(var V: TGLVector; const V1: TGLVector);
  4892. begin
  4893. if V1.X < V.X then
  4894. V.X := V1.X;
  4895. if V1.Y < V.Y then
  4896. V.Y := V1.Y;
  4897. if V1.Z < V.Z then
  4898. V.Z := V1.Z;
  4899. if V1.W < V.W then
  4900. V.W := V1.W;
  4901. end;
  4902. procedure MinVector(var V: TAffineVector; const V1: TAffineVector);
  4903. begin
  4904. if V1.X < V.X then
  4905. V.X := V1.X;
  4906. if V1.Y < V.Y then
  4907. V.Y := V1.Y;
  4908. if V1.Z < V.Z then
  4909. V.Z := V1.Z;
  4910. end;
  4911. procedure SortArrayAscending(var a: array of Extended);
  4912. var
  4913. i, J, M: Integer;
  4914. buf: Extended;
  4915. begin
  4916. for i := Low(a) to High(a) - 1 do
  4917. begin
  4918. M := i;
  4919. for J := i + 1 to High(a) do
  4920. if a[J] < a[M] then
  4921. M := J;
  4922. if M <> i then
  4923. begin
  4924. buf := a[M];
  4925. a[M] := a[i];
  4926. a[i] := buf;
  4927. end;
  4928. end;
  4929. end;
  4930. function ClampValue(const aValue, aMin, aMax: Single): Single;
  4931. begin
  4932. if aValue < aMin then
  4933. result := aMin
  4934. else if aValue > aMax then
  4935. result := aMax
  4936. else
  4937. result := aValue;
  4938. end;
  4939. function ClampValue(const aValue, aMin: Single): Single;
  4940. begin
  4941. if aValue < aMin then
  4942. result := aMin
  4943. else
  4944. result := aValue;
  4945. end;
  4946. function MakeAffineDblVector(var V: array of Double): TAffineDblVector;
  4947. begin
  4948. result.X := V[0];
  4949. result.Y := V[1];
  4950. result.Z := V[2];
  4951. end;
  4952. function MakeDblVector(var V: array of Double): THomogeneousDblVector;
  4953. begin
  4954. result.X := V[0];
  4955. result.Y := V[1];
  4956. result.Z := V[2];
  4957. result.W := V[3];
  4958. end;
  4959. function PointInPolygon(const xp, yp: array of Single; X, Y: Single): Boolean;
  4960. var
  4961. i, J: Integer;
  4962. begin
  4963. result := False;
  4964. if High(xp) = High(yp) then
  4965. begin
  4966. J := High(xp);
  4967. for i := 0 to High(xp) do
  4968. begin
  4969. if ((((yp[i] <= Y) and (Y < yp[J])) or ((yp[J] <= Y) and (Y < yp[i]))) and
  4970. (X < (xp[J] - xp[i]) * (Y - yp[i]) / (yp[J] - yp[i]) + xp[i])) then
  4971. result := not result;
  4972. J := i;
  4973. end;
  4974. end;
  4975. end;
  4976. function IsPointInPolygon(const Polygon: array of TPoint; const p: TPoint): Boolean;
  4977. var
  4978. a: array of TPoint;
  4979. n, i: Integer;
  4980. inside: Boolean;
  4981. begin
  4982. n := High(Polygon) + 1;
  4983. SetLength(a, n + 2);
  4984. a[0] := p;
  4985. for i := 1 to n do
  4986. a[i] := Polygon[i - 1];
  4987. a[n + 1] := a[0];
  4988. inside := True;
  4989. for i := 1 to n do
  4990. begin
  4991. if (a[0].Y > a[i].Y) xor (a[0].Y <= a[i + 1].Y) then
  4992. Continue;
  4993. if (a[0].X - a[i].X) < ((a[0].Y - a[i].Y) * (a[i + 1].X - a[i].X) /
  4994. (a[i + 1].Y - a[i].Y)) then
  4995. inside := not inside;
  4996. end;
  4997. inside := not inside;
  4998. result := inside;
  4999. end;
  5000. procedure DivMod(Dividend: Integer; Divisor: Word; var result, Remainder: Word);
  5001. begin
  5002. result := Dividend div Divisor;
  5003. Remainder := Dividend mod Divisor;
  5004. end;
  5005. function ConvertRotation(const Angles: TAffineVector): TGLVector;
  5006. { Rotation of the Angle t about the axis (X, Y, Z) is given by:
  5007. | X^2 + (1-X^2) Cos(t), XY(1-Cos(t)) + Z Sin(t), XZ(1-Cos(t))-Y Sin(t) |
  5008. M = | XY(1-Cos(t))-Z Sin(t), Y^2 + (1-Y^2) Cos(t), YZ(1-Cos(t)) + X Sin(t) |
  5009. | XZ(1-Cos(t)) + Y Sin(t), YZ(1-Cos(t))-X Sin(t), Z^2 + (1-Z^2) Cos(t) |
  5010. Rotation about the three axes (Angles a1, a2, a3) can be represented as
  5011. the product of the individual rotation matrices:
  5012. | 1 0 0 | | Cos(a2) 0 -Sin(a2) | | Cos(a3) Sin(a3) 0 |
  5013. | 0 Cos(a1) Sin(a1) | * | 0 1 0 | * | -Sin(a3) Cos(a3) 0 |
  5014. | 0 -Sin(a1) Cos(a1) | | Sin(a2) 0 Cos(a2) | | 0 0 1 |
  5015. Mx My Mz
  5016. We now want to solve for X, Y, Z, and t given 9 equations in 4 unknowns.
  5017. Using the diagonal elements of the two matrices, we get:
  5018. X^2 + (1-X^2) Cos(t) = M[0][0]
  5019. Y^2 + (1-Y^2) Cos(t) = M[1][1]
  5020. Z^2 + (1-Z^2) Cos(t) = M[2][2]
  5021. Adding the three equations, we get:
  5022. X^2 + Y^2 + Z^2 - (M[0][0] + M[1][1] + M[2][2]) =
  5023. - (3 - X^2 - Y^2 - Z^2) Cos(t)
  5024. Since (X^2 + Y^2 + Z^2) = 1, we can rewrite as:
  5025. Cos(t) = (1 - (M[0][0] + M[1][1] + M[2][2])) / 2
  5026. Solving for t, we get:
  5027. t = Acos(((M[0][0] + M[1][1] + M[2][2]) - 1) / 2)
  5028. We can substitute t into the equations for X^2, Y^2, and Z^2 above
  5029. to get the values for X, Y, and Z. To find the proper signs we note
  5030. that:
  5031. 2 X Sin(t) = M[1][2] - M[2][1]
  5032. 2 Y Sin(t) = M[2][0] - M[0][2]
  5033. 2 Z Sin(t) = M[0][1] - M[1][0]
  5034. }
  5035. var
  5036. Axis1, Axis2: TVector3f;
  5037. M, m1, m2: TGLMatrix;
  5038. cost, cost1, sint, s1, s2, s3: Single;
  5039. i: Integer;
  5040. begin
  5041. // see if we are only rotating about a single Axis
  5042. if Abs(Angles.X) < EPSILON then
  5043. begin
  5044. if Abs(Angles.Y) < EPSILON then
  5045. begin
  5046. SetVector(result, 0, 0, 1, Angles.Z);
  5047. Exit;
  5048. end
  5049. else if Abs(Angles.Z) < EPSILON then
  5050. begin
  5051. SetVector(result, 0, 1, 0, Angles.Y);
  5052. Exit;
  5053. end
  5054. end
  5055. else if (Abs(Angles.Y) < EPSILON) and (Abs(Angles.Z) < EPSILON) then
  5056. begin
  5057. SetVector(result, 1, 0, 0, Angles.X);
  5058. Exit;
  5059. end;
  5060. // make the rotation matrix
  5061. Axis1 := XVector;
  5062. M := CreateRotationMatrix(Axis1, Angles.X);
  5063. Axis2 := YVector;
  5064. m2 := CreateRotationMatrix(Axis2, Angles.Y);
  5065. m1 := MatrixMultiply(M, m2);
  5066. Axis2 := ZVector;
  5067. m2 := CreateRotationMatrix(Axis2, Angles.Z);
  5068. M := MatrixMultiply(m1, m2);
  5069. cost := ((M.X.X + M.Y.Y + M.Z.Z) - 1) / 2;
  5070. if cost < -1 then
  5071. cost := -1
  5072. else if cost > 1 - EPSILON then
  5073. begin
  5074. // Bad Angle - this would cause a crash
  5075. SetVector(result, XHmgVector);
  5076. Exit;
  5077. end;
  5078. cost1 := 1 - cost;
  5079. SetVector(result, Sqrt((M.X.X - cost) / cost1), Sqrt((M.Y.Y - cost) / cost1),
  5080. Sqrt((M.Z.Z - cost) / cost1), ArcCosine(cost));
  5081. sint := 2 * Sqrt(1 - cost * cost); // This is actually 2 Sin(t)
  5082. // Determine the proper signs
  5083. for i := 0 to 7 do
  5084. begin
  5085. if (i and 1) > 1 then
  5086. s1 := -1
  5087. else
  5088. s1 := 1;
  5089. if (i and 2) > 1 then
  5090. s2 := -1
  5091. else
  5092. s2 := 1;
  5093. if (i and 4) > 1 then
  5094. s3 := -1
  5095. else
  5096. s3 := 1;
  5097. if (Abs(s1 * result.V[X] * sint - M.Y.Z + M.Z.Y) < EPSILON2) and
  5098. (Abs(s2 * result.V[Y] * sint - M.Z.X + M.X.Z) < EPSILON2) and
  5099. (Abs(s3 * result.V[Z] * sint - M.X.Y + M.Y.X) < EPSILON2) then
  5100. begin
  5101. // We found the right combination of signs
  5102. result.V[X] := result.V[X] * s1;
  5103. result.V[Y] := result.V[Y] * s2;
  5104. result.V[Z] := result.V[Z] * s3;
  5105. Exit;
  5106. end;
  5107. end;
  5108. end;
  5109. function QuaternionSlerp(const QStart, QEnd: TQuaternion; Spin: Integer;
  5110. T: Single): TQuaternion;
  5111. var
  5112. beta, // complementary interp parameter
  5113. Theta, // Angle between A and B
  5114. sint, cost, // sine, cosine of theta
  5115. phi: Single; // theta plus spins
  5116. bflip: Boolean; // use negativ t?
  5117. begin
  5118. // cosine theta
  5119. cost := VectorAngleCosine(QStart.ImagPart, QEnd.ImagPart);
  5120. // if QEnd is on opposite hemisphere from QStart, use -QEnd instead
  5121. if cost < 0 then
  5122. begin
  5123. cost := -cost;
  5124. bflip := True;
  5125. end
  5126. else
  5127. bflip := False;
  5128. // if QEnd is (within precision limits) the same as QStart,
  5129. // just linear interpolate between QStart and QEnd.
  5130. // Can't do spins, since we don't know what direction to spin.
  5131. if (1 - cost) < EPSILON then
  5132. beta := 1 - T
  5133. else
  5134. begin
  5135. // normal case
  5136. Theta := ArcCosine(cost);
  5137. phi := Theta + Spin * PI;
  5138. sint := Sin(Theta);
  5139. beta := Sin(Theta - T * phi) / sint;
  5140. T := Sin(T * phi) / sint;
  5141. end;
  5142. if bflip then
  5143. T := -T;
  5144. // interpolate
  5145. result.ImagPart.V[X] := beta * QStart.ImagPart.V[X] + T * QEnd.ImagPart.V[X];
  5146. result.ImagPart.V[Y] := beta * QStart.ImagPart.V[Y] + T * QEnd.ImagPart.V[Y];
  5147. result.ImagPart.V[Z] := beta * QStart.ImagPart.V[Z] + T * QEnd.ImagPart.V[Z];
  5148. result.RealPart := beta * QStart.RealPart + T * QEnd.RealPart;
  5149. end;
  5150. function QuaternionSlerp(const source, dest: TQuaternion; const T: Single)
  5151. : TQuaternion;
  5152. var
  5153. to1: array [0 .. 4] of Single;
  5154. omega, cosom, sinom, scale0, scale1: Extended;
  5155. // t goes from 0 to 1
  5156. // absolute rotations
  5157. begin
  5158. // calc cosine
  5159. cosom := source.ImagPart.X * dest.ImagPart.X + source.ImagPart.Y *
  5160. dest.ImagPart.Y + source.ImagPart.Z * dest.ImagPart.Z +
  5161. source.RealPart * dest.RealPart;
  5162. // adjust signs (if necessary)
  5163. if cosom < 0 then
  5164. begin
  5165. cosom := -cosom;
  5166. to1[0] := -dest.ImagPart.X;
  5167. to1[1] := -dest.ImagPart.Y;
  5168. to1[2] := -dest.ImagPart.Z;
  5169. to1[3] := -dest.RealPart;
  5170. end
  5171. else
  5172. begin
  5173. to1[0] := dest.ImagPart.X;
  5174. to1[1] := dest.ImagPart.Y;
  5175. to1[2] := dest.ImagPart.Z;
  5176. to1[3] := dest.RealPart;
  5177. end;
  5178. // calculate coefficients
  5179. if ((1.0 - cosom) > EPSILON2) then
  5180. begin // standard case (slerp)
  5181. omega := ArcCosine(cosom);
  5182. sinom := 1 / Sin(omega);
  5183. scale0 := Sin((1.0 - T) * omega) * sinom;
  5184. scale1 := Sin(T * omega) * sinom;
  5185. end
  5186. else
  5187. begin // "from" and "to" quaternions are very close
  5188. // ... so we can do a linear interpolation
  5189. scale0 := 1.0 - T;
  5190. scale1 := T;
  5191. end;
  5192. // calculate final values
  5193. result.ImagPart.X := scale0 * source.ImagPart.X + scale1 * to1[0];
  5194. result.ImagPart.Y := scale0 * source.ImagPart.Y + scale1 * to1[1];
  5195. result.ImagPart.Z := scale0 * source.ImagPart.Z + scale1 * to1[2];
  5196. result.RealPart := scale0 * source.RealPart + scale1 * to1[3];
  5197. NormalizeQuaternion(result);
  5198. end;
  5199. function VectorDblToFlt(const V: THomogeneousDblVector): THomogeneousVector;
  5200. begin
  5201. {$HINTS OFF}
  5202. result.X := V.X;
  5203. result.Y := V.Y;
  5204. result.Z := V.Z;
  5205. result.W := V.W;
  5206. {$HINTS ON}
  5207. end;
  5208. function VectorAffineDblToFlt(const V: TAffineDblVector): TAffineVector;
  5209. begin
  5210. {$HINTS OFF}
  5211. result.X := V.X;
  5212. result.Y := V.Y;
  5213. result.Z := V.Z;
  5214. {$HINTS ON}
  5215. end;
  5216. function VectorAffineFltToDbl(const V: TAffineVector): TAffineDblVector;
  5217. begin
  5218. result.X := V.X;
  5219. result.Y := V.Y;
  5220. result.Z := V.Z;
  5221. end;
  5222. function VectorFltToDbl(const V: TGLVector): THomogeneousDblVector;
  5223. begin
  5224. result.X := V.X;
  5225. result.Y := V.Y;
  5226. result.Z := V.Z;
  5227. result.W := V.W;
  5228. end;
  5229. // ----------------- coordinate system manipulation functions -----------------------------------------------------------
  5230. function Turn(const Matrix: TGLMatrix; angle: Single): TGLMatrix;
  5231. begin
  5232. result := MatrixMultiply(Matrix,
  5233. CreateRotationMatrix(AffineVectorMake(Matrix.Y.X, Matrix.Y.Y,
  5234. Matrix.Y.Z), angle));
  5235. end;
  5236. function Turn(const Matrix: TGLMatrix; const MasterUp: TAffineVector;
  5237. angle: Single): TGLMatrix;
  5238. begin
  5239. result := MatrixMultiply(Matrix, CreateRotationMatrix(MasterUp, angle));
  5240. end;
  5241. function Pitch(const Matrix: TGLMatrix; angle: Single): TGLMatrix;
  5242. begin
  5243. result := MatrixMultiply(Matrix,
  5244. CreateRotationMatrix(AffineVectorMake(Matrix.X.X, Matrix.X.Y,
  5245. Matrix.X.Z), angle));
  5246. end;
  5247. function Pitch(const Matrix: TGLMatrix; const MasterRight: TAffineVector;
  5248. angle: Single): TGLMatrix; overload;
  5249. begin
  5250. result := MatrixMultiply(Matrix, CreateRotationMatrix(MasterRight, angle));
  5251. end;
  5252. function Roll(const Matrix: TGLMatrix; angle: Single): TGLMatrix;
  5253. begin
  5254. result := MatrixMultiply(Matrix,
  5255. CreateRotationMatrix(AffineVectorMake(Matrix.Z.X, Matrix.Z.Y,
  5256. Matrix.Z.Z), angle));
  5257. end;
  5258. function Roll(const Matrix: TGLMatrix; const MasterDirection: TAffineVector;
  5259. angle: Single): TGLMatrix; overload;
  5260. begin
  5261. result := MatrixMultiply(Matrix,
  5262. CreateRotationMatrix(MasterDirection, angle));
  5263. end;
  5264. function RayCastPlaneIntersect(const rayStart, rayVector: TGLVector;
  5265. const planePoint, planeNormal: TGLVector;
  5266. intersectPoint: PGLVector = nil): Boolean;
  5267. var
  5268. sp: TGLVector;
  5269. T, d: Single;
  5270. begin
  5271. d := VectorDotProduct(rayVector, planeNormal);
  5272. result := ((d > EPSILON2) or (d < -EPSILON2));
  5273. if result and Assigned(intersectPoint) then
  5274. begin
  5275. VectorSubtract(planePoint, rayStart, sp);
  5276. d := 1 / d; // will keep one FPU unit busy during dot product calculation
  5277. T := VectorDotProduct(sp, planeNormal) * d;
  5278. if T > 0 then
  5279. VectorCombine(rayStart, rayVector, T, intersectPoint^)
  5280. else
  5281. result := False;
  5282. end;
  5283. end;
  5284. function RayCastPlaneXZIntersect(const rayStart, rayVector: TGLVector;
  5285. const planeY: Single; intersectPoint: PGLVector = nil): Boolean;
  5286. var
  5287. T: Single;
  5288. begin
  5289. if rayVector.Y = 0 then
  5290. result := False
  5291. else
  5292. begin
  5293. T := (rayStart.Y - planeY) / rayVector.Y;
  5294. if T < 0 then
  5295. begin
  5296. if Assigned(intersectPoint) then
  5297. VectorCombine(rayStart, rayVector, T, intersectPoint^);
  5298. result := True;
  5299. end
  5300. else
  5301. result := False;
  5302. end;
  5303. end;
  5304. function RayCastTriangleIntersect(const rayStart, rayVector: TGLVector;
  5305. const p1, p2, p3: TAffineVector; intersectPoint: PGLVector = nil;
  5306. intersectNormal: PGLVector = nil): Boolean;
  5307. var
  5308. pvec: TAffineVector;
  5309. V1, V2, qvec, tvec: TGLVector;
  5310. T, u, V, det, invDet: Single;
  5311. begin
  5312. VectorSubtract(p2, p1, V1);
  5313. VectorSubtract(p3, p1, V2);
  5314. VectorCrossProduct(rayVector, V2, pvec);
  5315. det := VectorDotProduct(V1, pvec);
  5316. if ((det < EPSILON2) and (det > -EPSILON2)) then
  5317. begin // vector is parallel to triangle's plane
  5318. result := False;
  5319. Exit;
  5320. end;
  5321. invDet := cOne / det;
  5322. VectorSubtract(rayStart, p1, tvec);
  5323. u := VectorDotProduct(tvec, pvec) * invDet;
  5324. if (u < 0) or (u > 1) then
  5325. result := False
  5326. else
  5327. begin
  5328. qvec := VectorCrossProduct(tvec, V1);
  5329. V := VectorDotProduct(rayVector, qvec) * invDet;
  5330. result := (V >= 0) and (u + V <= 1);
  5331. if result then
  5332. begin
  5333. T := VectorDotProduct(V2, qvec) * invDet;
  5334. if T > 0 then
  5335. begin
  5336. if intersectPoint <> nil then
  5337. VectorCombine(rayStart, rayVector, T, intersectPoint^);
  5338. if intersectNormal <> nil then
  5339. VectorCrossProduct(V1, V2, intersectNormal^);
  5340. end
  5341. else
  5342. result := False;
  5343. end;
  5344. end;
  5345. end;
  5346. function RayCastMinDistToPoint(const rayStart, rayVector: TGLVector;
  5347. const point: TGLVector): Single;
  5348. var
  5349. proj: Single;
  5350. begin
  5351. proj := PointProject(point, rayStart, rayVector);
  5352. if proj <= 0 then
  5353. proj := 0; // rays don't go backward!
  5354. result := VectorDistance(point, VectorCombine(rayStart, rayVector, 1, proj));
  5355. end;
  5356. function RayCastIntersectsSphere(const rayStart, rayVector: TGLVector;
  5357. const sphereCenter: TGLVector; const SphereRadius: Single): Boolean;
  5358. var
  5359. proj: Single;
  5360. begin
  5361. proj := PointProject(sphereCenter, rayStart, rayVector);
  5362. if proj <= 0 then
  5363. proj := 0; // rays don't go backward!
  5364. result := (VectorDistance2(sphereCenter, VectorCombine(rayStart, rayVector, 1,
  5365. proj)) <= Sqr(SphereRadius));
  5366. end;
  5367. function RayCastSphereIntersect(const rayStart, rayVector: TGLVector;
  5368. const sphereCenter: TGLVector; const SphereRadius: Single;
  5369. var i1, i2: TGLVector): Integer;
  5370. var
  5371. proj, d2: Single;
  5372. id2: Integer;
  5373. projPoint: TGLVector;
  5374. begin
  5375. proj := PointProject(sphereCenter, rayStart, rayVector);
  5376. VectorCombine(rayStart, rayVector, proj, projPoint);
  5377. d2 := SphereRadius * SphereRadius - VectorDistance2(sphereCenter, projPoint);
  5378. id2 := PInteger(@d2)^;
  5379. if id2 >= 0 then
  5380. begin
  5381. if id2 = 0 then
  5382. begin
  5383. if PInteger(@proj)^ > 0 then
  5384. begin
  5385. VectorCombine(rayStart, rayVector, proj, i1);
  5386. result := 1;
  5387. Exit;
  5388. end;
  5389. end
  5390. else if id2 > 0 then
  5391. begin
  5392. d2 := Sqrt(d2);
  5393. if proj >= d2 then
  5394. begin
  5395. VectorCombine(rayStart, rayVector, proj - d2, i1);
  5396. VectorCombine(rayStart, rayVector, proj + d2, i2);
  5397. result := 2;
  5398. Exit;
  5399. end
  5400. else if proj + d2 >= 0 then
  5401. begin
  5402. VectorCombine(rayStart, rayVector, proj + d2, i1);
  5403. result := 1;
  5404. Exit;
  5405. end;
  5406. end;
  5407. end;
  5408. result := 0;
  5409. end;
  5410. function RayCastBoxIntersect(const rayStart, rayVector, aMinExtent,
  5411. aMaxExtent: TAffineVector; intersectPoint: PAffineVector = nil): Boolean;
  5412. var
  5413. i, planeInd: Integer;
  5414. ResAFV, MaxDist, plane: TAffineVector;
  5415. isMiddle: array [0 .. 2] of Boolean;
  5416. begin
  5417. // Find plane.
  5418. result := True;
  5419. for i := 0 to 2 do
  5420. if rayStart.V[i] < aMinExtent.V[i] then
  5421. begin
  5422. plane.V[i] := aMinExtent.V[i];
  5423. isMiddle[i] := False;
  5424. result := False;
  5425. end
  5426. else if rayStart.V[i] > aMaxExtent.V[i] then
  5427. begin
  5428. plane.V[i] := aMaxExtent.V[i];
  5429. isMiddle[i] := False;
  5430. result := False;
  5431. end
  5432. else
  5433. begin
  5434. isMiddle[i] := True;
  5435. end;
  5436. if result then
  5437. begin
  5438. // rayStart inside box.
  5439. if intersectPoint <> nil then
  5440. intersectPoint^ := rayStart;
  5441. end
  5442. else
  5443. begin
  5444. // Distance to plane.
  5445. planeInd := 0;
  5446. for i := 0 to 2 do
  5447. if isMiddle[i] or (rayVector.V[i] = 0) then
  5448. MaxDist.V[i] := -1
  5449. else
  5450. begin
  5451. MaxDist.V[i] := (plane.V[i] - rayStart.V[i]) / rayVector.V[i];
  5452. if MaxDist.V[i] > 0 then
  5453. begin
  5454. if MaxDist.V[planeInd] < MaxDist.V[i] then
  5455. planeInd := i;
  5456. result := True;
  5457. end;
  5458. end;
  5459. // Inside box ?
  5460. if result then
  5461. begin
  5462. for i := 0 to 2 do
  5463. if planeInd = i then
  5464. ResAFV.V[i] := plane.V[i]
  5465. else
  5466. begin
  5467. ResAFV.V[i] := rayStart.V[i] + MaxDist.V[planeInd] * rayVector.V[i];
  5468. result := (ResAFV.V[i] >= aMinExtent.V[i]) and
  5469. (ResAFV.V[i] <= aMaxExtent.V[i]);
  5470. if not result then
  5471. Exit;
  5472. end;
  5473. if intersectPoint <> nil then
  5474. intersectPoint^ := ResAFV;
  5475. end;
  5476. end;
  5477. end;
  5478. function SphereVisibleRadius(distance, radius: Single): Single;
  5479. var
  5480. d2, r2, ir, tr: Single;
  5481. begin
  5482. d2 := distance * distance;
  5483. r2 := radius * radius;
  5484. ir := Sqrt(d2 - r2);
  5485. tr := (d2 + r2 - Sqr(ir)) / (2 * ir);
  5486. result := Sqrt(r2 + Sqr(tr));
  5487. end;
  5488. function IntersectLinePlane(const point, direction: TGLVector;
  5489. const plane: THmgPlane; intersectPoint: PGLVector = nil): Integer;
  5490. var
  5491. a, b: Extended;
  5492. T: Single;
  5493. begin
  5494. a := VectorDotProduct(plane, direction);
  5495. // direction projected to plane normal
  5496. b := PlaneEvaluatePoint(plane, point); // distance to plane
  5497. if a = 0 then
  5498. begin // direction is parallel to plane
  5499. if b = 0 then
  5500. result := -1 // line is inside plane
  5501. else
  5502. result := 0; // line is outside plane
  5503. end
  5504. else
  5505. begin
  5506. if Assigned(intersectPoint) then
  5507. begin
  5508. T := -b / a; // parameter of intersection
  5509. intersectPoint^ := point;
  5510. // calculate intersection = p + t*d
  5511. CombineVector(intersectPoint^, direction, T);
  5512. end;
  5513. result := 1;
  5514. end;
  5515. end;
  5516. function IntersectTriangleBox(const p1, p2, p3, aMinExtent,
  5517. aMaxExtent: TAffineVector): Boolean;
  5518. var
  5519. RayDir, iPoint: TAffineVector;
  5520. BoxDiagPt, BoxDiagPt2, BoxDiagDir, iPnt: TGLVector;
  5521. begin
  5522. // Triangle edge (p2, p1) - Box intersection
  5523. VectorSubtract(p2, p1, RayDir);
  5524. result := RayCastBoxIntersect(p1, RayDir, aMinExtent, aMaxExtent, @iPoint);
  5525. if result then
  5526. result := VectorNorm(VectorSubtract(p1, iPoint)) <
  5527. VectorNorm(VectorSubtract(p1, p2));
  5528. if result then
  5529. Exit;
  5530. // Triangle edge (p3, p1) - Box intersection
  5531. VectorSubtract(p3, p1, RayDir);
  5532. result := RayCastBoxIntersect(p1, RayDir, aMinExtent, aMaxExtent, @iPoint);
  5533. if result then
  5534. result := VectorNorm(VectorSubtract(p1, iPoint)) <
  5535. VectorNorm(VectorSubtract(p1, p3));
  5536. if result then
  5537. Exit;
  5538. // Triangle edge (p2, p3) - Box intersection
  5539. VectorSubtract(p2, p3, RayDir);
  5540. result := RayCastBoxIntersect(p3, RayDir, aMinExtent, aMaxExtent, @iPoint);
  5541. if result then
  5542. result := VectorNorm(VectorSubtract(p3, iPoint)) <
  5543. VectorNorm(VectorSubtract(p3, p2));
  5544. if result then
  5545. Exit;
  5546. // Triangle - Box diagonal 1 intersection
  5547. BoxDiagPt := VectorMake(aMinExtent);
  5548. VectorSubtract(aMaxExtent, aMinExtent, BoxDiagDir);
  5549. result := RayCastTriangleIntersect(BoxDiagPt, BoxDiagDir, p1, p2, p3, @iPnt);
  5550. if result then
  5551. result := VectorNorm(VectorSubtract(BoxDiagPt, iPnt)) <
  5552. VectorNorm(VectorSubtract(aMaxExtent, aMinExtent));
  5553. if result then
  5554. Exit;
  5555. // Triangle - Box diagonal 2 intersection
  5556. BoxDiagPt := VectorMake(aMinExtent.X, aMinExtent.Y, aMaxExtent.Z);
  5557. BoxDiagPt2 := VectorMake(aMaxExtent.X, aMaxExtent.Y, aMinExtent.Z);
  5558. VectorSubtract(BoxDiagPt2, BoxDiagPt, BoxDiagDir);
  5559. result := RayCastTriangleIntersect(BoxDiagPt, BoxDiagDir, p1, p2, p3, @iPnt);
  5560. if result then
  5561. result := VectorNorm(VectorSubtract(BoxDiagPt, iPnt)) <
  5562. VectorNorm(VectorSubtract(BoxDiagPt, BoxDiagPt2));
  5563. if result then
  5564. Exit;
  5565. // Triangle - Box diagonal 3 intersection
  5566. BoxDiagPt := VectorMake(aMinExtent.X, aMaxExtent.Y, aMinExtent.Z);
  5567. BoxDiagPt2 := VectorMake(aMaxExtent.X, aMinExtent.Y, aMaxExtent.Z);
  5568. VectorSubtract(BoxDiagPt, BoxDiagPt, BoxDiagDir);
  5569. result := RayCastTriangleIntersect(BoxDiagPt, BoxDiagDir, p1, p2, p3, @iPnt);
  5570. if result then
  5571. result := VectorLength(VectorSubtract(BoxDiagPt, iPnt)) <
  5572. VectorLength(VectorSubtract(BoxDiagPt, BoxDiagPt));
  5573. if result then
  5574. Exit;
  5575. // Triangle - Box diagonal 4 intersection
  5576. BoxDiagPt := VectorMake(aMaxExtent.X, aMinExtent.Y, aMinExtent.Z);
  5577. BoxDiagPt2 := VectorMake(aMinExtent.X, aMaxExtent.Y, aMaxExtent.Z);
  5578. VectorSubtract(BoxDiagPt, BoxDiagPt, BoxDiagDir);
  5579. result := RayCastTriangleIntersect(BoxDiagPt, BoxDiagDir, p1, p2, p3, @iPnt);
  5580. if result then
  5581. result := VectorLength(VectorSubtract(BoxDiagPt, iPnt)) <
  5582. VectorLength(VectorSubtract(BoxDiagPt, BoxDiagPt));
  5583. end;
  5584. function IntersectSphereBox(const SpherePos: TGLVector;
  5585. const SphereRadius: Single; const BoxMatrix: TGLMatrix;
  5586. // Up Direction and Right must be normalized!
  5587. // Use CubDepht, CubeHeight and CubeWidth
  5588. // for scale TGLCube.
  5589. const BoxScale: TAffineVector; intersectPoint: PAffineVector = nil;
  5590. normal: PAffineVector = nil; depth: PSingle = nil): Boolean;
  5591. function dDOTByColumn(const V: TAffineVector; const M: TGLMatrix;
  5592. const aColumn: Integer): Single;
  5593. begin
  5594. result := V.X * M.X.V[aColumn] + V.Y * M.Y.V[aColumn] + V.Z *
  5595. M.Z.V[aColumn];
  5596. end;
  5597. function dDotByRow(const V: TAffineVector; const M: TGLMatrix;
  5598. const aRow: Integer): Single;
  5599. begin
  5600. // Equal with: Result := VectorDotProduct(v, AffineVectorMake(m[aRow]));
  5601. result := V.X * M.V[aRow].X + V.Y * M.V[aRow].Y + V.Z *
  5602. M.V[aRow].Z;
  5603. end;
  5604. function dDotMatrByColumn(const V: TAffineVector; const M: TGLMatrix)
  5605. : TAffineVector;
  5606. begin
  5607. result.X := dDOTByColumn(V, M, 0);
  5608. result.Y := dDOTByColumn(V, M, 1);
  5609. result.Z := dDOTByColumn(V, M, 2);
  5610. end;
  5611. function dDotMatrByRow(const V: TAffineVector; const M: TGLMatrix)
  5612. : TAffineVector;
  5613. begin
  5614. result.X := dDotByRow(V, M, 0);
  5615. result.Y := dDotByRow(V, M, 1);
  5616. result.Z := dDotByRow(V, M, 2);
  5617. end;
  5618. var
  5619. tmp, l, T, p, Q, r: TAffineVector;
  5620. FaceDistance, MinDistance, Depth1: Single;
  5621. mini, i: Integer;
  5622. isSphereCenterInsideBox: Boolean;
  5623. begin
  5624. // this is easy. get the sphere center `p' relative to the box, and then clip
  5625. // that to the boundary of the box (call that point `q'). if q is on the
  5626. // boundary of the box and |p-q| is <= sphere radius, they touch.
  5627. // if q is inside the box, the sphere is inside the box, so set a contact
  5628. // normal to push the sphere to the closest box face.
  5629. p.X := SpherePos.X - BoxMatrix.W.X;
  5630. p.Y := SpherePos.Y - BoxMatrix.W.Y;
  5631. p.Z := SpherePos.Z - BoxMatrix.W.Z;
  5632. isSphereCenterInsideBox := True;
  5633. for i := 0 to 2 do
  5634. begin
  5635. l.V[i] := 0.5 * BoxScale.V[i];
  5636. T.V[i] := dDotByRow(p, BoxMatrix, i);
  5637. if T.V[i] < -l.V[i] then
  5638. begin
  5639. T.V[i] := -l.V[i];
  5640. isSphereCenterInsideBox := False;
  5641. end
  5642. else if T.V[i] > l.V[i] then
  5643. begin
  5644. T.V[i] := l.V[i];
  5645. isSphereCenterInsideBox := False;
  5646. end;
  5647. end;
  5648. if isSphereCenterInsideBox then
  5649. begin
  5650. MinDistance := l.X - Abs(T.X);
  5651. mini := 0;
  5652. for i := 1 to 2 do
  5653. begin
  5654. FaceDistance := l.V[i] - Abs(T.V[i]);
  5655. if FaceDistance < MinDistance then
  5656. begin
  5657. MinDistance := FaceDistance;
  5658. mini := i;
  5659. end;
  5660. end;
  5661. if intersectPoint <> nil then
  5662. intersectPoint^ := AffineVectorMake(SpherePos);
  5663. if normal <> nil then
  5664. begin
  5665. tmp := NullVector;
  5666. if T.V[mini] > 0 then
  5667. tmp.V[mini] := 1
  5668. else
  5669. tmp.V[mini] := -1;
  5670. normal^ := dDotMatrByRow(tmp, BoxMatrix);
  5671. end;
  5672. if depth <> nil then
  5673. depth^ := MinDistance + SphereRadius;
  5674. result := True;
  5675. end
  5676. else
  5677. begin
  5678. Q := dDotMatrByColumn(T, BoxMatrix);
  5679. r := VectorSubtract(p, Q);
  5680. Depth1 := SphereRadius - VectorLength(r);
  5681. if Depth1 < 0 then
  5682. begin
  5683. result := False;
  5684. end
  5685. else
  5686. begin
  5687. if intersectPoint <> nil then
  5688. intersectPoint^ := VectorAdd(Q, AffineVectorMake(BoxMatrix.W));
  5689. if normal <> nil then
  5690. begin
  5691. normal^ := VectorNormalize(r);
  5692. end;
  5693. if depth <> nil then
  5694. depth^ := Depth1;
  5695. result := True;
  5696. end;
  5697. end;
  5698. end;
  5699. function ExtractFrustumFromModelViewProjection(const modelViewProj: TGLMatrix)
  5700. : TFrustum;
  5701. begin
  5702. with result do
  5703. begin
  5704. // extract left plane
  5705. pLeft.X := modelViewProj.X.W + modelViewProj.X.X;
  5706. pLeft.Y := modelViewProj.Y.W + modelViewProj.Y.X;
  5707. pLeft.Z := modelViewProj.Z.W + modelViewProj.Z.X;
  5708. pLeft.W := modelViewProj.W.W + modelViewProj.W.X;
  5709. NormalizePlane(pLeft);
  5710. // extract top plane
  5711. pTop.X := modelViewProj.X.W - modelViewProj.X.Y;
  5712. pTop.Y := modelViewProj.Y.W - modelViewProj.Y.Y;
  5713. pTop.Z := modelViewProj.Z.W - modelViewProj.Z.Y;
  5714. pTop.W := modelViewProj.W.W - modelViewProj.W.Y;
  5715. NormalizePlane(pTop);
  5716. // extract right plane
  5717. pRight.X := modelViewProj.X.W - modelViewProj.X.X;
  5718. pRight.Y := modelViewProj.Y.W - modelViewProj.Y.X;
  5719. pRight.Z := modelViewProj.Z.W - modelViewProj.Z.X;
  5720. pRight.W := modelViewProj.W.W - modelViewProj.W.X;
  5721. NormalizePlane(pRight);
  5722. // extract bottom plane
  5723. pBottom.X := modelViewProj.X.W + modelViewProj.X.Y;
  5724. pBottom.Y := modelViewProj.Y.W + modelViewProj.Y.Y;
  5725. pBottom.Z := modelViewProj.Z.W + modelViewProj.Z.Y;
  5726. pBottom.W := modelViewProj.W.W + modelViewProj.W.Y;
  5727. NormalizePlane(pBottom);
  5728. // extract far plane
  5729. pFar.X := modelViewProj.X.W - modelViewProj.X.Z;
  5730. pFar.Y := modelViewProj.Y.W - modelViewProj.Y.Z;
  5731. pFar.Z := modelViewProj.Z.W - modelViewProj.Z.Z;
  5732. pFar.W := modelViewProj.W.W - modelViewProj.W.Z;
  5733. NormalizePlane(pFar);
  5734. // extract near plane
  5735. pNear.X := modelViewProj.X.W + modelViewProj.X.Z;
  5736. pNear.Y := modelViewProj.Y.W + modelViewProj.Y.Z;
  5737. pNear.Z := modelViewProj.Z.W + modelViewProj.Z.Z;
  5738. pNear.W := modelViewProj.W.W + modelViewProj.W.Z;
  5739. NormalizePlane(pNear);
  5740. end;
  5741. end;
  5742. function IsVolumeClipped(const objPos: TAffineVector; const objRadius: Single;
  5743. const Frustum: TFrustum): Boolean;
  5744. var
  5745. negRadius: Single;
  5746. begin
  5747. negRadius := -objRadius;
  5748. result := (PlaneEvaluatePoint(Frustum.pLeft, objPos) < negRadius) or
  5749. (PlaneEvaluatePoint(Frustum.pTop, objPos) < negRadius) or
  5750. (PlaneEvaluatePoint(Frustum.pRight, objPos) < negRadius) or
  5751. (PlaneEvaluatePoint(Frustum.pBottom, objPos) < negRadius) or
  5752. (PlaneEvaluatePoint(Frustum.pNear, objPos) < negRadius) or
  5753. (PlaneEvaluatePoint(Frustum.pFar, objPos) < negRadius);
  5754. end;
  5755. function IsVolumeClipped(const objPos: TGLVector; const objRadius: Single;
  5756. const Frustum: TFrustum): Boolean;
  5757. begin
  5758. result := IsVolumeClipped(PAffineVector(@objPos)^, objRadius, Frustum);
  5759. end;
  5760. function IsVolumeClipped(const min, max: TAffineVector;
  5761. const Frustum: TFrustum): Boolean;
  5762. begin
  5763. // change box to sphere
  5764. result := IsVolumeClipped(VectorScale(VectorAdd(min, max), 0.5),
  5765. VectorDistance(min, max) * 0.5, Frustum);
  5766. end;
  5767. function MakeParallelProjectionMatrix(const plane: THmgPlane;
  5768. const dir: TGLVector): TGLMatrix;
  5769. // Based on material from a course by William D. Shoaff (www.cs.fit.edu)
  5770. var
  5771. dot, invDot: Single;
  5772. begin
  5773. dot := plane.X * dir.X + plane.Y * dir.Y + plane.Z * dir.Z;
  5774. if Abs(dot) < 1E-5 then
  5775. begin
  5776. result := IdentityHmgMatrix;
  5777. Exit;
  5778. end;
  5779. invDot := 1 / dot;
  5780. result.X.X := (plane.Y * dir.Y + plane.Z * dir.Z) * invDot;
  5781. result.Y.X := (-plane.Y * dir.X) * invDot;
  5782. result.Z.X := (-plane.Z * dir.X) * invDot;
  5783. result.W.X := (-plane.W * dir.X) * invDot;
  5784. result.X.Y := (-plane.X * dir.Y) * invDot;
  5785. result.Y.Y := (plane.X * dir.X + plane.Z * dir.Z) * invDot;
  5786. result.Z.Y := (-plane.Z * dir.Y) * invDot;
  5787. result.W.Y := (-plane.W * dir.Y) * invDot;
  5788. result.X.Z := (-plane.X * dir.Z) * invDot;
  5789. result.Y.Z := (-plane.Y * dir.Z) * invDot;
  5790. result.Z.Z := (plane.X * dir.X + plane.Y * dir.Y) * invDot;
  5791. result.W.Z := (-plane.W * dir.Z) * invDot;
  5792. result.X.W := 0;
  5793. result.Y.W := 0;
  5794. result.Z.W := 0;
  5795. result.W.W := 1;
  5796. end;
  5797. function MakeShadowMatrix(const planePoint, planeNormal,
  5798. lightPos: TGLVector): TGLMatrix;
  5799. var
  5800. planeNormal3, dot: Single;
  5801. begin
  5802. // Find the last coefficient by back substitutions
  5803. planeNormal3 := -(planeNormal.X * planePoint.X + planeNormal.Y *
  5804. planePoint.Y + planeNormal.Z * planePoint.Z);
  5805. // Dot product of plane and light position
  5806. dot := planeNormal.X * lightPos.X + planeNormal.Y * lightPos.Y +
  5807. planeNormal.Z * lightPos.Z + planeNormal3 * lightPos.W;
  5808. // Now do the projection
  5809. // First column
  5810. result.X.X := dot - lightPos.X * planeNormal.X;
  5811. result.Y.X := -lightPos.X * planeNormal.Y;
  5812. result.Z.X := -lightPos.X * planeNormal.Z;
  5813. result.W.X := -lightPos.X * planeNormal3;
  5814. // Second column
  5815. result.X.Y := -lightPos.Y * planeNormal.X;
  5816. result.Y.Y := dot - lightPos.Y * planeNormal.Y;
  5817. result.Z.Y := -lightPos.Y * planeNormal.Z;
  5818. result.W.Y := -lightPos.Y * planeNormal3;
  5819. // Third Column
  5820. result.X.Z := -lightPos.Z * planeNormal.X;
  5821. result.Y.Z := -lightPos.Z * planeNormal.Y;
  5822. result.Z.Z := dot - lightPos.Z * planeNormal.Z;
  5823. result.W.Z := -lightPos.Z * planeNormal3;
  5824. // Fourth Column
  5825. result.X.W := -lightPos.W * planeNormal.X;
  5826. result.Y.W := -lightPos.W * planeNormal.Y;
  5827. result.Z.W := -lightPos.W * planeNormal.Z;
  5828. result.W.W := dot - lightPos.W * planeNormal3;
  5829. end;
  5830. function MakeReflectionMatrix(const planePoint, planeNormal
  5831. : TAffineVector): TGLMatrix;
  5832. var
  5833. pv2: Single;
  5834. begin
  5835. // Precalcs
  5836. pv2 := 2 * VectorDotProduct(planePoint, planeNormal);
  5837. // 1st column
  5838. result.X.X := 1 - 2 * Sqr(planeNormal.X);
  5839. result.X.Y := -2 * planeNormal.X * planeNormal.Y;
  5840. result.X.Z := -2 * planeNormal.X * planeNormal.Z;
  5841. result.X.W := 0;
  5842. // 2nd column
  5843. result.Y.X := -2 * planeNormal.Y * planeNormal.X;
  5844. result.Y.Y := 1 - 2 * Sqr(planeNormal.Y);
  5845. result.Y.Z := -2 * planeNormal.Y * planeNormal.Z;
  5846. result.Y.W := 0;
  5847. // 3rd column
  5848. result.Z.X := -2 * planeNormal.Z * planeNormal.X;
  5849. result.Z.Y := -2 * planeNormal.Z * planeNormal.Y;
  5850. result.Z.Z := 1 - 2 * Sqr(planeNormal.Z);
  5851. result.Z.W := 0;
  5852. // 4th column
  5853. result.W.X := pv2 * planeNormal.X;
  5854. result.W.Y := pv2 * planeNormal.Y;
  5855. result.W.Z := pv2 * planeNormal.Z;
  5856. result.W.W := 1;
  5857. end;
  5858. function PackRotationMatrix(const mat: TGLMatrix): TPackedRotationMatrix;
  5859. var
  5860. Q: TQuaternion;
  5861. const
  5862. cFact: Single = 32767;
  5863. begin
  5864. Q := QuaternionFromMatrix(mat);
  5865. NormalizeQuaternion(Q);
  5866. {$HINTS OFF}
  5867. if Q.RealPart < 0 then
  5868. begin
  5869. result[0] := Round(-Q.ImagPart.X * cFact);
  5870. result[1] := Round(-Q.ImagPart.Y * cFact);
  5871. result[2] := Round(-Q.ImagPart.Z * cFact);
  5872. end
  5873. else
  5874. begin
  5875. result[0] := Round(Q.ImagPart.X * cFact);
  5876. result[1] := Round(Q.ImagPart.Y * cFact);
  5877. result[2] := Round(Q.ImagPart.Z * cFact);
  5878. end;
  5879. {$HINTS ON}
  5880. end;
  5881. function UnPackRotationMatrix(const packedMatrix
  5882. : TPackedRotationMatrix): TGLMatrix;
  5883. var
  5884. Q: TQuaternion;
  5885. const
  5886. cFact: Single = 1 / 32767;
  5887. begin
  5888. Q.ImagPart.X := packedMatrix[0] * cFact;
  5889. Q.ImagPart.Y := packedMatrix[1] * cFact;
  5890. Q.ImagPart.Z := packedMatrix[2] * cFact;
  5891. Q.RealPart := 1 - VectorNorm(Q.ImagPart);
  5892. if Q.RealPart < 0 then
  5893. Q.RealPart := 0
  5894. else
  5895. Q.RealPart := Sqrt(Q.RealPart);
  5896. result := QuaternionToMatrix(Q);
  5897. end;
  5898. function BarycentricCoordinates(const V1, V2, V3, p: TAffineVector;
  5899. var u, V: Single): Boolean;
  5900. var
  5901. a1, a2: Integer;
  5902. n, e1, e2, pt: TAffineVector;
  5903. begin
  5904. // calculate edges
  5905. VectorSubtract(V1, V3, e1);
  5906. VectorSubtract(V2, V3, e2);
  5907. // calculate p relative to v3
  5908. VectorSubtract(p, V3, pt);
  5909. // find the dominant axis
  5910. n := VectorCrossProduct(e1, e2);
  5911. AbsVector(n);
  5912. a1 := 0;
  5913. if n.Y > n.V[a1] then
  5914. a1 := 1;
  5915. if n.Z > n.V[a1] then
  5916. a1 := 2;
  5917. // use dominant axis for projection
  5918. case a1 of
  5919. 0:
  5920. begin
  5921. a1 := 1;
  5922. a2 := 2;
  5923. end;
  5924. 1:
  5925. begin
  5926. a1 := 0;
  5927. a2 := 2;
  5928. end;
  5929. else // 2:
  5930. a1 := 0;
  5931. a2 := 1;
  5932. end;
  5933. // solve for u and v
  5934. u := (pt.V[a2] * e2.V[a1] - pt.V[a1] * e2.V[a2]) /
  5935. (e1.V[a2] * e2.V[a1] - e1.V[a1] * e2.V[a2]);
  5936. V := (pt.V[a2] * e1.V[a1] - pt.V[a1] * e1.V[a2]) /
  5937. (e2.V[a2] * e1.V[a1] - e2.V[a1] * e1.V[a2]);
  5938. result := (u >= 0) and (V >= 0) and (u + V <= 1);
  5939. end;
  5940. { ***************************************************************************** }
  5941. function Vector2fMake(const X, Y: Single): TVector2f;
  5942. begin
  5943. result.X := X;
  5944. result.Y := Y;
  5945. end;
  5946. function Vector2iMake(const X, Y: Longint): TVector2i;
  5947. begin
  5948. result.X := X;
  5949. result.Y := Y;
  5950. end;
  5951. function Vector2sMake(const X, Y: SmallInt): TVector2s;
  5952. begin
  5953. result.X := X;
  5954. result.Y := Y;
  5955. end;
  5956. function Vector2dMake(const X, Y: Double): TVector2d;
  5957. begin
  5958. result.X := X;
  5959. result.Y := Y;
  5960. end;
  5961. function Vector2bMake(const X, Y: Byte): TVector2b;
  5962. begin
  5963. result.X := X;
  5964. result.Y := Y;
  5965. end;
  5966. // **************
  5967. function Vector2fMake(const Vector: TVector3f): TVector2f;
  5968. begin
  5969. result.X := Vector.X;
  5970. result.Y := Vector.Y;
  5971. end;
  5972. function Vector2iMake(const Vector: TVector3i): TVector2i;
  5973. begin
  5974. result.X := Vector.X;
  5975. result.Y := Vector.Y;
  5976. end;
  5977. function Vector2sMake(const Vector: TVector3s): TVector2s;
  5978. begin
  5979. result.X := Vector.X;
  5980. result.Y := Vector.Y;
  5981. end;
  5982. function Vector2dMake(const Vector: TVector3d): TVector2d;
  5983. begin
  5984. result.X := Vector.X;
  5985. result.Y := Vector.Y;
  5986. end;
  5987. function Vector2bMake(const Vector: TVector3b): TVector2b;
  5988. begin
  5989. result.X := Vector.X;
  5990. result.Y := Vector.Y;
  5991. end;
  5992. // **********
  5993. function Vector2fMake(const Vector: TVector4f): TVector2f;
  5994. begin
  5995. result.X := Vector.X;
  5996. result.Y := Vector.Y;
  5997. end;
  5998. function Vector2iMake(const Vector: TVector4i): TVector2i;
  5999. begin
  6000. result.X := Vector.X;
  6001. result.Y := Vector.Y;
  6002. end;
  6003. function Vector2sMake(const Vector: TVector4s): TVector2s;
  6004. begin
  6005. result.X := Vector.X;
  6006. result.Y := Vector.Y;
  6007. end;
  6008. function Vector2dMake(const Vector: TVector4d): TVector2d;
  6009. begin
  6010. result.X := Vector.X;
  6011. result.Y := Vector.Y;
  6012. end;
  6013. function Vector2bMake(const Vector: TVector4b): TVector2b;
  6014. begin
  6015. result.X := Vector.X;
  6016. result.Y := Vector.Y;
  6017. end;
  6018. { ***************************************************************************** }
  6019. function Vector3fMake(const X, Y, Z: Single): TVector3f;
  6020. begin
  6021. result.X := X;
  6022. result.Y := Y;
  6023. result.Z := Z;
  6024. end;
  6025. function Vector3iMake(const X, Y, Z: Longint): TVector3i;
  6026. begin
  6027. result.X := X;
  6028. result.Y := Y;
  6029. result.Z := Z;
  6030. end;
  6031. function Vector3sMake(const X, Y, Z: SmallInt): TVector3s;
  6032. begin
  6033. result.X := X;
  6034. result.Y := Y;
  6035. result.Z := Z;
  6036. end;
  6037. function Vector3dMake(const X, Y, Z: Double): TVector3d;
  6038. begin
  6039. result.X := X;
  6040. result.Y := Y;
  6041. result.Z := Z;
  6042. end;
  6043. function Vector3bMake(const X, Y, Z: Byte): TVector3b;
  6044. begin
  6045. result.X := X;
  6046. result.Y := Y;
  6047. result.Z := Z;
  6048. end;
  6049. function Vector3fMake(const Vector: TVector2f; const Z: Single): TVector3f;
  6050. begin
  6051. result.X := Vector.X;
  6052. result.Y := Vector.Y;
  6053. result.Z := Z;
  6054. end;
  6055. function Vector3iMake(const Vector: TVector2i; const Z: Longint): TVector3i;
  6056. begin
  6057. result.X := Vector.X;
  6058. result.Y := Vector.Y;
  6059. result.Z := Z;
  6060. end;
  6061. function Vector3sMake(const Vector: TVector2s; const Z: SmallInt): TVector3s;
  6062. begin
  6063. result.X := Vector.X;
  6064. result.Y := Vector.Y;
  6065. result.Z := Z;
  6066. end;
  6067. function Vector3dMake(const Vector: TVector2d; const Z: Double): TVector3d;
  6068. begin
  6069. result.X := Vector.X;
  6070. result.Y := Vector.Y;
  6071. result.Z := Z;
  6072. end;
  6073. function Vector3bMake(const Vector: TVector2b; const Z: Byte): TVector3b;
  6074. begin
  6075. result.X := Vector.X;
  6076. result.Y := Vector.Y;
  6077. result.Z := Z;
  6078. end;
  6079. function Vector3fMake(const Vector: TVector4f): TVector3f;
  6080. begin
  6081. result.X := Vector.X;
  6082. result.Y := Vector.Y;
  6083. result.Z := Vector.Z;
  6084. end;
  6085. function Vector3iMake(const Vector: TVector4i): TVector3i;
  6086. begin
  6087. result.X := Vector.X;
  6088. result.Y := Vector.Y;
  6089. result.Z := Vector.Z;
  6090. end;
  6091. function Vector3sMake(const Vector: TVector4s): TVector3s;
  6092. begin
  6093. result.X := Vector.X;
  6094. result.Y := Vector.Y;
  6095. result.Z := Vector.Z;
  6096. end;
  6097. function Vector3dMake(const Vector: TVector4d): TVector3d;
  6098. begin
  6099. result.X := Vector.X;
  6100. result.Y := Vector.Y;
  6101. result.Z := Vector.Z;
  6102. end;
  6103. function Vector3bMake(const Vector: TVector4b): TVector3b;
  6104. begin
  6105. result.X := Vector.X;
  6106. result.Y := Vector.Y;
  6107. result.Z := Vector.Z;
  6108. end;
  6109. { ***************************************************************************** }
  6110. function Vector4fMake(const X, Y, Z, W: Single): TVector4f;
  6111. begin
  6112. result.X := X;
  6113. result.Y := Y;
  6114. result.Z := Z;
  6115. result.W := W;
  6116. end;
  6117. function Vector4iMake(const X, Y, Z, W: Longint): TVector4i;
  6118. begin
  6119. result.X := X;
  6120. result.Y := Y;
  6121. result.Z := Z;
  6122. result.W := W;
  6123. end;
  6124. function Vector4sMake(const X, Y, Z, W: SmallInt): TVector4s;
  6125. begin
  6126. result.X := X;
  6127. result.Y := Y;
  6128. result.Z := Z;
  6129. result.W := W;
  6130. end;
  6131. function Vector4dMake(const X, Y, Z, W: Double): TVector4d;
  6132. begin
  6133. result.X := X;
  6134. result.Y := Y;
  6135. result.Z := Z;
  6136. result.W := W;
  6137. end;
  6138. function Vector4bMake(const X, Y, Z, W: Byte): TVector4b;
  6139. begin
  6140. result.X := X;
  6141. result.Y := Y;
  6142. result.Z := Z;
  6143. result.W := W;
  6144. end;
  6145. function Vector4fMake(const Vector: TVector3f; const W: Single): TVector4f;
  6146. begin
  6147. result.X := Vector.X;
  6148. result.Y := Vector.Y;
  6149. result.Z := Vector.Z;
  6150. result.W := W;
  6151. end;
  6152. function Vector4iMake(const Vector: TVector3i; const W: Longint): TVector4i;
  6153. begin
  6154. result.X := Vector.X;
  6155. result.Y := Vector.Y;
  6156. result.Z := Vector.Z;
  6157. result.W := W;
  6158. end;
  6159. function Vector4sMake(const Vector: TVector3s; const W: SmallInt): TVector4s;
  6160. begin
  6161. result.X := Vector.X;
  6162. result.Y := Vector.Y;
  6163. result.Z := Vector.Z;
  6164. result.W := W;
  6165. end;
  6166. function Vector4dMake(const Vector: TVector3d; const W: Double): TVector4d;
  6167. begin
  6168. result.X := Vector.X;
  6169. result.Y := Vector.Y;
  6170. result.Z := Vector.Z;
  6171. result.W := W;
  6172. end;
  6173. function Vector4bMake(const Vector: TVector3b; const W: Byte): TVector4b;
  6174. begin
  6175. result.X := Vector.X;
  6176. result.Y := Vector.Y;
  6177. result.Z := Vector.Z;
  6178. result.W := W;
  6179. end;
  6180. function Vector4fMake(const Vector: TVector2f; const Z: Single; const W: Single)
  6181. : TVector4f;
  6182. begin
  6183. result.X := Vector.X;
  6184. result.Y := Vector.Y;
  6185. result.Z := Z;
  6186. result.W := W;
  6187. end;
  6188. function Vector4iMake(const Vector: TVector2i; const Z: Longint;
  6189. const W: Longint): TVector4i;
  6190. begin
  6191. result.X := Vector.X;
  6192. result.Y := Vector.Y;
  6193. result.Z := Z;
  6194. result.W := W;
  6195. end;
  6196. function Vector4sMake(const Vector: TVector2s; const Z: SmallInt;
  6197. const W: SmallInt): TVector4s;
  6198. begin
  6199. result.X := Vector.X;
  6200. result.Y := Vector.Y;
  6201. result.Z := Z;
  6202. result.W := W;
  6203. end;
  6204. function Vector4dMake(const Vector: TVector2d; const Z: Double; const W: Double)
  6205. : TVector4d;
  6206. begin
  6207. result.X := Vector.X;
  6208. result.Y := Vector.Y;
  6209. result.Z := Z;
  6210. result.W := W;
  6211. end;
  6212. function Vector4bMake(const Vector: TVector2b; const Z: Byte; const W: Byte)
  6213. : TVector4b;
  6214. begin
  6215. result.X := Vector.X;
  6216. result.Y := Vector.Y;
  6217. result.Z := Z;
  6218. result.W := W;
  6219. end;
  6220. { ***************************************************************************** }
  6221. function VectorEquals(const Vector1, Vector2: TVector2f): Boolean;
  6222. begin
  6223. result := (Vector1.X = Vector2.X) and (Vector1.Y = Vector2.Y);
  6224. end;
  6225. function VectorEquals(const Vector1, Vector2: TVector2i): Boolean;
  6226. begin
  6227. result := (Vector1.X = Vector2.X) and (Vector1.Y = Vector2.Y);
  6228. end;
  6229. function VectorEquals(const V1, V2: TVector2d): Boolean;
  6230. begin
  6231. result := (V1.X = V2.X) and (V1.Y = V2.Y);
  6232. end;
  6233. function VectorEquals(const V1, V2: TVector2s): Boolean;
  6234. begin
  6235. result := (V1.X = V2.X) and (V1.Y = V2.Y);
  6236. end;
  6237. function VectorEquals(const V1, V2: TVector2b): Boolean;
  6238. begin
  6239. result := (V1.X = V2.X) and (V1.Y = V2.Y);
  6240. end;
  6241. { ***************************************************************************** }
  6242. function VectorEquals(const V1, V2: TVector3i): Boolean;
  6243. begin
  6244. result := (V1.X = V2.X) and (V1.Y = V2.Y) and (V1.Z = V2.Z);
  6245. end;
  6246. function VectorEquals(const V1, V2: TVector3d): Boolean;
  6247. begin
  6248. result := (V1.X = V2.X) and (V1.Y = V2.Y) and (V1.Z = V2.Z);
  6249. end;
  6250. function VectorEquals(const V1, V2: TVector3s): Boolean;
  6251. begin
  6252. result := (V1.X = V2.X) and (V1.Y = V2.Y) and (V1.Z = V2.Z);
  6253. end;
  6254. function VectorEquals(const V1, V2: TVector3b): Boolean;
  6255. begin
  6256. result := (V1.X = V2.X) and (V1.Y = V2.Y) and (V1.Z = V2.Z);
  6257. end;
  6258. { ***************************************************************************** }
  6259. function VectorEquals(const V1, V2: TVector4i): Boolean;
  6260. begin
  6261. result := (V1.X = V2.X) and (V1.Y = V2.Y) and (V1.Z = V2.Z)
  6262. and (V1.W = V2.W);
  6263. end;
  6264. function VectorEquals(const V1, V2: TVector4d): Boolean;
  6265. begin
  6266. result := (V1.X = V2.X) and (V1.Y = V2.Y) and (V1.Z = V2.Z)
  6267. and (V1.W = V2.W);
  6268. end;
  6269. function VectorEquals(const V1, V2: TVector4s): Boolean;
  6270. begin
  6271. result := (V1.X = V2.X) and (V1.Y = V2.Y) and (V1.Z = V2.Z)
  6272. and (V1.W = V2.W);
  6273. end;
  6274. function VectorEquals(const V1, V2: TVector4b): Boolean;
  6275. begin
  6276. result := (V1.X = V2.X) and (V1.Y = V2.Y) and (V1.Z = V2.Z)
  6277. and (V1.W = V2.W);
  6278. end;
  6279. { ***************************************************************************** }
  6280. function MatrixEquals(const Matrix1, Matrix2: TMatrix3f): Boolean;
  6281. begin
  6282. result := VectorEquals(Matrix1.X, Matrix2.X) and
  6283. VectorEquals(Matrix1.Y, Matrix2.Y) and
  6284. VectorEquals(Matrix1.Z, Matrix2.Z);
  6285. end;
  6286. // 3x3i
  6287. function MatrixEquals(const Matrix1, Matrix2: TMatrix3i): Boolean;
  6288. begin
  6289. result := VectorEquals(Matrix1.X, Matrix2.X) and
  6290. VectorEquals(Matrix1.Y, Matrix2.Y) and
  6291. VectorEquals(Matrix1.Z, Matrix2.Z);
  6292. end;
  6293. function MatrixEquals(const Matrix1, Matrix2: TMatrix3d): Boolean;
  6294. begin
  6295. result := VectorEquals(Matrix1.X, Matrix2.X) and
  6296. VectorEquals(Matrix1.Y, Matrix2.Y) and
  6297. VectorEquals(Matrix1.Z, Matrix2.Z);
  6298. end;
  6299. function MatrixEquals(const Matrix1, Matrix2: TMatrix3s): Boolean;
  6300. begin
  6301. result := VectorEquals(Matrix1.X, Matrix2.X) and
  6302. VectorEquals(Matrix1.Y, Matrix2.Y) and
  6303. VectorEquals(Matrix1.Z, Matrix2.Z);
  6304. end;
  6305. function MatrixEquals(const Matrix1, Matrix2: TMatrix3b): Boolean;
  6306. begin
  6307. result := VectorEquals(Matrix1.X, Matrix2.X) and
  6308. VectorEquals(Matrix1.Y, Matrix2.Y) and
  6309. VectorEquals(Matrix1.Z, Matrix2.Z);
  6310. end;
  6311. { ***************************************************************************** }
  6312. // 4x4f
  6313. function MatrixEquals(const Matrix1, Matrix2: TMatrix4f): Boolean;
  6314. begin
  6315. result := VectorEquals(Matrix1.X, Matrix2.X) and
  6316. VectorEquals(Matrix1.Y, Matrix2.Y) and
  6317. VectorEquals(Matrix1.Z, Matrix2.Z) and
  6318. VectorEquals(Matrix1.W, Matrix2.W);
  6319. end;
  6320. // 4x4i
  6321. function MatrixEquals(const Matrix1, Matrix2: TMatrix4i): Boolean;
  6322. begin
  6323. result := VectorEquals(Matrix1.X, Matrix2.X) and
  6324. VectorEquals(Matrix1.Y, Matrix2.Y) and
  6325. VectorEquals(Matrix1.Z, Matrix2.Z) and
  6326. VectorEquals(Matrix1.W, Matrix2.W);
  6327. end;
  6328. // 4x4d
  6329. function MatrixEquals(const Matrix1, Matrix2: TMatrix4d): Boolean;
  6330. begin
  6331. result := VectorEquals(Matrix1.X, Matrix2.X) and
  6332. VectorEquals(Matrix1.Y, Matrix2.Y) and
  6333. VectorEquals(Matrix1.Z, Matrix2.Z) and
  6334. VectorEquals(Matrix1.W, Matrix2.W);
  6335. end;
  6336. function MatrixEquals(const Matrix1, Matrix2: TMatrix4s): Boolean;
  6337. begin
  6338. result := VectorEquals(Matrix1.X, Matrix2.X) and
  6339. VectorEquals(Matrix1.Y, Matrix2.Y) and
  6340. VectorEquals(Matrix1.Z, Matrix2.Z) and
  6341. VectorEquals(Matrix1.W, Matrix2.W);
  6342. end;
  6343. function MatrixEquals(const Matrix1, Matrix2: TMatrix4b): Boolean;
  6344. begin
  6345. result := VectorEquals(Matrix1.X, Matrix2.X) and
  6346. VectorEquals(Matrix1.Y, Matrix2.Y) and
  6347. VectorEquals(Matrix1.Z, Matrix2.Z) and
  6348. VectorEquals(Matrix1.W, Matrix2.W);
  6349. end;
  6350. { ***************************************************************************** }
  6351. function VectorMoreThen(const SourceVector, ComparedVector: TVector3f)
  6352. : Boolean; overload;
  6353. begin
  6354. result := (SourceVector.X > ComparedVector.X) and
  6355. (SourceVector.Y > ComparedVector.Y) and
  6356. (SourceVector.Z > ComparedVector.Z);
  6357. end;
  6358. function VectorMoreEqualThen(const SourceVector, ComparedVector: TVector3f)
  6359. : Boolean; overload;
  6360. begin
  6361. result := (SourceVector.X >= ComparedVector.X) and
  6362. (SourceVector.Y >= ComparedVector.Y) and
  6363. (SourceVector.Z >= ComparedVector.Z);
  6364. end;
  6365. function VectorLessThen(const SourceVector, ComparedVector: TVector3f)
  6366. : Boolean; overload;
  6367. begin
  6368. result := (SourceVector.X < ComparedVector.X) and
  6369. (SourceVector.Y < ComparedVector.Y) and
  6370. (SourceVector.Z < ComparedVector.Z);
  6371. end;
  6372. function VectorLessEqualThen(const SourceVector, ComparedVector: TVector3f)
  6373. : Boolean; overload;
  6374. begin
  6375. result := (SourceVector.X <= ComparedVector.X) and
  6376. (SourceVector.Y <= ComparedVector.Y) and
  6377. (SourceVector.Z <= ComparedVector.Z);
  6378. end;
  6379. function VectorMoreThen(const SourceVector, ComparedVector: TVector4f)
  6380. : Boolean; overload;
  6381. begin
  6382. result := (SourceVector.X > ComparedVector.X) and
  6383. (SourceVector.Y > ComparedVector.Y) and
  6384. (SourceVector.Z > ComparedVector.Z) and
  6385. (SourceVector.W > ComparedVector.W);
  6386. end;
  6387. function VectorMoreEqualThen(const SourceVector, ComparedVector: TVector4f)
  6388. : Boolean; overload;
  6389. begin
  6390. result := (SourceVector.X >= ComparedVector.X) and
  6391. (SourceVector.Y >= ComparedVector.Y) and
  6392. (SourceVector.Z >= ComparedVector.Z) and
  6393. (SourceVector.W >= ComparedVector.W);
  6394. end;
  6395. function VectorLessThen(const SourceVector, ComparedVector: TVector4f)
  6396. : Boolean; overload;
  6397. begin
  6398. result := (SourceVector.X < ComparedVector.X) and
  6399. (SourceVector.Y < ComparedVector.Y) and
  6400. (SourceVector.Z < ComparedVector.Z) and
  6401. (SourceVector.W < ComparedVector.W);
  6402. end;
  6403. function VectorLessEqualThen(const SourceVector, ComparedVector: TVector4f)
  6404. : Boolean; overload;
  6405. begin
  6406. result := (SourceVector.X <= ComparedVector.X) and
  6407. (SourceVector.Y <= ComparedVector.Y) and
  6408. (SourceVector.Z <= ComparedVector.Z) and
  6409. (SourceVector.W <= ComparedVector.W);
  6410. end;
  6411. function VectorMoreThen(const SourceVector, ComparedVector: TVector3i)
  6412. : Boolean; overload;
  6413. begin
  6414. result := (SourceVector.X > ComparedVector.X) and
  6415. (SourceVector.Y > ComparedVector.Y) and
  6416. (SourceVector.Z > ComparedVector.Z);
  6417. end;
  6418. function VectorMoreEqualThen(const SourceVector, ComparedVector: TVector3i)
  6419. : Boolean; overload;
  6420. begin
  6421. result := (SourceVector.X >= ComparedVector.X) and
  6422. (SourceVector.Y >= ComparedVector.Y) and
  6423. (SourceVector.Z >= ComparedVector.Z);
  6424. end;
  6425. function VectorLessThen(const SourceVector, ComparedVector: TVector3i)
  6426. : Boolean; overload;
  6427. begin
  6428. result := (SourceVector.X < ComparedVector.X) and
  6429. (SourceVector.Y < ComparedVector.Y) and
  6430. (SourceVector.Z < ComparedVector.Z);
  6431. end;
  6432. function VectorLessEqualThen(const SourceVector, ComparedVector: TVector3i)
  6433. : Boolean; overload;
  6434. begin
  6435. result := (SourceVector.X <= ComparedVector.X) and
  6436. (SourceVector.Y <= ComparedVector.Y) and
  6437. (SourceVector.Z <= ComparedVector.Z);
  6438. end;
  6439. function VectorMoreThen(const SourceVector, ComparedVector: TVector4i)
  6440. : Boolean; overload;
  6441. begin
  6442. result := (SourceVector.X > ComparedVector.X) and
  6443. (SourceVector.Y > ComparedVector.Y) and
  6444. (SourceVector.Z > ComparedVector.Z) and
  6445. (SourceVector.W > ComparedVector.W);
  6446. end;
  6447. function VectorMoreEqualThen(const SourceVector, ComparedVector: TVector4i)
  6448. : Boolean; overload;
  6449. begin
  6450. result := (SourceVector.X >= ComparedVector.X) and
  6451. (SourceVector.Y >= ComparedVector.Y) and
  6452. (SourceVector.Z >= ComparedVector.Z) and
  6453. (SourceVector.W >= ComparedVector.W);
  6454. end;
  6455. function VectorLessThen(const SourceVector, ComparedVector: TVector4i)
  6456. : Boolean; overload;
  6457. begin
  6458. result := (SourceVector.X < ComparedVector.X) and
  6459. (SourceVector.Y < ComparedVector.Y) and
  6460. (SourceVector.Z < ComparedVector.Z) and
  6461. (SourceVector.W < ComparedVector.W);
  6462. end;
  6463. function VectorLessEqualThen(const SourceVector, ComparedVector: TVector4i)
  6464. : Boolean; overload;
  6465. begin
  6466. result := (SourceVector.X <= ComparedVector.X) and
  6467. (SourceVector.Y <= ComparedVector.Y) and
  6468. (SourceVector.Z <= ComparedVector.Z) and
  6469. (SourceVector.W <= ComparedVector.W);
  6470. end;
  6471. function VectorMoreThen(const SourceVector, ComparedVector: TVector3s)
  6472. : Boolean; overload;
  6473. begin
  6474. result := (SourceVector.X > ComparedVector.X) and
  6475. (SourceVector.Y > ComparedVector.Y) and
  6476. (SourceVector.Z > ComparedVector.Z);
  6477. end;
  6478. function VectorMoreEqualThen(const SourceVector, ComparedVector: TVector3s)
  6479. : Boolean; overload;
  6480. begin
  6481. result := (SourceVector.X >= ComparedVector.X) and
  6482. (SourceVector.Y >= ComparedVector.Y) and
  6483. (SourceVector.Z >= ComparedVector.Z);
  6484. end;
  6485. function VectorLessThen(const SourceVector, ComparedVector: TVector3s)
  6486. : Boolean; overload;
  6487. begin
  6488. result := (SourceVector.X < ComparedVector.X) and
  6489. (SourceVector.Y < ComparedVector.Y) and
  6490. (SourceVector.Z < ComparedVector.Z);
  6491. end;
  6492. function VectorLessEqualThen(const SourceVector, ComparedVector: TVector3s)
  6493. : Boolean; overload;
  6494. begin
  6495. result := (SourceVector.X <= ComparedVector.X) and
  6496. (SourceVector.Y <= ComparedVector.Y) and
  6497. (SourceVector.Z <= ComparedVector.Z);
  6498. end;
  6499. // 4s
  6500. function VectorMoreThen(const SourceVector, ComparedVector: TVector4s)
  6501. : Boolean; overload;
  6502. begin
  6503. result := (SourceVector.X > ComparedVector.X) and
  6504. (SourceVector.Y > ComparedVector.Y) and
  6505. (SourceVector.Z > ComparedVector.Z) and
  6506. (SourceVector.W > ComparedVector.W);
  6507. end;
  6508. function VectorMoreEqualThen(const SourceVector, ComparedVector: TVector4s)
  6509. : Boolean; overload;
  6510. begin
  6511. result := (SourceVector.X >= ComparedVector.X) and
  6512. (SourceVector.Y >= ComparedVector.Y) and
  6513. (SourceVector.Z >= ComparedVector.Z) and
  6514. (SourceVector.W >= ComparedVector.W);
  6515. end;
  6516. function VectorLessThen(const SourceVector, ComparedVector: TVector4s)
  6517. : Boolean; overload;
  6518. begin
  6519. result := (SourceVector.X < ComparedVector.X) and
  6520. (SourceVector.Y < ComparedVector.Y) and
  6521. (SourceVector.Z < ComparedVector.Z) and
  6522. (SourceVector.W < ComparedVector.W);
  6523. end;
  6524. function VectorLessEqualThen(const SourceVector, ComparedVector: TVector4s)
  6525. : Boolean; overload;
  6526. begin
  6527. result := (SourceVector.X <= ComparedVector.X) and
  6528. (SourceVector.Y <= ComparedVector.Y) and
  6529. (SourceVector.Z <= ComparedVector.Z) and
  6530. (SourceVector.W <= ComparedVector.W);
  6531. end;
  6532. function VectorMoreThen(const SourceVector: TVector3f;
  6533. const ComparedNumber: Single): Boolean; overload;
  6534. begin
  6535. result := (SourceVector.X > ComparedNumber) and
  6536. (SourceVector.Y > ComparedNumber) and
  6537. (SourceVector.Z > ComparedNumber);
  6538. end;
  6539. function VectorMoreEqualThen(const SourceVector: TVector3f;
  6540. const ComparedNumber: Single): Boolean; overload;
  6541. begin
  6542. result := (SourceVector.X >= ComparedNumber) and
  6543. (SourceVector.Y >= ComparedNumber) and
  6544. (SourceVector.Z >= ComparedNumber);
  6545. end;
  6546. function VectorLessThen(const SourceVector: TVector3f;
  6547. const ComparedNumber: Single): Boolean; overload;
  6548. begin
  6549. result := (SourceVector.X < ComparedNumber) and
  6550. (SourceVector.Y < ComparedNumber) and
  6551. (SourceVector.Z < ComparedNumber);
  6552. end;
  6553. function VectorLessEqualThen(const SourceVector: TVector3f;
  6554. const ComparedNumber: Single): Boolean; overload;
  6555. begin
  6556. result := (SourceVector.X <= ComparedNumber) and
  6557. (SourceVector.Y <= ComparedNumber) and
  6558. (SourceVector.Z <= ComparedNumber);
  6559. end;
  6560. function VectorMoreThen(const SourceVector: TVector4f;
  6561. const ComparedNumber: Single): Boolean; overload;
  6562. begin
  6563. result := (SourceVector.X > ComparedNumber) and
  6564. (SourceVector.Y > ComparedNumber) and
  6565. (SourceVector.Z > ComparedNumber) and
  6566. (SourceVector.W > ComparedNumber);
  6567. end;
  6568. function VectorMoreEqualThen(const SourceVector: TVector4f;
  6569. const ComparedNumber: Single): Boolean; overload;
  6570. begin
  6571. result := (SourceVector.X >= ComparedNumber) and
  6572. (SourceVector.Y >= ComparedNumber) and
  6573. (SourceVector.Z >= ComparedNumber) and
  6574. (SourceVector.W >= ComparedNumber);
  6575. end;
  6576. function VectorLessThen(const SourceVector: TVector4f;
  6577. const ComparedNumber: Single): Boolean; overload;
  6578. begin
  6579. result := (SourceVector.X < ComparedNumber) and
  6580. (SourceVector.Y < ComparedNumber) and
  6581. (SourceVector.Z < ComparedNumber) and
  6582. (SourceVector.W < ComparedNumber);
  6583. end;
  6584. function VectorLessEqualThen(const SourceVector: TVector4f;
  6585. const ComparedNumber: Single): Boolean; overload;
  6586. begin
  6587. result := (SourceVector.X <= ComparedNumber) and
  6588. (SourceVector.Y <= ComparedNumber) and
  6589. (SourceVector.Z <= ComparedNumber) and
  6590. (SourceVector.W <= ComparedNumber);
  6591. end;
  6592. function VectorMoreThen(const SourceVector: TVector3i;
  6593. const ComparedNumber: Single): Boolean; overload;
  6594. begin
  6595. result := (SourceVector.X > ComparedNumber) and
  6596. (SourceVector.Y > ComparedNumber) and
  6597. (SourceVector.Z > ComparedNumber);
  6598. end;
  6599. function VectorMoreEqualThen(const SourceVector: TVector3i;
  6600. const ComparedNumber: Single): Boolean; overload;
  6601. begin
  6602. result := (SourceVector.X >= ComparedNumber) and
  6603. (SourceVector.Y >= ComparedNumber) and
  6604. (SourceVector.Z >= ComparedNumber);
  6605. end;
  6606. function VectorLessThen(const SourceVector: TVector3i;
  6607. const ComparedNumber: Single): Boolean; overload;
  6608. begin
  6609. result := (SourceVector.X < ComparedNumber) and
  6610. (SourceVector.Y < ComparedNumber) and
  6611. (SourceVector.Z < ComparedNumber);
  6612. end;
  6613. function VectorLessEqualThen(const SourceVector: TVector3i;
  6614. const ComparedNumber: Single): Boolean; overload;
  6615. begin
  6616. result := (SourceVector.X <= ComparedNumber) and
  6617. (SourceVector.Y <= ComparedNumber) and
  6618. (SourceVector.Z <= ComparedNumber);
  6619. end;
  6620. function VectorMoreThen(const SourceVector: TVector4i;
  6621. const ComparedNumber: Single): Boolean; overload;
  6622. begin
  6623. result := (SourceVector.X > ComparedNumber) and
  6624. (SourceVector.Y > ComparedNumber) and
  6625. (SourceVector.Z > ComparedNumber) and
  6626. (SourceVector.W > ComparedNumber);
  6627. end;
  6628. function VectorMoreEqualThen(const SourceVector: TVector4i;
  6629. const ComparedNumber: Single): Boolean; overload;
  6630. begin
  6631. result := (SourceVector.X >= ComparedNumber) and
  6632. (SourceVector.Y >= ComparedNumber) and
  6633. (SourceVector.Z >= ComparedNumber) and
  6634. (SourceVector.W >= ComparedNumber);
  6635. end;
  6636. function VectorLessThen(const SourceVector: TVector4i;
  6637. const ComparedNumber: Single): Boolean; overload;
  6638. begin
  6639. result := (SourceVector.X < ComparedNumber) and
  6640. (SourceVector.Y < ComparedNumber) and
  6641. (SourceVector.Z < ComparedNumber) and
  6642. (SourceVector.W < ComparedNumber);
  6643. end;
  6644. function VectorLessEqualThen(const SourceVector: TVector4i;
  6645. const ComparedNumber: Single): Boolean; overload;
  6646. begin
  6647. result := (SourceVector.X <= ComparedNumber) and
  6648. (SourceVector.Y <= ComparedNumber) and
  6649. (SourceVector.Z <= ComparedNumber) and
  6650. (SourceVector.W <= ComparedNumber);
  6651. end;
  6652. function VectorMoreThen(const SourceVector: TVector3s;
  6653. const ComparedNumber: Single): Boolean; overload;
  6654. begin
  6655. result := (SourceVector.X > ComparedNumber) and
  6656. (SourceVector.Y > ComparedNumber) and
  6657. (SourceVector.Z > ComparedNumber);
  6658. end;
  6659. function VectorMoreEqualThen(const SourceVector: TVector3s;
  6660. const ComparedNumber: Single): Boolean; overload;
  6661. begin
  6662. result := (SourceVector.X >= ComparedNumber) and
  6663. (SourceVector.Y >= ComparedNumber) and
  6664. (SourceVector.Z >= ComparedNumber);
  6665. end;
  6666. function VectorLessThen(const SourceVector: TVector3s;
  6667. const ComparedNumber: Single): Boolean; overload;
  6668. begin
  6669. result := (SourceVector.X < ComparedNumber) and
  6670. (SourceVector.Y < ComparedNumber) and
  6671. (SourceVector.Z < ComparedNumber);
  6672. end;
  6673. function VectorLessEqualThen(const SourceVector: TVector3s;
  6674. const ComparedNumber: Single): Boolean; overload;
  6675. begin
  6676. result := (SourceVector.X <= ComparedNumber) and
  6677. (SourceVector.Y <= ComparedNumber) and
  6678. (SourceVector.Z <= ComparedNumber);
  6679. end;
  6680. function VectorMoreThen(const SourceVector: TVector4s;
  6681. const ComparedNumber: Single): Boolean; overload;
  6682. begin
  6683. result := (SourceVector.X > ComparedNumber) and
  6684. (SourceVector.Y > ComparedNumber) and
  6685. (SourceVector.Z > ComparedNumber) and
  6686. (SourceVector.W > ComparedNumber);
  6687. end;
  6688. function VectorMoreEqualThen(const SourceVector: TVector4s;
  6689. const ComparedNumber: Single): Boolean; overload;
  6690. begin
  6691. result := (SourceVector.X >= ComparedNumber) and
  6692. (SourceVector.Y >= ComparedNumber) and
  6693. (SourceVector.Z >= ComparedNumber) and
  6694. (SourceVector.W >= ComparedNumber);
  6695. end;
  6696. function VectorLessThen(const SourceVector: TVector4s;
  6697. const ComparedNumber: Single): Boolean; overload;
  6698. begin
  6699. result := (SourceVector.X < ComparedNumber) and
  6700. (SourceVector.Y < ComparedNumber) and
  6701. (SourceVector.Z < ComparedNumber) and
  6702. (SourceVector.W < ComparedNumber);
  6703. end;
  6704. function VectorLessEqualThen(const SourceVector: TVector4s;
  6705. const ComparedNumber: Single): Boolean; overload;
  6706. begin
  6707. result := (SourceVector.X <= ComparedNumber) and
  6708. (SourceVector.Y <= ComparedNumber) and
  6709. (SourceVector.Z <= ComparedNumber) and
  6710. (SourceVector.W <= ComparedNumber);
  6711. end;
  6712. function RectanglesIntersect(const ACenterOfRect1, ACenterOfRect2, ASizeOfRect1,
  6713. ASizeOfRect2: TVector2f): Boolean;
  6714. begin
  6715. result := (Abs(ACenterOfRect1.X - ACenterOfRect2.X) <
  6716. (ASizeOfRect1.X + ASizeOfRect2.X) / 2) and
  6717. (Abs(ACenterOfRect1.Y - ACenterOfRect2.Y) <
  6718. (ASizeOfRect1.Y + ASizeOfRect2.Y) / 2);
  6719. end;
  6720. function RectangleContains(const ACenterOfBigRect1, ACenterOfSmallRect2,
  6721. ASizeOfBigRect1, ASizeOfSmallRect2: TVector2f;
  6722. const AEps: Single = 0.0): Boolean;
  6723. begin
  6724. result := (Abs(ACenterOfBigRect1.X - ACenterOfSmallRect2.X) +
  6725. ASizeOfSmallRect2.X / 2 - ASizeOfBigRect1.X / 2 < AEps) and
  6726. (Abs(ACenterOfBigRect1.Y - ACenterOfSmallRect2.Y) +
  6727. ASizeOfSmallRect2.Y / 2 - ASizeOfBigRect1.Y / 2 < AEps);
  6728. end;
  6729. function GetSafeTurnAngle(const AOriginalPosition, AOriginalUpVector,
  6730. ATargetPosition, AMoveAroundTargetCenter: TGLVector): TVector2f;
  6731. var
  6732. pitchangle0, pitchangle1, turnangle0, turnangle1, pitchangledif, turnangledif,
  6733. dx0, dy0, dz0, dx1, dy1, dz1: Double;
  6734. Sign: shortint;
  6735. begin
  6736. // determine relative positions to determine the lines which form the angles
  6737. // distances from initial camera pos to target object
  6738. dx0 := AOriginalPosition.X - AMoveAroundTargetCenter.X;
  6739. dy0 := AOriginalPosition.Y - AMoveAroundTargetCenter.Y;
  6740. dz0 := AOriginalPosition.Z - AMoveAroundTargetCenter.Z;
  6741. // distances from final camera pos to target object
  6742. dx1 := ATargetPosition.X - AMoveAroundTargetCenter.X;
  6743. dy1 := ATargetPosition.Y - AMoveAroundTargetCenter.Y;
  6744. dz1 := ATargetPosition.Z - AMoveAroundTargetCenter.Z;
  6745. // just to make sure we don't get division by 0 exceptions
  6746. if dx0 = 0 then
  6747. dx0 := 0.001;
  6748. if dy0 = 0 then
  6749. dy0 := 0.001;
  6750. if dz0 = 0 then
  6751. dz0 := 0.001;
  6752. if dx1 = 0 then
  6753. dx1 := 0.001;
  6754. if dy1 = 0 then
  6755. dy1 := 0.001;
  6756. if dz1 = 0 then
  6757. dz1 := 0.001;
  6758. // determine "pitch" and "turn" angles for the initial and final camera position
  6759. // the formulas differ depending on the camera.Up vector
  6760. // I tested all quadrants for all possible integer FJoblist.Camera.Up directions
  6761. if Abs(AOriginalUpVector.Z) = 1 then // Z=1/-1
  6762. begin
  6763. Sign := Round(AOriginalUpVector.Z / Abs(AOriginalUpVector.Z));
  6764. pitchangle0 := arctan(dz0 / Sqrt(Sqr(dx0) + Sqr(dy0)));
  6765. pitchangle1 := arctan(dz1 / Sqrt(Sqr(dx1) + Sqr(dy1)));
  6766. turnangle0 := arctan(dy0 / dx0);
  6767. if (dx0 < 0) and (dy0 < 0) then
  6768. turnangle0 := -(PI - turnangle0)
  6769. else if (dx0 < 0) and (dy0 > 0) then
  6770. turnangle0 := -(PI - turnangle0);
  6771. turnangle1 := arctan(dy1 / dx1);
  6772. if (dx1 < 0) and (dy1 < 0) then
  6773. turnangle1 := -(PI - turnangle1)
  6774. else if (dx1 < 0) and (dy1 > 0) then
  6775. turnangle1 := -(PI - turnangle1);
  6776. end
  6777. else if Abs(AOriginalUpVector.Y) = 1 then // Y=1/-1
  6778. begin
  6779. Sign := Round(AOriginalUpVector.Y / Abs(AOriginalUpVector.Y));
  6780. pitchangle0 := arctan(dy0 / Sqrt(Sqr(dx0) + Sqr(dz0)));
  6781. pitchangle1 := arctan(dy1 / Sqrt(Sqr(dx1) + Sqr(dz1)));
  6782. turnangle0 := -arctan(dz0 / dx0);
  6783. if (dx0 < 0) and (dz0 < 0) then
  6784. turnangle0 := -(PI - turnangle0)
  6785. else if (dx0 < 0) and (dz0 > 0) then
  6786. turnangle0 := -(PI - turnangle0);
  6787. turnangle1 := -arctan(dz1 / dx1);
  6788. if (dx1 < 0) and (dz1 < 0) then
  6789. turnangle1 := -(PI - turnangle1)
  6790. else if (dx1 < 0) and (dz1 > 0) then
  6791. turnangle1 := -(PI - turnangle1);
  6792. end
  6793. else if Abs(AOriginalUpVector.X) = 1 then // X=1/-1
  6794. begin
  6795. Sign := Round(AOriginalUpVector.X / Abs(AOriginalUpVector.X));
  6796. pitchangle0 := arctan(dx0 / Sqrt(Sqr(dz0) + Sqr(dy0)));
  6797. pitchangle1 := arctan(dx1 / Sqrt(Sqr(dz1) + Sqr(dy1)));
  6798. turnangle0 := arctan(dz0 / dy0);
  6799. if (dz0 > 0) and (dy0 > 0) then
  6800. turnangle0 := -(PI - turnangle0)
  6801. else if (dz0 < 0) and (dy0 > 0) then
  6802. turnangle0 := -(PI - turnangle0);
  6803. turnangle1 := arctan(dz1 / dy1);
  6804. if (dz1 > 0) and (dy1 > 0) then
  6805. turnangle1 := -(PI - turnangle1)
  6806. else if (dz1 < 0) and (dy1 > 0) then
  6807. turnangle1 := -(PI - turnangle1);
  6808. end
  6809. else
  6810. begin
  6811. Raise Exception.Create('The Camera.Up vector may contain only -1, 0 or 1');
  6812. end;
  6813. // determine pitch and turn angle differences
  6814. pitchangledif := Sign * (pitchangle1 - pitchangle0);
  6815. turnangledif := Sign * (turnangle1 - turnangle0);
  6816. if Abs(turnangledif) > PI then
  6817. turnangledif := -Abs(turnangledif) / turnangledif *
  6818. (2 * PI - Abs(turnangledif));
  6819. // Determine rotation speeds
  6820. result.X := RadianToDeg(-pitchangledif);
  6821. result.Y := RadianToDeg(turnangledif);
  6822. end;
  6823. function GetSafeTurnAngle(const AOriginalPosition, AOriginalUpVector,
  6824. ATargetPosition, AMoveAroundTargetCenter: TAffineVector): TVector2f;
  6825. var
  6826. pitchangle0, pitchangle1, turnangle0, turnangle1, pitchangledif, turnangledif,
  6827. dx0, dy0, dz0, dx1, dy1, dz1: Double;
  6828. Sign: shortint;
  6829. begin
  6830. // determine relative positions to determine the lines which form the angles
  6831. // distances from initial camera pos to target object
  6832. dx0 := AOriginalPosition.X - AMoveAroundTargetCenter.X;
  6833. dy0 := AOriginalPosition.Y - AMoveAroundTargetCenter.Y;
  6834. dz0 := AOriginalPosition.Z - AMoveAroundTargetCenter.Z;
  6835. // distances from final camera pos to target object
  6836. dx1 := ATargetPosition.X - AMoveAroundTargetCenter.X;
  6837. dy1 := ATargetPosition.Y - AMoveAroundTargetCenter.Y;
  6838. dz1 := ATargetPosition.Z - AMoveAroundTargetCenter.Z;
  6839. // just to make sure we don't get division by 0 exceptions
  6840. if dx0 = 0 then
  6841. dx0 := 0.001;
  6842. if dy0 = 0 then
  6843. dy0 := 0.001;
  6844. if dz0 = 0 then
  6845. dz0 := 0.001;
  6846. if dx1 = 0 then
  6847. dx1 := 0.001;
  6848. if dy1 = 0 then
  6849. dy1 := 0.001;
  6850. if dz1 = 0 then
  6851. dz1 := 0.001;
  6852. // determine "pitch" and "turn" angles for the initial and final camera position
  6853. // the formulas differ depending on the camera.Up vector
  6854. // I tested all quadrants for all possible integer FJoblist.Camera.Up directions
  6855. if Abs(AOriginalUpVector.Z) = 1 then // Z=1/-1
  6856. begin
  6857. Sign := Round(AOriginalUpVector.Z / Abs(AOriginalUpVector.Z));
  6858. pitchangle0 := arctan(dz0 / Sqrt(Sqr(dx0) + Sqr(dy0)));
  6859. pitchangle1 := arctan(dz1 / Sqrt(Sqr(dx1) + Sqr(dy1)));
  6860. turnangle0 := arctan(dy0 / dx0);
  6861. if (dx0 < 0) and (dy0 < 0) then
  6862. turnangle0 := -(PI - turnangle0)
  6863. else if (dx0 < 0) and (dy0 > 0) then
  6864. turnangle0 := -(PI - turnangle0);
  6865. turnangle1 := arctan(dy1 / dx1);
  6866. if (dx1 < 0) and (dy1 < 0) then
  6867. turnangle1 := -(PI - turnangle1)
  6868. else if (dx1 < 0) and (dy1 > 0) then
  6869. turnangle1 := -(PI - turnangle1);
  6870. end
  6871. else if Abs(AOriginalUpVector.Y) = 1 then // Y=1/-1
  6872. begin
  6873. Sign := Round(AOriginalUpVector.Y / Abs(AOriginalUpVector.Y));
  6874. pitchangle0 := arctan(dy0 / Sqrt(Sqr(dx0) + Sqr(dz0)));
  6875. pitchangle1 := arctan(dy1 / Sqrt(Sqr(dx1) + Sqr(dz1)));
  6876. turnangle0 := -arctan(dz0 / dx0);
  6877. if (dx0 < 0) and (dz0 < 0) then
  6878. turnangle0 := -(PI - turnangle0)
  6879. else if (dx0 < 0) and (dz0 > 0) then
  6880. turnangle0 := -(PI - turnangle0);
  6881. turnangle1 := -arctan(dz1 / dx1);
  6882. if (dx1 < 0) and (dz1 < 0) then
  6883. turnangle1 := -(PI - turnangle1)
  6884. else if (dx1 < 0) and (dz1 > 0) then
  6885. turnangle1 := -(PI - turnangle1);
  6886. end
  6887. else if Abs(AOriginalUpVector.X) = 1 then // X=1/-1
  6888. begin
  6889. Sign := Round(AOriginalUpVector.X / Abs(AOriginalUpVector.X));
  6890. pitchangle0 := arctan(dx0 / Sqrt(Sqr(dz0) + Sqr(dy0)));
  6891. pitchangle1 := arctan(dx1 / Sqrt(Sqr(dz1) + Sqr(dy1)));
  6892. turnangle0 := arctan(dz0 / dy0);
  6893. if (dz0 > 0) and (dy0 > 0) then
  6894. turnangle0 := -(PI - turnangle0)
  6895. else if (dz0 < 0) and (dy0 > 0) then
  6896. turnangle0 := -(PI - turnangle0);
  6897. turnangle1 := arctan(dz1 / dy1);
  6898. if (dz1 > 0) and (dy1 > 0) then
  6899. turnangle1 := -(PI - turnangle1)
  6900. else if (dz1 < 0) and (dy1 > 0) then
  6901. turnangle1 := -(PI - turnangle1);
  6902. end
  6903. else
  6904. begin
  6905. Raise Exception.Create('The Camera.Up vector may contain only -1, 0 or 1');
  6906. end;
  6907. // determine pitch and turn angle differences
  6908. pitchangledif := Sign * (pitchangle1 - pitchangle0);
  6909. turnangledif := Sign * (turnangle1 - turnangle0);
  6910. if Abs(turnangledif) > PI then
  6911. turnangledif := -Abs(turnangledif) / turnangledif *
  6912. (2 * PI - Abs(turnangledif));
  6913. // Determine rotation speeds
  6914. result.X := RadianToDeg(-pitchangledif);
  6915. result.Y := RadianToDeg(turnangledif);
  6916. end;
  6917. function MoveObjectAround(const AMovingObjectPosition, AMovingObjectUp,
  6918. ATargetPosition: TGLVector; pitchDelta, turnDelta: Single): TGLVector;
  6919. var
  6920. originalT2C, normalT2C, normalCameraRight: TGLVector;
  6921. pitchNow, dist: Single;
  6922. begin
  6923. // normalT2C points away from the direction the camera is looking
  6924. originalT2C := VectorSubtract(AMovingObjectPosition, ATargetPosition);
  6925. SetVector(normalT2C, originalT2C);
  6926. dist := VectorLength(normalT2C);
  6927. NormalizeVector(normalT2C);
  6928. // normalRight points to the camera's right the camera is pitching around this axis.
  6929. normalCameraRight := VectorCrossProduct(AMovingObjectUp, normalT2C);
  6930. if VectorLength(normalCameraRight) < 0.001 then
  6931. SetVector(normalCameraRight, XVector) // arbitrary vector
  6932. else
  6933. NormalizeVector(normalCameraRight);
  6934. // calculate the current pitch. 0 is looking down and PI is looking up
  6935. pitchNow := ArcCosine(VectorDotProduct(AMovingObjectUp, normalT2C));
  6936. pitchNow := ClampValue(pitchNow + DegToRadian(pitchDelta), 0 + 0.025,
  6937. PI - 0.025);
  6938. // creates a new vector pointing up and then rotate it down into the new position
  6939. SetVector(normalT2C, AMovingObjectUp);
  6940. RotateVector(normalT2C, normalCameraRight, -pitchNow);
  6941. RotateVector(normalT2C, AMovingObjectUp, -DegToRadian(turnDelta));
  6942. ScaleVector(normalT2C, dist);
  6943. result := VectorAdd(AMovingObjectPosition, VectorSubtract(normalT2C,
  6944. originalT2C));
  6945. end;
  6946. function AngleBetweenVectors(const a, b, ACenterPoint: TGLVector): Single;
  6947. begin
  6948. result := ArcCosine(VectorAngleCosine(VectorNormalize(VectorSubtract(a,
  6949. ACenterPoint)), VectorNormalize(VectorSubtract(b, ACenterPoint))));
  6950. end;
  6951. function AngleBetweenVectors(const a, b, ACenterPoint: TAffineVector): Single;
  6952. begin
  6953. result := ArcCosine(VectorAngleCosine(VectorNormalize(VectorSubtract(a,
  6954. ACenterPoint)), VectorNormalize(VectorSubtract(b, ACenterPoint))));
  6955. end;
  6956. function ShiftObjectFromCenter(const AOriginalPosition: TGLVector;
  6957. const ACenter: TGLVector; const ADistance: Single;
  6958. const AFromCenterSpot: Boolean): TGLVector;
  6959. var
  6960. lDirection: TGLVector;
  6961. begin
  6962. lDirection := VectorNormalize(VectorSubtract(AOriginalPosition, ACenter));
  6963. if AFromCenterSpot then
  6964. result := VectorAdd(ACenter, VectorScale(lDirection, ADistance))
  6965. else
  6966. result := VectorAdd(AOriginalPosition, VectorScale(lDirection, ADistance))
  6967. end;
  6968. function ShiftObjectFromCenter(const AOriginalPosition: TAffineVector;
  6969. const ACenter: TAffineVector; const ADistance: Single;
  6970. const AFromCenterSpot: Boolean): TAffineVector;
  6971. var
  6972. lDirection: TAffineVector;
  6973. begin
  6974. lDirection := VectorNormalize(VectorSubtract(AOriginalPosition, ACenter));
  6975. if AFromCenterSpot then
  6976. result := VectorAdd(ACenter, VectorScale(lDirection, ADistance))
  6977. else
  6978. result := VectorAdd(AOriginalPosition, VectorScale(lDirection, ADistance))
  6979. end;
  6980. // --------------------------------------------------------------
  6981. initialization
  6982. // --------------------------------------------------------------
  6983. vSIMD := 0;
  6984. end.