2
0

GLS.VectorGeometry.pas 243 KB

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