GLS.VectorGeometry.pas 243 KB

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