Stage.VectorGeometry.pas 243 KB

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