GLS.ODEManager.pas 140 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455
  1. //
  2. // The graphics engine GLScene
  3. //
  4. unit GLS.ODEManager;
  5. (* An ODE Manager *)
  6. interface
  7. uses
  8. Winapi.OpenGL,
  9. System.Classes,
  10. System.SysUtils,
  11. System.Math,
  12. System.Types,
  13. Stage.OpenGLTokens,
  14. Stage.VectorTypes,
  15. GLS.VectorLists,
  16. Stage.VectorGeometry,
  17. Stage.PipelineTransform,
  18. GLS.PersistentClasses,
  19. Stage.Manager,
  20. GLS.XCollection,
  21. GLS.Scene,
  22. GLS.Context,
  23. GLS.Texture,
  24. GLS.Objects,
  25. GLS.Color,
  26. GLS.Coordinates,
  27. GLS.RenderContextInfo,
  28. GLS.State,
  29. GLS.TerrainRenderer,
  30. GLS.Graph,
  31. ODE.Import,
  32. GLS.ODEUtils;
  33. type
  34. TGLODECustomCollisionEvent = procedure (Geom1, Geom2 : PdxGeom) of object;
  35. TGLODECollisionEvent = procedure (Sender : TObject; Object1, Object2 : TObject;
  36. var Contact:TdContact; var HandleCollision:Boolean) of object;
  37. TGLODEObjectCollisionEvent = procedure (Sender : TObject; Object2 : TObject;
  38. var Contact:TdContact; var HandleCollision:Boolean) of object;
  39. TGLODECollisionSurfaceMode = (csmMu2,csmFDir1,csmBounce,csmSoftERP,csmSoftCFM,
  40. csmMotion1,csmMotion2,csmSlip1,csmSlip2);
  41. TGLODESurfaceModes = set of TGLODECollisionSurfaceMode;
  42. TGLODESolverMethod = (osmDefault, osmStepFast, osmQuickStep);
  43. TGLODEElements = class;
  44. TGLODEBehaviour = class;
  45. TGLODEElementBase = class;
  46. TGLODEJointBase = class;
  47. // The visual component to manage behaviours of ODE objects
  48. TGLODEManager = class(TComponent)
  49. private
  50. FWorld: PdxWorld;
  51. FSpace: PdxSpace;
  52. FContactGroup: TdJointGroupID;
  53. FGravity: TGLCoordinates;
  54. FOnCollision: TGLODECollisionEvent;
  55. FOnCustomCollision: TGLODECustomCollisionEvent;
  56. FNumContactJoints,
  57. FMaxContacts: Integer;
  58. FODEBehaviours: TGLPersistentObjectList;
  59. FRFContactList: TList;
  60. FIterations: Integer;
  61. FSolver: TGLODESolverMethod;
  62. FContacts: array of TdContact;
  63. FContactGeoms: array of TdContactGeom;
  64. FRenderPoint: TGLRenderPoint;
  65. FVisible,
  66. FVisibleAtRunTime: Boolean;
  67. FGeomColorDynD,
  68. FGeomColorDynE,
  69. FGeomColorStat: TGLColor;
  70. protected
  71. procedure Loaded; override;
  72. procedure CalcContact(Object1, Object2: TObject; var Contact: TdContact);
  73. procedure Collision(g1, g2: PdxGeom);
  74. procedure GravityChange(Sender: TObject);
  75. procedure SetMaxContacts(const Value: Integer);
  76. procedure SetGravity(Value: TGLCoordinates);
  77. procedure SetIterations(const val: Integer);
  78. function GetODEBehaviour(index: Integer): TGLODEBehaviour;
  79. procedure RegisterODEBehaviour(ODEBehaviour: TGLODEBehaviour);
  80. procedure UnregisterODEBehaviour(ODEBehaviour: TGLODEBehaviour);
  81. procedure SetRenderPoint(const Value: TGLRenderPoint);
  82. procedure RenderEvent(Sender: TObject; var rci: TGLRenderContextInfo);
  83. procedure RenderPointFreed(Sender: TObject);
  84. procedure SetVisible(const Value: Boolean);
  85. procedure SetVisibleAtRunTime(const Value: Boolean);
  86. procedure SetGeomColorDynE(const Value: TGLColor);
  87. procedure GeomColorChangeDynE(Sender: TObject);
  88. procedure SetGeomColorDynD(const Value: TGLColor);
  89. procedure GeomColorChangeDynD(Sender: TObject);
  90. procedure SetGeomColorStat(const Value: TGLColor);
  91. procedure GeomColorChangeStat(Sender: TObject);
  92. property ODEBehaviours[index: Integer]: TGLODEBehaviour read GetODEBehaviour;
  93. public
  94. constructor Create(AOwner: TComponent); override;
  95. destructor Destroy; override;
  96. procedure Step(deltaTime: double);
  97. procedure NotifyChange(Sender: TObject);
  98. property World: PdxWorld read FWorld;
  99. property Space: PdxSpace read FSpace;
  100. property ContactGroup: TdJointGroupID read FContactGroup;
  101. property NumContactJoints: Integer read FNumContactJoints;
  102. published
  103. property Gravity: TGLCoordinates read FGravity write SetGravity;
  104. property OnCollision: TGLODECollisionEvent read FOnCollision write FOnCollision;
  105. property OnCustomCollision: TGLODECustomCollisionEvent read FOnCustomCollision write FOnCustomCollision;
  106. property Solver: TGLODESolverMethod read FSolver write FSolver;
  107. property Iterations: Integer read FIterations write SetIterations;
  108. property MaxContacts: Integer read FMaxContacts write SetMaxContacts;
  109. property RenderPoint: TGLRenderPoint read FRenderPoint write SetRenderPoint;
  110. property Visible: Boolean read FVisible write SetVisible;
  111. property VisibleAtRunTime: Boolean read FVisibleAtRunTime write SetVisibleAtRunTime;
  112. property GeomColorDynD: TGLColor read FGeomColorDynD write SetGeomColorDynD;
  113. property GeomColorDynE: TGLColor read FGeomColorDynE write SetGeomColorDynE;
  114. property GeomColorStat: TGLColor read FGeomColorStat write SetGeomColorStat;
  115. end;
  116. TGLODECollisionSurface = class(TPersistent)
  117. private
  118. FOwner: TPersistent;
  119. FSurfaceParams: TdSurfaceParameters;
  120. FRFCoeff: Single;
  121. FRFEnabled: Boolean;
  122. protected
  123. procedure WriteToFiler(writer: TWriter);
  124. procedure ReadFromFiler(reader: TReader);
  125. function GetSurfaceMode: TGLODESurfaceModes;
  126. function GetMu: TdReal;
  127. function GetMu2: TdReal;
  128. function GetBounce: TdReal;
  129. function GetBounce_Vel: TdReal;
  130. function GetSoftERP: TdReal;
  131. function GetSoftCFM: TdReal;
  132. function GetMotion1: TdReal;
  133. function GetMotion2: TdReal;
  134. function GetSlip1: TdReal;
  135. function GetSlip2: TdReal;
  136. procedure SetSurfaceMode(Value: TGLODESurfaceModes);
  137. procedure SetMu(Value: TdReal);
  138. procedure SetMu2(Value: TdReal);
  139. procedure SetBounce(Value: TdReal);
  140. procedure SetBounce_Vel(Value: TdReal);
  141. procedure SetSoftERP(Value: TdReal);
  142. procedure SetSoftCFM(Value: TdReal);
  143. procedure SetMotion1(Value: TdReal);
  144. procedure SetMotion2(Value: TdReal);
  145. procedure SetSlip1(Value: TdReal);
  146. procedure SetSlip2(Value: TdReal);
  147. public
  148. constructor Create(AOwner: TPersistent);
  149. function GetOwner: TPersistent; override;
  150. procedure Assign(Source: TPersistent); override;
  151. published
  152. property RollingFrictionCoeff: Single read FRFCoeff write FRFCoeff;
  153. property RollingFrictionEnabled: Boolean read FRFEnabled write FRFEnabled;
  154. property SurfaceMode: TGLODESurfaceModes read GetSurfaceMode write SetSurfaceMode;
  155. property Mu: TdReal read GetMu write SetMu;
  156. property Mu2: TdReal read GetMu2 write SetMu2;
  157. property Bounce: TdReal read GetBounce write SetBounce;
  158. property Bounce_Vel: TdReal read GetBounce_Vel write SetBounce_Vel;
  159. property SoftERP: TdReal read GetSoftERP write SetSoftERP;
  160. property SoftCFM: TdReal read GetSoftCFM write SetSoftCFM;
  161. property Motion1: TdReal read GetMotion1 write SetMotion1;
  162. property Motion2: TdReal read GetMotion2 write SetMotion2;
  163. property Slip1: TdReal read GetSlip1 write SetSlip1;
  164. property Slip2: TdReal read GetSlip2 write SetSlip2;
  165. end;
  166. TGLODEElementClass = class of TGLODEElementBase;
  167. // Basis structures for behaviour style implementations
  168. TGLODEBehaviour = class(TGLBehaviour)
  169. private
  170. FManager: TGLODEManager;
  171. FManagerName: String;
  172. FSurface: TGLODECollisionSurface;
  173. FOnCollision: TGLODEObjectCollisionEvent;
  174. FInitialized: Boolean;
  175. FOwnerBaseSceneObject: TGLBaseSceneObject;
  176. protected
  177. procedure Initialize; virtual;
  178. procedure Finalize; virtual;
  179. procedure WriteToFiler(writer: TWriter); override;
  180. procedure ReadFromFiler(reader: TReader); override;
  181. procedure Loaded; override;
  182. procedure SetManager(Value: TGLODEManager);
  183. procedure SetSurface(Value: TGLODECollisionSurface);
  184. function GetAbsoluteMatrix: TGLMatrix;
  185. public
  186. constructor Create(AOwner: TXCollection); override;
  187. destructor Destroy; override;
  188. procedure NotifyChange(Sender: TObject);
  189. procedure Render(var rci: TGLRenderContextInfo); virtual;
  190. procedure Reinitialize;
  191. property Initialized: Boolean read FInitialized;
  192. property AbsoluteMatrix: TGLMatrix read GetAbsoluteMatrix;
  193. published
  194. property Manager: TGLODEManager read FManager write SetManager;
  195. property Surface: TGLODECollisionSurface read FSurface write SetSurface;
  196. property OnCollision: TGLODEObjectCollisionEvent read FOnCollision write FOnCollision;
  197. end;
  198. TGLODEDynamic = class(TGLODEBehaviour)
  199. private
  200. FBody: PdxBody;
  201. FMass: TdMass;
  202. FElements: TGLODEElements;
  203. FEnabled: Boolean;
  204. FJointRegister: TList;
  205. protected
  206. procedure Initialize; override;
  207. procedure Finalize; override;
  208. procedure WriteToFiler(writer: TWriter); override;
  209. procedure ReadFromFiler(reader: TReader); override;
  210. procedure SetMass(const Value: TdMass);
  211. function GetMass: TdMass;
  212. procedure AlignBodyToMatrix(Mat: TGLMatrix);
  213. procedure SetEnabled(const Value: Boolean);
  214. function GetEnabled: Boolean;
  215. procedure RegisterJoint(Joint: TGLODEJointBase);
  216. procedure UnregisterJoint(Joint: TGLODEJointBase);
  217. public
  218. constructor Create(AOwner: TXCollection); override;
  219. destructor Destroy; override;
  220. procedure Render(var rci: TGLRenderContextInfo); override;
  221. class function FriendlyName: String; override;
  222. class function UniqueItem: Boolean; override;
  223. function AddNewElement(AChild: TGLODEElementClass): TGLODEElementBase; dynamic;
  224. procedure AlignObject;
  225. function CalculateMass: TdMass;
  226. procedure CalibrateCenterOfMass;
  227. procedure AddForce(Force: TAffineVector);
  228. procedure AddForceAtPos(Force, Pos: TAffineVector);
  229. procedure AddForceAtRelPos(Force, Pos: TAffineVector);
  230. procedure AddRelForce(Force: TAffineVector);
  231. procedure AddRelForceAtPos(Force, Pos: TAffineVector);
  232. procedure AddRelForceAtRelPos(Force, Pos: TAffineVector);
  233. procedure AddTorque(Torque: TAffineVector);
  234. procedure AddRelTorque(Torque: TAffineVector);
  235. property Body: PdxBody read FBody;
  236. property Mass: TdMass read GetMass write SetMass;
  237. published
  238. property Elements: TGLODEElements read FElements;
  239. property Enabled: Boolean read GetEnabled write SetEnabled;
  240. end;
  241. TGLODEStatic = class(TGLODEBehaviour)
  242. private
  243. FElements: TGLODEElements;
  244. protected
  245. procedure Initialize; override;
  246. procedure Finalize; override;
  247. procedure WriteToFiler(writer: TWriter); override;
  248. procedure ReadFromFiler(reader: TReader); override;
  249. procedure AlignElements;
  250. public
  251. constructor Create(AOwner: TXCollection); override;
  252. destructor Destroy; override;
  253. procedure Render(var rci: TGLRenderContextInfo); override;
  254. class function FriendlyName: String; override;
  255. class function UniqueItem: Boolean; override;
  256. function AddNewElement(AChild: TGLODEElementClass): TGLODEElementBase; dynamic;
  257. published
  258. property Elements: TGLODEElements read FElements;
  259. end;
  260. TGLODEElements = class(TXCollection)
  261. private
  262. function GetElement(index: Integer): TGLODEElementBase;
  263. public
  264. destructor Destroy; override;
  265. class function ItemsClass: TXCollectionItemClass; override;
  266. procedure Initialize;
  267. procedure Finalize;
  268. procedure NotifyChange(Sender: TObject);
  269. procedure Render(var rci: TGLRenderContextInfo);
  270. property Element[index: Integer]: TGLODEElementBase read GetElement;
  271. end;
  272. TGLODEElementBase = class(TXCollectionItem)
  273. private
  274. FMass: TdMass;
  275. FDensity: TdReal;
  276. FGeomTransform,
  277. FGeomElement: PdxGeom;
  278. FPosition,
  279. FDirection,
  280. FUp: TGLCoordinates;
  281. FLocalMatrix: TGLMatrix;
  282. FRealignODE,
  283. FInitialized,
  284. FDynamic,
  285. FIsCalculating: Boolean;
  286. protected
  287. procedure Initialize; virtual;
  288. procedure Finalize; virtual;
  289. function CalculateMass: TdMass; virtual;
  290. procedure ODERebuild; virtual;
  291. procedure NotifyChange(Sender: TObject);
  292. procedure CoordinateChanged(Sender: TObject);
  293. procedure WriteToFiler(writer: TWriter); override;
  294. procedure ReadFromFiler(reader: TReader); override;
  295. function IsODEInitialized: Boolean;
  296. procedure AlignGeomElementToMatrix(Mat: TGLMatrix); virtual;
  297. procedure SetGeomElement(aGeom: PdxGeom);
  298. procedure RebuildMatrix;
  299. procedure RebuildVectors;
  300. procedure SetDensity(const Value: TdReal);
  301. procedure SetMatrix(const Value: TGLMatrix);
  302. function GetMatrix: TGLMatrix;
  303. procedure SetPosition(const Value: TGLCoordinates);
  304. procedure SetDirection(const Value: TGLCoordinates);
  305. procedure SetUp(const Value: TGLCoordinates);
  306. public
  307. constructor Create(AOwner: TXCollection); override;
  308. destructor Destroy; override;
  309. procedure Render(var rci: TGLRenderContextInfo); virtual;
  310. function AbsoluteMatrix: TGLMatrix;
  311. function AbsolutePosition: TAffineVector;
  312. property Matrix: TGLMatrix read GetMatrix write SetMatrix;
  313. property GeomTransform: PdxGeom read FGeomTransform;
  314. property Geom: PdxGeom read FGeomElement;
  315. property Initialized: Boolean read FInitialized;
  316. published
  317. property Density: TdReal read FDensity write SetDensity;
  318. property Position: TGLCoordinates read FPosition write SetPosition;
  319. property Direction: TGLCoordinates read FDirection write SetDirection;
  320. property Up: TGLCoordinates read FUp write SetUp;
  321. end;
  322. // ODE box implementation
  323. TGLODEElementBox = class(TGLODEElementBase)
  324. private
  325. FBoxWidth,
  326. FBoxHeight,
  327. FBoxDepth: TdReal;
  328. protected
  329. procedure Initialize; override;
  330. function CalculateMass: TdMass; override;
  331. procedure ODERebuild; override;
  332. procedure WriteToFiler(writer: TWriter); override;
  333. procedure ReadFromFiler(reader: TReader); override;
  334. function GetBoxWidth: TdReal;
  335. function GetBoxHeight: TdReal;
  336. function GetBoxDepth: TdReal;
  337. procedure SetBoxWidth(const Value: TdReal);
  338. procedure SetBoxHeight(const Value: TdReal);
  339. procedure SetBoxDepth(const Value: TdReal);
  340. public
  341. constructor Create(AOwner: TXCollection); override;
  342. procedure Render(var rci: TGLRenderContextInfo); override;
  343. class function FriendlyName: String; override;
  344. class function FriendlyDescription: String; override;
  345. class function ItemCategory: String; override;
  346. published
  347. property BoxWidth: TdReal read GetBoxWidth write SetBoxWidth;
  348. property BoxHeight: TdReal read GetBoxHeight write SetBoxHeight;
  349. property BoxDepth: TdReal read GetBoxDepth write SetBoxDepth;
  350. end;
  351. // ODE sphere implementation
  352. TGLODEElementSphere = class(TGLODEElementBase)
  353. private
  354. FRadius: TdReal;
  355. protected
  356. procedure Initialize; override;
  357. function CalculateMass: TdMass; override;
  358. procedure ODERebuild; override;
  359. procedure WriteToFiler(writer: TWriter); override;
  360. procedure ReadFromFiler(reader: TReader); override;
  361. function GetRadius: TdReal;
  362. procedure SetRadius(const Value: TdReal);
  363. public
  364. constructor Create(AOwner: TXCollection); override;
  365. procedure Render(var rci: TGLRenderContextInfo); override;
  366. class function FriendlyName: String; override;
  367. class function FriendlyDescription: String; override;
  368. class function ItemCategory: String; override;
  369. published
  370. property Radius: TdReal read GetRadius write SetRadius;
  371. end;
  372. // ODE capped cylinder implementation
  373. TGLODEElementCapsule = class(TGLODEElementBase)
  374. private
  375. FRadius,
  376. FLength: TdReal;
  377. protected
  378. procedure Initialize; override;
  379. function CalculateMass: TdMass; override;
  380. procedure ODERebuild; override;
  381. procedure WriteToFiler(writer: TWriter); override;
  382. procedure ReadFromFiler(reader: TReader); override;
  383. function GetRadius: TdReal;
  384. function GetLength: TdReal;
  385. procedure SetRadius(const Value: TdReal);
  386. procedure SetLength(const Value: TdReal);
  387. public
  388. constructor Create(AOwner: TXCollection); override;
  389. procedure Render(var rci: TGLRenderContextInfo); override;
  390. class function FriendlyName: String; override;
  391. class function FriendlyDescription: String; override;
  392. class function ItemCategory: String; override;
  393. published
  394. property Radius: TdReal read GetRadius write SetRadius;
  395. property Length: TdReal read GetLength write SetLength;
  396. end;
  397. // ODE cylinder implementation
  398. TGLODEElementCylinder = class(TGLODEElementBase)
  399. private
  400. FRadius,
  401. FLength: TdReal;
  402. protected
  403. procedure Initialize; override;
  404. function CalculateMass: TdMass; override;
  405. procedure ODERebuild; override;
  406. procedure WriteToFiler(writer: TWriter); override;
  407. procedure ReadFromFiler(reader: TReader); override;
  408. function GetRadius: TdReal;
  409. function GetLength: TdReal;
  410. procedure SetRadius(const Value: TdReal);
  411. procedure SetLength(const Value: TdReal);
  412. public
  413. constructor Create(AOwner: TXCollection); override;
  414. procedure Render(var rci: TGLRenderContextInfo); override;
  415. class function FriendlyName: String; override;
  416. class function FriendlyDescription: String; override;
  417. class function ItemCategory: String; override;
  418. published
  419. property Radius: TdReal read GetRadius write SetRadius;
  420. property Length: TdReal read GetLength write SetLength;
  421. end;
  422. // ODE tri-mesh implementation
  423. TGLODEElementTriMesh = class(TGLODEElementBase)
  424. private
  425. FTriMeshData: PdxTriMeshData;
  426. FVertices: TGLAffineVectorList;
  427. FIndices: TGLIntegerList;
  428. protected
  429. procedure Initialize; override;
  430. procedure Finalize; override;
  431. function CalculateMass: TdMass; override;
  432. procedure WriteToFiler(writer: TWriter); override;
  433. procedure ReadFromFiler(reader: TReader); override;
  434. procedure SetVertices(const Value: TGLAffineVectorList);
  435. procedure SetIndices(const Value: TGLIntegerList);
  436. public
  437. constructor Create(AOwner: TXCollection); override;
  438. destructor Destroy; override;
  439. class function FriendlyName: String; override;
  440. class function FriendlyDescription: String; override;
  441. class function ItemCategory: String; override;
  442. procedure RefreshTriMeshData;
  443. property Vertices: TGLAffineVectorList read FVertices write SetVertices;
  444. property Indices: TGLIntegerList read FIndices write SetIndices;
  445. end;
  446. // ODE plane implementation
  447. TGLODEElementPlane = class(TGLODEElementBase)
  448. protected
  449. procedure Initialize; override;
  450. procedure WriteToFiler(writer: TWriter); override;
  451. procedure ReadFromFiler(reader: TReader); override;
  452. procedure AlignGeomElementToMatrix(Mat: TGLMatrix); override;
  453. public
  454. class function FriendlyName: String; override;
  455. class function FriendlyDescription: String; override;
  456. class function ItemCategory: String; override;
  457. class function CanAddTo(collection: TXCollection): Boolean; override;
  458. end;
  459. // An XCollection decendant for ODE Joints
  460. TGLODEJoints = class(TXCollection)
  461. protected
  462. function GetJoint(index: Integer): TGLODEJointBase;
  463. public
  464. class function ItemsClass: TXCollectionItemClass; override;
  465. procedure Initialize;
  466. procedure Finalize;
  467. property Joint[index: Integer]: TGLODEJointBase read GetJoint; default;
  468. end;
  469. // Component front-end for storing ODE Joints
  470. TGLODEJointList = class(TComponent)
  471. private
  472. FJoints: TGLODEJoints;
  473. protected
  474. procedure WriteJoints(stream: TStream);
  475. procedure ReadJoints(stream: TStream);
  476. procedure DefineProperties(Filer: TFiler); override;
  477. procedure Loaded; override;
  478. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  479. public
  480. constructor Create(AOwner: TComponent); override;
  481. destructor Destroy; override;
  482. published
  483. property Joints: TGLODEJoints read FJoints;
  484. end;
  485. TGLODEJointOption = (joBothObjectsMustBeAssigned);
  486. TGLODEJointOptions = set of TGLODEJointOption;
  487. // Base structures for ODE Joints
  488. TGLODEJointBase = class(TXCollectionItem)
  489. private
  490. FJointID: TdJointID;
  491. FObject1,
  492. FObject2: TGLBaseSceneObject;
  493. FManager: TGLODEManager;
  494. FObject1Name,
  495. FObject2Name,
  496. FManagerName: String;
  497. FInitialized,
  498. FEnabled: Boolean;
  499. FJointOptions : TGLODEJointOptions;
  500. protected
  501. procedure WriteToFiler(writer: TWriter); override;
  502. procedure ReadFromFiler(reader: TReader); override;
  503. procedure Loaded; override;
  504. function IsODEInitialized: Boolean;
  505. procedure RegisterJointWithObject(Obj: TGLBaseSceneObject);
  506. procedure UnregisterJointWithObject(Obj: TGLBaseSceneObject);
  507. procedure Attach;
  508. procedure SetManager(const Value: TGLODEManager);
  509. procedure SetObject1(const Value: TGLBaseSceneObject);
  510. procedure SetObject2(const Value: TGLBaseSceneObject);
  511. procedure SetEnabled(const Value: Boolean);
  512. procedure SetJointOptions(const Value : TGLODEJointOptions);
  513. property JointOptions : TGLODEJointOptions read FJointOptions write SetJointOptions;
  514. public
  515. constructor Create(AOwner: TXCollection); override;
  516. destructor Destroy; override;
  517. procedure StructureChanged; virtual;
  518. procedure Initialize; virtual;
  519. procedure Finalize; virtual;
  520. function IsAttached: Boolean;
  521. procedure DoLoaded;
  522. property JointID: TdJointID read FJointID;
  523. property Initialized: Boolean read FInitialized;
  524. published
  525. property Manager: TGLODEManager read FManager write SetManager;
  526. property Object1: TGLBaseSceneObject read FObject1 write SetObject1;
  527. property Object2: TGLBaseSceneObject read FObject2 write SetObject2;
  528. property Enabled: Boolean read FEnabled write SetEnabled;
  529. end;
  530. TGLODESetParamCallback = function(Param: Integer; const Value: TdReal): Boolean of object;
  531. TGLODEGetParamCallback = function(Param: Integer; var Value: TdReal): Boolean of object;
  532. TGLODEJointParams = class(TPersistent)
  533. private
  534. FOwner: TPersistent;
  535. FSetCallback: TGLODESetParamCallback;
  536. FGetCallback: TGLODEGetParamCallback;
  537. FLoStop,
  538. FHiStop,
  539. FVel,
  540. FFMax,
  541. FFudgeFactor,
  542. FBounce,
  543. FCFM,
  544. FStopERP,
  545. FStopCFM,
  546. FSuspensionERP,
  547. FSuspensionCFM: TdReal;
  548. FFlagLoStop,
  549. FFlagHiStop,
  550. FFlagVel,
  551. FFlagFMax,
  552. FFlagFudgeFactor,
  553. FFlagBounce,
  554. FFlagCFM,
  555. FFlagStopERP,
  556. FFlagStopCFM,
  557. FFlagSuspensionERP,
  558. FFlagSuspensionCFM: Boolean;
  559. protected
  560. function GetLoStop: TdReal;
  561. function GetHiStop: TdReal;
  562. function GetVel: TdReal;
  563. function GetFMax: TdReal;
  564. function GetFudgeFactor: TdReal;
  565. function GetBounce: TdReal;
  566. function GetCFM: TdReal;
  567. function GetStopERP: TdReal;
  568. function GetStopCFM: TdReal;
  569. function GetSuspensionERP: TdReal;
  570. function GetSuspensionCFM: TdReal;
  571. procedure SetLoStop(const Value: TdReal);
  572. procedure SetHiStop(const Value: TdReal);
  573. procedure SetVel(const Value: TdReal);
  574. procedure SetFMax(const Value: TdReal);
  575. procedure SetFudgeFactor(const Value: TdReal);
  576. procedure SetBounce(const Value: TdReal);
  577. procedure SetCFM(const Value: TdReal);
  578. procedure SetStopERP(const Value: TdReal);
  579. procedure SetStopCFM(const Value: TdReal);
  580. procedure SetSuspensionERP(const Value: TdReal);
  581. procedure SetSuspensionCFM(const Value: TdReal);
  582. procedure WriteToFiler(writer: TWriter);
  583. procedure ReadFromFiler(reader: TReader);
  584. public
  585. constructor Create(AOwner: TPersistent);
  586. function GetOwner: TPersistent; override;
  587. procedure Assign(Source: TPersistent); override;
  588. procedure ApplyFlagged;
  589. property SetCallback: TGLODESetParamCallback read FSetCallback write FSetCallback;
  590. property GetCallback: TGLODEGetParamCallback read FGetCallback write FGetCallback;
  591. published
  592. property LoStop: TdReal read GetLoStop write SetLoStop;
  593. property HiStop: TdReal read GetHiStop write SetHiStop;
  594. property Vel: TdReal read GetVel write SetVel;
  595. property FMax: TdReal read GetFMax write SetFMax;
  596. property FudgeFactor: TdReal read GetFudgeFactor write SetFudgeFactor;
  597. property Bounce: TdReal read GetBounce write SetBounce;
  598. property CFM: TdReal read GetCFM write SetCFM;
  599. property StopERP: TdReal read GetStopERP write SetStopERP;
  600. property StopCFM: TdReal read GetStopCFM write SetStopCFM;
  601. property SuspensionERP: TdReal read GetSuspensionERP write SetSuspensionERP;
  602. property SuspensionCFM: TdReal read GetSuspensionCFM write SetSuspensionCFM;
  603. end;
  604. // ODE hinge joint implementation
  605. TGLODEJointHinge = class(TGLODEJointBase)
  606. private
  607. FAnchor,
  608. FAxis: TGLCoordinates;
  609. FAxisParams: TGLODEJointParams;
  610. protected
  611. procedure WriteToFiler(writer: TWriter); override;
  612. procedure ReadFromFiler(reader: TReader); override;
  613. procedure SetAnchor(const Value: TGLCoordinates);
  614. procedure SetAxis(const Value: TGLCoordinates);
  615. procedure AnchorChange(Sender: TObject);
  616. procedure AxisChange(Sender: TObject);
  617. procedure SetAxisParams(const Value: TGLODEJointParams);
  618. function SetAxisParam(Param: Integer; const Value: TdReal): Boolean;
  619. function GetAxisParam(Param: Integer; var Value: TdReal): Boolean;
  620. public
  621. constructor Create(AOwner: TXCollection); override;
  622. destructor Destroy; override;
  623. procedure StructureChanged; override;
  624. procedure Initialize; override;
  625. class function FriendlyName: String; override;
  626. class function FriendlyDescription: String; override;
  627. published
  628. property Anchor: TGLCoordinates read FAnchor write SetAnchor;
  629. property Axis: TGLCoordinates read FAxis write SetAxis;
  630. property AxisParams: TGLODEJointParams read FAxisParams write SetAxisParams;
  631. end;
  632. // ODE ball joint implementation
  633. TGLODEJointBall = class(TGLODEJointBase)
  634. private
  635. FAnchor: TGLCoordinates;
  636. protected
  637. procedure WriteToFiler(writer: TWriter); override;
  638. procedure ReadFromFiler(reader: TReader); override;
  639. procedure SetAnchor(const Value: TGLCoordinates);
  640. procedure AnchorChange(Sender: TObject);
  641. public
  642. constructor Create(AOwner: TXCollection); override;
  643. destructor Destroy; override;
  644. procedure StructureChanged; override;
  645. procedure Initialize; override;
  646. class function FriendlyName: String; override;
  647. class function FriendlyDescription: String; override;
  648. published
  649. property Anchor: TGLCoordinates read FAnchor write SetAnchor;
  650. end;
  651. // ODE slider joint implementation
  652. TGLODEJointSlider = class(TGLODEJointBase)
  653. private
  654. FAxis: TGLCoordinates;
  655. FAxisParams: TGLODEJointParams;
  656. protected
  657. procedure WriteToFiler(writer: TWriter); override;
  658. procedure ReadFromFiler(reader: TReader); override;
  659. procedure SetAxis(const Value: TGLCoordinates);
  660. procedure AxisChange(Sender: TObject);
  661. procedure SetAxisParams(const Value: TGLODEJointParams);
  662. function SetAxisParam(Param: Integer; const Value: TdReal): Boolean;
  663. function GetAxisParam(Param: Integer; var Value: TdReal): Boolean;
  664. public
  665. constructor Create(AOwner: TXCollection); override;
  666. destructor Destroy; override;
  667. procedure StructureChanged; override;
  668. procedure Initialize; override;
  669. class function FriendlyName: String; override;
  670. class function FriendlyDescription: String; override;
  671. published
  672. property Axis: TGLCoordinates read FAxis write SetAxis;
  673. property AxisParams: TGLODEJointParams read FAxisParams write SetAxisParams;
  674. end;
  675. // ODE fixed joint implementation
  676. TGLODEJointFixed = class(TGLODEJointBase)
  677. protected
  678. procedure WriteToFiler(writer: TWriter); override;
  679. procedure ReadFromFiler(reader: TReader); override;
  680. public
  681. class function FriendlyName: String; override;
  682. class function FriendlyDescription: String; override;
  683. procedure Initialize; override;
  684. end;
  685. // ODE hinge2 joint implementation
  686. TGLODEJointHinge2 = class(TGLODEJointBase)
  687. private
  688. FAnchor,
  689. FAxis1,
  690. FAxis2: TGLCoordinates;
  691. FAxis1Params,
  692. FAxis2Params: TGLODEJointParams;
  693. protected
  694. procedure WriteToFiler(writer: TWriter); override;
  695. procedure ReadFromFiler(reader: TReader); override;
  696. procedure SetAnchor(const Value: TGLCoordinates);
  697. procedure SetAxis1(const Value: TGLCoordinates);
  698. procedure SetAxis2(const Value: TGLCoordinates);
  699. procedure AnchorChange(Sender: TObject);
  700. procedure Axis1Change(Sender: TObject);
  701. procedure Axis2Change(Sender: TObject);
  702. procedure SetAxis1Params(const Value: TGLODEJointParams);
  703. procedure SetAxis2Params(const Value: TGLODEJointParams);
  704. function SetAxis1Param(Param: Integer; const Value: TdReal): Boolean;
  705. function SetAxis2Param(Param: Integer; const Value: TdReal): Boolean;
  706. function GetAxis1Param(Param: Integer; var Value: TdReal): Boolean;
  707. function GetAxis2Param(Param: Integer; var Value: TdReal): Boolean;
  708. public
  709. constructor Create(AOwner: TXCollection); override;
  710. destructor Destroy; override;
  711. procedure StructureChanged; override;
  712. procedure Initialize; override;
  713. class function FriendlyName: String; override;
  714. class function FriendlyDescription: String; override;
  715. published
  716. property Anchor: TGLCoordinates read FAnchor write SetAnchor;
  717. property Axis1: TGLCoordinates read FAxis1 write SetAxis1;
  718. property Axis2: TGLCoordinates read FAxis2 write SetAxis2;
  719. property Axis1Params: TGLODEJointParams read FAxis1Params write SetAxis1Params;
  720. property Axis2Params: TGLODEJointParams read FAxis2Params write SetAxis2Params;
  721. end;
  722. // ODE universal joint implementation
  723. TGLODEJointUniversal = class(TGLODEJointBase)
  724. private
  725. FAnchor,
  726. FAxis1,
  727. FAxis2: TGLCoordinates;
  728. FAxis1Params,
  729. FAxis2Params: TGLODEJointParams;
  730. protected
  731. procedure WriteToFiler(writer: TWriter); override;
  732. procedure ReadFromFiler(reader: TReader); override;
  733. procedure SetAnchor(const Value: TGLCoordinates);
  734. procedure SetAxis1(const Value: TGLCoordinates);
  735. procedure SetAxis2(const Value: TGLCoordinates);
  736. procedure AnchorChange(Sender: TObject);
  737. procedure Axis1Change(Sender: TObject);
  738. procedure Axis2Change(Sender: TObject);
  739. procedure SetAxis1Params(const Value: TGLODEJointParams);
  740. procedure SetAxis2Params(const Value: TGLODEJointParams);
  741. function SetAxis1Param(Param: Integer; const Value: TdReal): Boolean;
  742. function SetAxis2Param(Param: Integer; const Value: TdReal): Boolean;
  743. function GetAxis1Param(Param: Integer; var Value: TdReal): Boolean;
  744. function GetAxis2Param(Param: Integer; var Value: TdReal): Boolean;
  745. public
  746. constructor Create(AOwner: TXCollection); override;
  747. destructor Destroy; override;
  748. procedure Initialize; override;
  749. procedure StructureChanged; override;
  750. class function FriendlyName: String; override;
  751. class function FriendlyDescription: String; override;
  752. published
  753. property Anchor: TGLCoordinates read FAnchor write SetAnchor;
  754. property Axis1: TGLCoordinates read FAxis1 write SetAxis1;
  755. property Axis2: TGLCoordinates read FAxis2 write SetAxis2;
  756. property Axis1Params: TGLODEJointParams read FAxis1Params write SetAxis1Params;
  757. property Axis2Params: TGLODEJointParams read FAxis2Params write SetAxis2Params;
  758. end;
  759. TGLODEContactPoint = class
  760. public
  761. Position: TAffineVector;
  762. Normal: TAffineVector;
  763. Depth: Single;
  764. end;
  765. (*The custom collider is designed for generic contact handling. There is a
  766. contact point generator for sphere, box, capped cylinder, cylinder and cone geoms.
  767. Once the contact points for a collision are generated the abstract Collide
  768. function is called to generate the depth and the contact position and normal.
  769. These points are then sorted and the deepest are applied to ODE *)
  770. TGLODECustomCollider = class(TGLODEBehaviour)
  771. private
  772. FGeom: PdxGeom;
  773. FContactList,
  774. FContactCache: TList;
  775. FTransform: TGLMatrix;
  776. FContactResolution: Single;
  777. FRenderContacts: Boolean;
  778. FContactRenderPoints: TGLAffineVectorList;
  779. FPointSize: Single;
  780. FContactColor: TGLColor;
  781. protected
  782. procedure Initialize; override;
  783. procedure Finalize; override;
  784. procedure WriteToFiler(writer: TWriter); override;
  785. procedure ReadFromFiler(reader: TReader); override;
  786. // Test a position for a collision and fill out the contact information.
  787. function Collide(aPos: TAffineVector; var Depth: Single;
  788. var cPos, cNorm: TAffineVector): Boolean; virtual; abstract;
  789. // Clears the contact list so it's ready for another collision.
  790. procedure ClearContacts;
  791. // Add a contact point to the list for ApplyContacts to processes.
  792. procedure AddContact(x, y, z: TdReal); overload;
  793. procedure AddContact(pos: TAffineVector); overload;
  794. // Sort the current contact list and apply the deepest to ODE.
  795. function ApplyContacts(o1, o2: PdxGeom; flags: Integer;
  796. contact: PdContactGeom; skip: Integer): Integer;
  797. // Set the transform used that transforms contact points generated with AddContact
  798. procedure SetTransform(ATransform: TGLMatrix);
  799. procedure SetContactResolution(const Value: Single);
  800. procedure SetRenderContacts(const Value: Boolean);
  801. procedure SetPointSize(const Value: Single);
  802. procedure SetContactColor(const Value: TGLColor);
  803. public
  804. constructor Create(AOwner: TXCollection); override;
  805. destructor Destroy; override;
  806. procedure Render(var rci: TGLRenderContextInfo); override;
  807. property Geom: PdxGeom read FGeom;
  808. published
  809. (* Defines the resolution of the contact points created for the colliding
  810. Geom. The number of contact points generated change base don the size
  811. of the object and the ContactResolution. Lower values generate higher
  812. resolution contact boundaries, and thus smoother but slower collisions. *)
  813. property ContactResolution: Single read FContactResolution write SetContactResolution;
  814. (* Toggle contact point rendering on and off. (Rendered through the assigned
  815. Manager.RenderPoint. *)
  816. property RenderContacts: Boolean read FRenderContacts write SetRenderContacts;
  817. // Contact point rendering size (in pixels).
  818. property PointSize: Single read FPointSize write SetPointSize;
  819. // Contact point rendering color.
  820. property ContactColor: TGLColor read FContactColor write SetContactColor;
  821. end;
  822. (* Add this behaviour to a TGLHeightField or TGLTerrainRenderer to enable
  823. height based collisions for spheres, boxes, capped cylinders, cylinders and cones. *)
  824. TGLODEHeightField = class(TGLODECustomCollider)
  825. protected
  826. procedure WriteToFiler(writer: TWriter); override;
  827. procedure ReadFromFiler(reader: TReader); override;
  828. function Collide(aPos: TAffineVector; var Depth: Single;
  829. var cPos, cNorm: TAffineVector): Boolean; override;
  830. public
  831. constructor Create(AOwner: TXCollection); override;
  832. class function FriendlyName: string; override;
  833. class function FriendlyDescription: string; override;
  834. class function UniqueItem: Boolean; override;
  835. class function CanAddTo(collection: TXCollection): Boolean; override;
  836. end;
  837. (* ODE nearCallBack, throws near callback to the collision procedure
  838. of the ODE manager linked by the Data pointer *)
  839. procedure nearCallBack(Data: Pointer; o1, o2: PdxGeom); cdecl;
  840. { Helper functions for extracting data from objects with different inheritance. }
  841. function GetBodyFromObject(anObject: TObject): PdxBody;
  842. function GetBodyFromGLSceneObject(anObject: TGLBaseSceneObject): PdxBody;
  843. function GetSurfaceFromObject(anObject: TObject): TGLODECollisionSurface;
  844. // GLODEObject register methods (used for joint object persistence)
  845. procedure RegisterGLSceneObject(anObject: TGLBaseSceneObject);
  846. procedure UnregisterGLSceneObject(anObject: TGLBaseSceneObject);
  847. function GetGLSceneObject(anObjectName: String): TGLBaseSceneObject;
  848. // Get and GetOrCreate functions for ode behaviours
  849. function GetOdeStatic(obj: TGLBaseSceneObject): TGLODEStatic;
  850. function GetOrCreateOdeStatic(obj: TGLBaseSceneObject): TGLODEStatic;
  851. function GetOdeDynamic(obj: TGLBaseSceneObject): TGLODEDynamic;
  852. function GetOrCreateOdeDynamic(obj: TGLBaseSceneObject): TGLODEDynamic;
  853. // Get and GetOrCreate functions for ODE HeightField
  854. function GetODEHeightField(obj: TGLBaseSceneObject): TGLODEHeightField;
  855. function GetOrCreateODEHeightField(obj: TGLBaseSceneObject): TGLODEHeightField;
  856. var
  857. vODEObjectRegister: TList;
  858. vCustomColliderClass: TdGeomClass;
  859. vCustomColliderClassNum: Integer;
  860. // ------------------------------------------------------------------
  861. implementation
  862. // ------------------------------------------------------------------
  863. procedure nearCallBack(Data: Pointer; o1, o2: PdxGeom); cdecl;
  864. begin
  865. TGLODEManager(Data).Collision(o1, o2);
  866. end;
  867. function GetBodyFromObject(anObject: TObject): PdxBody;
  868. begin
  869. Result := nil;
  870. if Assigned(anObject) then
  871. if anObject is TGLODEDynamic then
  872. Result := TGLODEDynamic(anObject).Body;
  873. end;
  874. function GetBodyFromGLSceneObject(anObject: TGLBaseSceneObject): PdxBody;
  875. var
  876. temp: TGLODEDynamic;
  877. begin
  878. Result := nil;
  879. if Assigned(anObject) then
  880. begin
  881. temp := TGLODEDynamic(anObject.Behaviours.GetByClass(TGLODEDynamic));
  882. if temp <> nil then
  883. Result := temp.Body;
  884. end;
  885. end;
  886. function GetSurfaceFromObject(anObject: TObject): TGLODECollisionSurface;
  887. var
  888. ODEBehaviour: TGLODEBehaviour;
  889. begin
  890. Result := nil;
  891. if Assigned(anObject) then
  892. if anObject is TGLODEBehaviour then
  893. Result := TGLODEBehaviour(anObject).Surface
  894. else
  895. begin
  896. if (anObject is TGLBaseSceneObject) then
  897. begin
  898. ODEBehaviour := TGLODEBehaviour(TGLBaseSceneObject(anObject).Behaviours.GetByClass(TGLODEBehaviour));
  899. if Assigned(ODEBehaviour) then
  900. Result := ODEBehaviour.Surface
  901. end;
  902. end;
  903. end;
  904. function IsGLODEObject(Obj: TGLBaseSceneObject): Boolean;
  905. var
  906. temp: TGLODEDynamic;
  907. begin
  908. Result := False;
  909. if Assigned(Obj) then
  910. begin
  911. temp := TGLODEDynamic(Obj.Behaviours.GetByClass(TGLODEDynamic));
  912. Result := Assigned(temp);
  913. end;
  914. end;
  915. procedure RegisterGLSceneObject(anObject: TGLBaseSceneObject);
  916. begin
  917. if vODEObjectRegister.IndexOf(anObject) = -1 then
  918. vODEObjectRegister.Add(anObject);
  919. end;
  920. procedure UnregisterGLSceneObject(anObject: TGLBaseSceneObject);
  921. begin
  922. vODEObjectRegister.Remove(anObject);
  923. end;
  924. function GetGLSceneObject(anObjectName: String): TGLBaseSceneObject;
  925. var
  926. i: Integer;
  927. begin
  928. Result := nil;
  929. for i := 0 to vODEObjectRegister.Count - 1 do
  930. if TGLBaseSceneObject(vODEObjectRegister[i]).GetNamePath = anObjectName then
  931. begin
  932. Result := vODEObjectRegister[i];
  933. Exit;
  934. end;
  935. end;
  936. function GetODEStatic(Obj: TGLBaseSceneObject): TGLODEStatic;
  937. begin
  938. Result := TGLODEStatic(Obj.Behaviours.GetByClass(TGLODEStatic));
  939. end;
  940. function GetOrCreateOdeStatic(Obj: TGLBaseSceneObject): TGLODEStatic;
  941. begin
  942. Result := TGLODEStatic(Obj.GetOrCreateBehaviour(TGLODEStatic));
  943. end;
  944. function GetODEDynamic(Obj: TGLBaseSceneObject): TGLODEDynamic;
  945. begin
  946. Result := TGLODEDynamic(Obj.Behaviours.GetByClass(TGLODEDynamic));
  947. end;
  948. function GetOrCreateOdeDynamic(Obj: TGLBaseSceneObject): TGLODEDynamic;
  949. begin
  950. Result := TGLODEDynamic(Obj.GetOrCreateBehaviour(TGLODEDynamic));
  951. end;
  952. function GetODEHeightField(obj: TGLBaseSceneObject): TGLODEHeightField;
  953. begin
  954. Result:= TGLODEHeightField(obj.Behaviours.GetByClass(TGLODEHeightField));
  955. end;
  956. function GetOrCreateODEHeightField(obj: TGLBaseSceneObject): TGLODEHeightField;
  957. begin
  958. Result:= TGLODEHeightField(obj.GetOrCreateBehaviour(TGLODEHeightField));
  959. end;
  960. function GetColliderFromGeom(aGeom: PdxGeom): TGLODECustomCollider;
  961. var
  962. temp: TObject;
  963. begin
  964. Result:= nil;
  965. temp:= dGeomGetData(aGeom);
  966. if Assigned(temp) then
  967. if temp is TGLODECustomCollider then
  968. Result:= TGLODECustomCollider(temp);
  969. end;
  970. function ContactSort(Item1, Item2: Pointer): Integer;
  971. var
  972. c1, c2: TGLODEContactPoint;
  973. begin
  974. c1 := TGLODEContactPoint(Item1);
  975. c2 := TGLODEContactPoint(Item2);
  976. if c1.Depth > c2.Depth then
  977. result := -1
  978. else if c1.Depth = c2.Depth then
  979. result := 0
  980. else
  981. result := 1;
  982. end;
  983. function CollideSphere(o1, o2: PdxGeom; flags: Integer; contact: PdContactGeom;
  984. skip: Integer): Integer; cdecl;
  985. var
  986. Collider: TGLODECustomCollider;
  987. i, j, res: Integer;
  988. pos: PdVector3;
  989. R: PdMatrix3;
  990. rmat, mat: TGLMatrix;
  991. rad, dx, dy, dz: TdReal;
  992. begin
  993. Result := 0;
  994. Collider := GetColliderFromGeom(o1);
  995. if not Assigned(Collider) then
  996. exit;
  997. pos := dGeomGetPosition(o2);
  998. R := dGeomGetRotation(o2);
  999. ODERToGLSceneMatrix(mat, R^, pos^);
  1000. Collider.SetTransform(mat);
  1001. rad := dGeomSphereGetRadius(o2);
  1002. res := Round(10 * rad / Collider.ContactResolution);
  1003. if res < 8 then
  1004. res := 8;
  1005. Collider.AddContact(0, 0, -rad);
  1006. Collider.AddContact(0, 0, rad);
  1007. rmat := CreateRotationMatrixZ(2 * Pi / res);
  1008. for i := 0 to res - 1 do
  1009. begin
  1010. mat := MatrixMultiply(rmat, mat);
  1011. Collider.SetTransform(mat);
  1012. for j := -(res div 2) + 1 to (res div 2) - 1 do
  1013. begin
  1014. dx := rad * cos(j * Pi / res);
  1015. dy := 0;
  1016. dz := rad * sin(j * Pi / res);
  1017. Collider.AddContact(dx, dy, dz);
  1018. end;
  1019. end;
  1020. Result := Collider.ApplyContacts(o1, o2, flags, contact, skip);
  1021. Collider.SetTransform(IdentityHMGMatrix);
  1022. end;
  1023. function CollideBox(o1, o2: PdxGeom; flags: Integer; contact: PdContactGeom;
  1024. skip: Integer): Integer; cdecl;
  1025. var
  1026. Collider: TGLODECustomCollider;
  1027. i, j, res: Integer;
  1028. rcpres, len1, len2: Single;
  1029. s: TdVector3;
  1030. pos: PdVector3;
  1031. R: PdMatrix3;
  1032. mat: TGLMatrix;
  1033. begin
  1034. Result := 0;
  1035. Collider := GetColliderFromGeom(o1);
  1036. if not Assigned(Collider) then
  1037. exit;
  1038. pos := dGeomGetPosition(o2);
  1039. R := dGeomGetRotation(o2);
  1040. ODERToGLSceneMatrix(mat, R^, pos^);
  1041. Collider.SetTransform(mat);
  1042. dGeomBoxGetLengths(o2, s);
  1043. res := Round(Sqrt(MaxFloat([s[0], s[1], s[2]])) / Collider.ContactResolution);
  1044. if res < 1 then
  1045. res := 1;
  1046. rcpres := 1 / res;
  1047. s[0] := 0.5 * s[0];
  1048. s[1] := 0.5 * s[1];
  1049. s[2] := 0.5 * s[2];
  1050. with Collider do
  1051. begin
  1052. // Corners
  1053. AddContact(s[0], s[1], s[2]);
  1054. AddContact(s[0], s[1], -s[2]);
  1055. AddContact(s[0], -s[1], s[2]);
  1056. AddContact(s[0], -s[1], -s[2]);
  1057. AddContact(-s[0], s[1], s[2]);
  1058. AddContact(-s[0], s[1], -s[2]);
  1059. AddContact(-s[0], -s[1], s[2]);
  1060. AddContact(-s[0], -s[1], -s[2]);
  1061. // Edges
  1062. for i := -(res - 1) to (res - 1) do
  1063. begin
  1064. len1 := i * rcpres * s[0];
  1065. AddContact(len1, s[1], s[2]);
  1066. AddContact(len1, s[1], -s[2]);
  1067. AddContact(len1, -s[1], s[2]);
  1068. AddContact(len1, -s[1], -s[2]);
  1069. len1 := i * rcpres * s[1];
  1070. AddContact(s[0], len1, s[2]);
  1071. AddContact(s[0], len1, -s[2]);
  1072. AddContact(-s[0], len1, s[2]);
  1073. AddContact(-s[0], len1, -s[2]);
  1074. len1 := i * rcpres * s[2];
  1075. AddContact(s[0], s[1], len1);
  1076. AddContact(s[0], -s[1], len1);
  1077. AddContact(-s[0], s[1], len1);
  1078. AddContact(-s[0], -s[1], len1);
  1079. end;
  1080. // Faces
  1081. for i := -(res - 1) to (res - 1) do
  1082. for j := -(res - 1) to (res - 1) do
  1083. begin
  1084. len1 := i * rcpres * s[0];
  1085. len2 := j * rcpres * s[1];
  1086. AddContact(len1, len2, s[2]);
  1087. AddContact(len1, len2, -s[2]);
  1088. len2 := j * rcpres * s[2];
  1089. AddContact(len1, s[1], len2);
  1090. AddContact(len1, -s[1], len2);
  1091. len1 := i * rcpres * s[1];
  1092. AddContact(s[0], len1, len2);
  1093. AddContact(-s[0], len1, len2);
  1094. end;
  1095. end;
  1096. Result := Collider.ApplyContacts(o1, o2, flags, contact, skip);
  1097. Collider.SetTransform(IdentityHMGMatrix);
  1098. end;
  1099. function CollideCapsule(o1, o2: PdxGeom; flags: Integer; contact: PdContactGeom;
  1100. skip: Integer): Integer; cdecl;
  1101. var
  1102. Collider: TGLODECustomCollider;
  1103. i, j, res: Integer;
  1104. pos: PdVector3;
  1105. R: PdMatrix3;
  1106. mat, rmat: TGLMatrix;
  1107. rad, len, dx, dy, dz: TdReal;
  1108. begin
  1109. Result := 0;
  1110. Collider := GetColliderFromGeom(o1);
  1111. if not Assigned(Collider) then
  1112. exit;
  1113. pos := dGeomGetPosition(o2);
  1114. R := dGeomGetRotation(o2);
  1115. ODERToGLSceneMatrix(mat, R^, pos^);
  1116. Collider.SetTransform(mat);
  1117. dGeomCapsuleGetParams(o2, rad, len);
  1118. res := Round(5 * MaxFloat(4 * rad, len) / Collider.ContactResolution);
  1119. if res < 8 then
  1120. res := 8;
  1121. rmat := CreateRotationMatrixZ(2 * Pi / res);
  1122. with Collider do
  1123. begin
  1124. AddContact(0, 0, -rad - 0.5 * len);
  1125. AddContact(0, 0, rad + 0.5 * len);
  1126. for i := 0 to res - 1 do
  1127. begin
  1128. mat := MatrixMultiply(rmat, mat);
  1129. SetTransform(mat);
  1130. for j := 0 to res do
  1131. AddContact(rad, 0, len * (j / res - 0.5));
  1132. for j := 1 to (res div 2) - 1 do
  1133. begin
  1134. dx := rad * cos(j * Pi / res);
  1135. dy := 0;
  1136. dz := rad * sin(j * Pi / res);
  1137. Collider.AddContact(dx, dy, -dz - 0.5 * len);
  1138. Collider.AddContact(dx, dy, dz + 0.5 * len);
  1139. end;
  1140. end;
  1141. end;
  1142. Result := Collider.ApplyContacts(o1, o2, flags, contact, skip);
  1143. Collider.SetTransform(IdentityHMGMatrix);
  1144. end;
  1145. function CollideCylinder(o1, o2: PdxGeom; flags: Integer;
  1146. contact: PdContactGeom; skip: Integer): Integer; cdecl;
  1147. var
  1148. Collider: TGLODECustomCollider;
  1149. i, j, res: Integer;
  1150. pos: PdVector3;
  1151. R: PdMatrix3;
  1152. mat: TGLMatrix;
  1153. rad, len, dx, dy: TdReal;
  1154. begin
  1155. Result := 0;
  1156. Collider := GetColliderFromGeom(o1);
  1157. if not Assigned(Collider) then
  1158. exit;
  1159. pos := dGeomGetPosition(o2);
  1160. R := dGeomGetRotation(o2);
  1161. ODERToGLSceneMatrix(mat, R^, pos^);
  1162. Collider.SetTransform(mat);
  1163. dGeomCylinderGetParams(o2, rad, len);
  1164. res := Round(5 * MaxFloat(4 * rad, len) / Collider.ContactResolution);
  1165. if res < 8 then
  1166. res := 8;
  1167. with Collider do
  1168. begin
  1169. AddContact(0, -0.5 * len, 0);
  1170. AddContact(0, 0.5 * len, 0);
  1171. for i := 0 to res - 1 do
  1172. begin
  1173. SinCosine(2 * Pi * i / res, rad, dy, dx);
  1174. AddContact(dx, -0.5 * len, dy);
  1175. AddContact(dx, 0, dy);
  1176. AddContact(dx, 0.5 * len, dy);
  1177. for j := 0 to res do
  1178. AddContact(dx, len * (j / res - 0.5), dy);
  1179. for j := 1 to (res div 2) - 1 do
  1180. begin
  1181. SinCosine(2 * Pi * i / res, rad * j / (res div 2), dy, dx);
  1182. AddContact(dx, -0.5 * len, dy);
  1183. AddContact(dx, 0.5 * len, dy);
  1184. end;
  1185. end;
  1186. end;
  1187. Result := Collider.ApplyContacts(o1, o2, flags, contact, skip);
  1188. Collider.SetTransform(IdentityHMGMatrix);
  1189. end;
  1190. function GetCustomColliderFn(num: Integer): TdColliderFn; cdecl;
  1191. begin
  1192. if num = dSphereClass then
  1193. Result := CollideSphere
  1194. else if num = dBoxClass then
  1195. Result := CollideBox
  1196. else if num = dCapsuleClass then
  1197. Result := CollideCapsule
  1198. else if num = dCylinderClass then
  1199. Result := CollideCylinder
  1200. else
  1201. Result := nil;
  1202. end;
  1203. // ---------------
  1204. // --------------- TGLODEManager ---------------
  1205. // ---------------
  1206. constructor TGLODEManager.Create(AOwner: TComponent);
  1207. begin
  1208. FWorld := nil;
  1209. if not InitODE('') then
  1210. raise Exception.Create('ODE failed to initialize.');
  1211. inherited;
  1212. FODEBehaviours:= TGLPersistentObjectList.Create;
  1213. FRFContactList:= TList.Create;
  1214. FGravity:= TGLCoordinates.CreateInitialized(Self, NullHmgPoint, csVector);
  1215. FGravity.OnNotifyChange:= GravityChange;
  1216. FSolver:= osmDefault;
  1217. FIterations:= 3;
  1218. MaxContacts:= 8;
  1219. if not (csDesigning in ComponentState) then
  1220. begin
  1221. FWorld := dWorldCreate;
  1222. FSpace := dHashSpaceCreate(nil);
  1223. dWorldSetCFM(FWorld, 1E-5);
  1224. dWorldSetQuickStepNumIterations(FWorld, FIterations);
  1225. FContactGroup := dJointGroupCreate(100);
  1226. end;
  1227. FGeomColorDynD := TGLColor.CreateInitialized(Self, clrRed, GeomColorChangeDynD);
  1228. FGeomColorDynE := TGLColor.CreateInitialized(Self, clrLime, GeomColorChangeDynE);
  1229. FGeomColorStat := TGLColor.CreateInitialized(Self, clrBlue, GeomColorChangeStat);
  1230. RegisterManager(Self);
  1231. end;
  1232. destructor TGLODEManager.Destroy;
  1233. begin
  1234. RenderPoint := nil;
  1235. // Unregister everything
  1236. while FODEBehaviours.Count > 0 do
  1237. ODEBehaviours[0].Manager:= nil;
  1238. // Clean up everything
  1239. FODEBehaviours.Free;
  1240. FGravity.Free;
  1241. FRFContactList.Free;
  1242. if Assigned(FWorld) then
  1243. begin
  1244. dJointGroupEmpty(FContactGroup);
  1245. dJointGroupDestroy(FContactGroup);
  1246. dSpaceDestroy(FSpace);
  1247. dWorldDestroy(FWorld);
  1248. end;
  1249. FGeomColorDynD.Free;
  1250. FGeomColorDynE.Free;
  1251. FGeomColorStat.Free;
  1252. DeregisterManager(Self);
  1253. inherited Destroy;
  1254. end;
  1255. procedure TGLODEManager.RegisterODEBehaviour(ODEBehaviour: TGLODEBehaviour);
  1256. begin
  1257. FODEBehaviours.Add(ODEBehaviour);
  1258. end;
  1259. procedure TGLODEManager.UnregisterODEBehaviour(ODEBehaviour: TGLODEBehaviour);
  1260. begin
  1261. FODEBehaviours.Remove(ODEBehaviour);
  1262. end;
  1263. procedure TGLODEManager.Loaded;
  1264. begin
  1265. GravityChange(Self);
  1266. end;
  1267. procedure TGLODEManager.SetGravity(Value: TGLCoordinates);
  1268. begin
  1269. FGravity.SetPoint(Value.DirectX, Value.DirectY, Value.DirectZ);
  1270. end;
  1271. procedure TGLODEManager.GravityChange(Sender: TObject);
  1272. begin
  1273. if Assigned(FWorld) then
  1274. dWorldSetGravity(FWorld, FGravity.X, FGravity.Y, FGravity.Z);
  1275. end;
  1276. procedure TGLODEManager.CalcContact(Object1, Object2: TObject; var Contact: TdContact);
  1277. var
  1278. Surface1, Surface2: TGLODECollisionSurface;
  1279. Body1, Body2: PdxBody;
  1280. begin
  1281. Surface1 := GetSurfaceFromObject(Object1);
  1282. Surface2 := GetSurfaceFromObject(Object2);
  1283. if not(Assigned(Surface1) and Assigned(Surface2)) then
  1284. Exit;
  1285. with Contact.Surface do
  1286. begin
  1287. // Average the involved contact information and assign it to the contact.
  1288. // Better methods for contact calculation will be looked into in the future.
  1289. mode:= Surface1.FSurfaceParams.mode or Surface2.FSurfaceParams.mode;
  1290. Mu:= (Surface1.Mu + Surface2.Mu) * 0.5;
  1291. Mu2:= (Surface1.Mu2 + Surface2.Mu2) * 0.5;
  1292. Bounce:= (Surface1.Bounce + Surface2.Bounce) * 0.5;
  1293. Bounce_Vel:= (Surface1.Bounce_Vel + Surface2.Bounce_Vel) * 0.5;
  1294. soft_erp:= (Surface1.SoftERP + Surface2.SoftERP) * 0.5;
  1295. soft_cfm:= (Surface1.SoftCFM + Surface2.SoftCFM) * 0.5;
  1296. Motion1:= (Surface1.Motion1 + Surface2.Motion1) * 0.5;
  1297. Motion2:= (Surface1.Motion2 + Surface2.Motion2) * 0.5;
  1298. Slip1:= (Surface1.Slip1 + Surface2.Slip1) * 0.5;
  1299. Slip2:= (Surface1.Slip2 + Surface2.Slip2) * 0.5;
  1300. end;
  1301. // Rolling friction
  1302. Body1:= GetBodyFromObject(Object1);
  1303. Body2:= GetBodyFromObject(Object2);
  1304. if (Surface1.RollingFrictionEnabled) and Assigned(Body1) then
  1305. FRFContactList.Add(Object1);
  1306. if (Surface2.RollingFrictionEnabled) and Assigned(Body2) then
  1307. FRFContactList.Add(Object2);
  1308. end;
  1309. procedure TGLODEManager.Collision(g1, g2: PdxGeom);
  1310. var
  1311. i, flags, num_contacts: Integer;
  1312. Obj1, Obj2: Pointer;
  1313. b1, b2: PdxBody;
  1314. Joint: TdJointID;
  1315. HandleCollision: Boolean;
  1316. begin
  1317. // Check for custom collision handling event
  1318. if Assigned(FOnCustomCollision) then
  1319. begin
  1320. FOnCustomCollision(g1, g2);
  1321. Exit;
  1322. end;
  1323. Obj1:= dGeomGetData(g1);
  1324. Obj2:= dGeomGetData(g2);
  1325. b1:= dGeomGetBody(g1);
  1326. b2:= dGeomGetBody(g2);
  1327. // don't create contact between static objects
  1328. if not Assigned(b1) and not Assigned(b2) then
  1329. Exit;
  1330. if Assigned(b1) and Assigned(b2) then
  1331. if dAreConnected(b1, b2) = 1 then
  1332. Exit;
  1333. // Get the collisions
  1334. flags := $0000FFFF and FMaxContacts;
  1335. num_contacts := dCollide(g1, g2, flags, FContactGeoms[0], SizeOf(TdContactGeom));
  1336. // Set up the initial contact info
  1337. for i := 0 to num_contacts - 1 do
  1338. begin
  1339. FContacts[i].Geom := FContactGeoms[i];
  1340. end;
  1341. for i := 0 to num_contacts - 1 do
  1342. begin
  1343. HandleCollision := True;
  1344. if Assigned(Obj1) and Assigned(Obj2) then
  1345. begin
  1346. // Calculate the contact based on Obj1 and Obj2 surface info
  1347. CalcContact(Obj1, Obj2, FContacts[i]);
  1348. if Assigned(FOnCollision) then
  1349. begin
  1350. // Fire the Scene level OnCollision event for last minute
  1351. // customization to the contact before the contact joint
  1352. // is created
  1353. FOnCollision(Self, Obj1, Obj2, FContacts[i], HandleCollision);
  1354. end;
  1355. // Fire the OnCollision event for each object
  1356. if TObject(Obj1) is TGLODEBehaviour then
  1357. if Assigned(TGLODEBehaviour(Obj1).FOnCollision) then
  1358. TGLODEBehaviour(Obj1).FOnCollision(Self, Obj2, FContacts[i], HandleCollision);
  1359. if TObject(Obj2) is TGLODEBehaviour then
  1360. if Assigned(TGLODEBehaviour(Obj2).FOnCollision) then
  1361. TGLODEBehaviour(Obj2).FOnCollision(Self, Obj1, FContacts[i], HandleCollision);
  1362. end
  1363. else
  1364. begin
  1365. // Default surface values
  1366. FContacts[i].Surface.Mu := 1000;
  1367. end;
  1368. if HandleCollision then
  1369. begin
  1370. // Creates and assign the contact joint
  1371. Joint := dJointCreateContact(FWorld, FContactGroup, @FContacts[i]);
  1372. dJointAttach(Joint, b1, b2);
  1373. // Increment the number of contact joints this step
  1374. Inc(FNumContactJoints);
  1375. end;
  1376. end;
  1377. end;
  1378. procedure TGLODEManager.Step(deltaTime: double);
  1379. var
  1380. i: Integer;
  1381. vec: PdVector3;
  1382. Body: PdxBody;
  1383. Coeff: Single;
  1384. begin
  1385. if not Assigned(World) then
  1386. Exit;
  1387. // Reset the contact joint counter
  1388. FNumContactJoints:= 0;
  1389. // Align static elements to their GLScene parent objects
  1390. for i:= 0 to FODEBehaviours.Count - 1 do
  1391. if ODEBehaviours[i] is TGLODEStatic then
  1392. if ODEBehaviours[i].Initialized then
  1393. TGLODEStatic(ODEBehaviours[i]).AlignElements;
  1394. // Run ODE collisions and step the scene
  1395. dSpaceCollide(FSpace, Self, nearCallBack);
  1396. case FSolver of
  1397. osmDefault: dWorldStep(FWorld, deltaTime);
  1398. osmQuickStep: dWorldQuickStep(FWorld, deltaTime);
  1399. end;
  1400. dJointGroupEmpty(FContactGroup);
  1401. // Align dynamic objects to their ODE bodies
  1402. for i := 0 to FODEBehaviours.Count - 1 do
  1403. if ODEBehaviours[i] is TGLODEDynamic then
  1404. if ODEBehaviours[i].Initialized then
  1405. TGLODEDynamic(ODEBehaviours[i]).AlignObject;
  1406. // Process rolling friction
  1407. Coeff := 0;
  1408. Body := nil;
  1409. while FRFContactList.Count > 0 do
  1410. begin
  1411. if TObject(FRFContactList[0]) is TGLODEDynamic then
  1412. begin
  1413. Body := TGLODEDynamic(FRFContactList[0]).Body;
  1414. Coeff := 1 - (TGLODEDynamic(FRFContactList[0]).Surface.RollingFrictionCoeff /
  1415. TGLODEDynamic(FRFContactList[0]).Mass.Mass);
  1416. end;
  1417. vec := dBodyGetAngularVel(Body);
  1418. dBodySetAngularVel(Body, vec[0] * Coeff, vec[1] * Coeff, vec[2] * Coeff);
  1419. FRFContactList.Delete(0);
  1420. end;
  1421. end;
  1422. procedure TGLODEManager.NotifyChange(Sender: TObject);
  1423. begin
  1424. if Assigned(RenderPoint) then
  1425. RenderPoint.StructureChanged;
  1426. end;
  1427. procedure TGLODEManager.SetIterations(const val: Integer);
  1428. begin
  1429. FIterations := val;
  1430. if Assigned(FWorld) then
  1431. dWorldSetQuickStepNumIterations(FWorld, FIterations);
  1432. end;
  1433. procedure TGLODEManager.SetMaxContacts(const Value: Integer);
  1434. begin
  1435. if Value <> FMaxContacts then
  1436. begin
  1437. FMaxContacts := Value;
  1438. SetLength(FContacts, FMaxContacts);
  1439. SetLength(FContactGeoms, FMaxContacts);
  1440. end;
  1441. end;
  1442. function TGLODEManager.GetODEBehaviour(index: Integer): TGLODEBehaviour;
  1443. begin
  1444. Result := TGLODEBehaviour(FODEBehaviours[index]);
  1445. end;
  1446. procedure TGLODEManager.SetRenderPoint(const Value: TGLRenderPoint);
  1447. begin
  1448. if FRenderPoint <> Value then
  1449. begin
  1450. if Assigned(FRenderPoint) then
  1451. FRenderPoint.UnRegisterCallBack(RenderEvent);
  1452. FRenderPoint := Value;
  1453. if Assigned(FRenderPoint) then
  1454. FRenderPoint.RegisterCallBack(RenderEvent, RenderPointFreed);
  1455. end;
  1456. end;
  1457. procedure TGLODEManager.RenderEvent(Sender: TObject; var rci: TGLRenderContextInfo);
  1458. var
  1459. i: Integer;
  1460. begin
  1461. if not Visible then
  1462. Exit;
  1463. if not(csDesigning in ComponentState) then
  1464. if not VisibleAtRunTime then
  1465. Exit;
  1466. gl.PushAttrib(GL_ENABLE_BIT + GL_CURRENT_BIT + GL_POLYGON_BIT);
  1467. gl.Disable(GL_LIGHTING);
  1468. gl.Enable(GL_POLYGON_OFFSET_LINE);
  1469. gl.PolygonOffset(1, 2);
  1470. for i := 0 to FODEBehaviours.Count - 1 do
  1471. begin
  1472. if ODEBehaviours[i] is TGLODEDynamic then
  1473. if TGLODEDynamic(ODEBehaviours[i]).GetEnabled then
  1474. gl.Color4fv(PGLFloat(GeomColorDynE.AsAddress))
  1475. else
  1476. gl.Color4fv(PGLFloat(GeomColorDynD.AsAddress))
  1477. else
  1478. gl.Color4fv(PGLFloat(GeomColorStat.AsAddress));
  1479. ODEBehaviours[i].Render(rci);
  1480. end;
  1481. end;
  1482. procedure TGLODEManager.RenderPointFreed(Sender: TObject);
  1483. begin
  1484. FRenderPoint := nil;
  1485. end;
  1486. procedure TGLODEManager.SetVisible(const Value: Boolean);
  1487. begin
  1488. if Value <> FVisible then
  1489. begin
  1490. FVisible := Value;
  1491. NotifyChange(Self);
  1492. end;
  1493. end;
  1494. procedure TGLODEManager.SetVisibleAtRunTime(const Value: Boolean);
  1495. begin
  1496. if Value <> FVisibleAtRunTime then
  1497. begin
  1498. FVisibleAtRunTime := Value;
  1499. NotifyChange(Self);
  1500. end;
  1501. end;
  1502. procedure TGLODEManager.SetGeomColorDynD(const Value: TGLColor);
  1503. begin
  1504. FGeomColorDynD.Assign(Value);
  1505. NotifyChange(Self);
  1506. end;
  1507. procedure TGLODEManager.GeomColorChangeDynD(Sender: TObject);
  1508. begin
  1509. NotifyChange(Self);
  1510. end;
  1511. procedure TGLODEManager.SetGeomColorDynE(const Value: TGLColor);
  1512. begin
  1513. FGeomColorDynE.Assign(Value);
  1514. NotifyChange(Self);
  1515. end;
  1516. procedure TGLODEManager.GeomColorChangeDynE(Sender: TObject);
  1517. begin
  1518. NotifyChange(Self);
  1519. end;
  1520. procedure TGLODEManager.SetGeomColorStat(const Value: TGLColor);
  1521. begin
  1522. FGeomColorStat.Assign(Value);
  1523. NotifyChange(Self);
  1524. end;
  1525. procedure TGLODEManager.GeomColorChangeStat(Sender: TObject);
  1526. begin
  1527. NotifyChange(Self);
  1528. end;
  1529. // ---------------
  1530. // --------------- TGLODECollisionSurface ---------------
  1531. // ---------------
  1532. constructor TGLODECollisionSurface.Create(AOwner: TPersistent);
  1533. begin
  1534. inherited Create;
  1535. FOwner := AOwner;
  1536. Mu := 1000;
  1537. RollingFrictionEnabled := False;
  1538. RollingFrictionCoeff := 0.001; // Larger Coeff = more friction
  1539. end;
  1540. function TGLODECollisionSurface.GetOwner: TPersistent;
  1541. begin
  1542. Result := FOwner;
  1543. end;
  1544. procedure TGLODECollisionSurface.Assign(Source: TPersistent);
  1545. begin
  1546. inherited;
  1547. if not Assigned(Source) then
  1548. Exit;
  1549. if Source is TGLODECollisionSurface then
  1550. begin
  1551. RollingFrictionCoeff := TGLODECollisionSurface(Source).RollingFrictionCoeff;
  1552. RollingFrictionEnabled := TGLODECollisionSurface(Source).RollingFrictionEnabled;
  1553. SurfaceMode := TGLODECollisionSurface(Source).SurfaceMode;
  1554. Mu := TGLODECollisionSurface(Source).Mu;
  1555. Mu2 := TGLODECollisionSurface(Source).Mu2;
  1556. Bounce := TGLODECollisionSurface(Source).Bounce;
  1557. Bounce_Vel := TGLODECollisionSurface(Source).Bounce_Vel;
  1558. SoftERP := TGLODECollisionSurface(Source).SoftERP;
  1559. SoftCFM := TGLODECollisionSurface(Source).SoftCFM;
  1560. Motion1 := TGLODECollisionSurface(Source).Motion1;
  1561. Motion2 := TGLODECollisionSurface(Source).Motion2;
  1562. Slip1 := TGLODECollisionSurface(Source).Slip1;
  1563. Slip2 := TGLODECollisionSurface(Source).Slip2;
  1564. end;
  1565. end;
  1566. procedure TGLODECollisionSurface.WriteToFiler(writer: TWriter);
  1567. var
  1568. mode: TGLODESurfaceModes;
  1569. begin
  1570. with writer do
  1571. begin
  1572. WriteInteger(0);
  1573. WriteFloat(RollingFrictionCoeff);
  1574. WriteBoolean(RollingFrictionEnabled);
  1575. mode := SurfaceMode;
  1576. Write(mode, SizeOf(TGLODESurfaceModes));
  1577. WriteFloat(Mu);
  1578. WriteFloat(Mu2);
  1579. WriteFloat(Bounce);
  1580. WriteFloat(Bounce_Vel);
  1581. WriteFloat(SoftERP);
  1582. WriteFloat(SoftCFM);
  1583. WriteFloat(Motion1);
  1584. WriteFloat(Motion2);
  1585. WriteFloat(Slip1);
  1586. WriteFloat(Slip2);
  1587. end;
  1588. end;
  1589. procedure TGLODECollisionSurface.ReadFromFiler(reader: TReader);
  1590. var
  1591. archiveVersion: Integer;
  1592. mode: TGLODESurfaceModes;
  1593. begin
  1594. with reader do
  1595. begin
  1596. archiveVersion := ReadInteger;
  1597. Assert(archiveVersion = 0);
  1598. RollingFrictionCoeff := ReadFloat;
  1599. RollingFrictionEnabled := ReadBoolean;
  1600. Read(mode, SizeOf(TGLODESurfaceModes));
  1601. SurfaceMode := mode;
  1602. Mu := ReadFloat;
  1603. Mu2 := ReadFloat;
  1604. Bounce := ReadFloat;
  1605. Bounce_Vel := ReadFloat;
  1606. SoftERP := ReadFloat;
  1607. SoftCFM := ReadFloat;
  1608. Motion1 := ReadFloat;
  1609. Motion2 := ReadFloat;
  1610. Slip1 := ReadFloat;
  1611. Slip2 := ReadFloat;
  1612. end;
  1613. end;
  1614. function TGLODECollisionSurface.GetSurfaceMode: TGLODESurfaceModes;
  1615. var
  1616. ASurfaceModes: TGLODESurfaceModes;
  1617. begin
  1618. ASurfaceModes := [];
  1619. if (FSurfaceParams.mode and dContactSlip2) <> 0 then
  1620. ASurfaceModes := ASurfaceModes + [csmSlip2];
  1621. if (FSurfaceParams.mode and dContactSlip1) <> 0 then
  1622. ASurfaceModes := ASurfaceModes + [csmSlip1];
  1623. if (FSurfaceParams.mode and dContactMotion2) <> 0 then
  1624. ASurfaceModes := ASurfaceModes + [csmMotion2];
  1625. if (FSurfaceParams.mode and dContactMotion1) <> 0 then
  1626. ASurfaceModes := ASurfaceModes + [csmMotion1];
  1627. if (FSurfaceParams.mode and dContactSoftCFM) <> 0 then
  1628. ASurfaceModes := ASurfaceModes + [csmSoftCFM];
  1629. if (FSurfaceParams.mode and dContactSoftERP) <> 0 then
  1630. ASurfaceModes := ASurfaceModes + [csmSoftERP];
  1631. if (FSurfaceParams.mode and dContactBounce) <> 0 then
  1632. ASurfaceModes := ASurfaceModes + [csmBounce];
  1633. if (FSurfaceParams.mode and dContactFDir1) <> 0 then
  1634. ASurfaceModes := ASurfaceModes + [csmFDir1];
  1635. if (FSurfaceParams.mode and dContactMu2) <> 0 then
  1636. ASurfaceModes := ASurfaceModes + [csmMu2];
  1637. Result := ASurfaceModes;
  1638. end;
  1639. procedure TGLODECollisionSurface.SetSurfaceMode(Value: TGLODESurfaceModes);
  1640. var
  1641. AMode: Integer;
  1642. begin
  1643. AMode := 0;
  1644. if csmSlip2 in Value then
  1645. AMode := AMode or dContactSlip2;
  1646. if csmSlip1 in Value then
  1647. AMode := AMode or dContactSlip1;
  1648. if csmMotion2 in Value then
  1649. AMode := AMode or dContactMotion2;
  1650. if csmMotion1 in Value then
  1651. AMode := AMode or dContactMotion1;
  1652. if csmSoftCFM in Value then
  1653. AMode := AMode or dContactSoftCFM;
  1654. if csmSoftERP in Value then
  1655. AMode := AMode or dContactSoftERP;
  1656. if csmBounce in Value then
  1657. AMode := AMode or dContactBounce;
  1658. if csmFDir1 in Value then
  1659. AMode := AMode or dContactFDir1;
  1660. if csmMu2 in Value then
  1661. AMode := AMode or dContactMu2;
  1662. FSurfaceParams.mode := AMode;
  1663. end;
  1664. function TGLODECollisionSurface.GetMu: TdReal;
  1665. begin
  1666. Result := FSurfaceParams.Mu;
  1667. end;
  1668. function TGLODECollisionSurface.GetMu2: TdReal;
  1669. begin
  1670. Result := FSurfaceParams.Mu2;
  1671. end;
  1672. function TGLODECollisionSurface.GetBounce: TdReal;
  1673. begin
  1674. Result := FSurfaceParams.Bounce;
  1675. end;
  1676. function TGLODECollisionSurface.GetBounce_Vel: TdReal;
  1677. begin
  1678. Result := FSurfaceParams.Bounce_Vel;
  1679. end;
  1680. function TGLODECollisionSurface.GetSoftERP: TdReal;
  1681. begin
  1682. Result := FSurfaceParams.soft_erp;
  1683. end;
  1684. function TGLODECollisionSurface.GetSoftCFM: TdReal;
  1685. begin
  1686. Result := FSurfaceParams.soft_cfm;
  1687. end;
  1688. function TGLODECollisionSurface.GetMotion1: TdReal;
  1689. begin
  1690. Result := FSurfaceParams.Motion1;
  1691. end;
  1692. function TGLODECollisionSurface.GetMotion2: TdReal;
  1693. begin
  1694. Result := FSurfaceParams.Motion2;
  1695. end;
  1696. function TGLODECollisionSurface.GetSlip1: TdReal;
  1697. begin
  1698. Result := FSurfaceParams.Slip1;
  1699. end;
  1700. function TGLODECollisionSurface.GetSlip2: TdReal;
  1701. begin
  1702. Result := FSurfaceParams.Slip2;
  1703. end;
  1704. procedure TGLODECollisionSurface.SetMu(Value: TdReal);
  1705. begin
  1706. FSurfaceParams.Mu := Value;
  1707. end;
  1708. procedure TGLODECollisionSurface.SetMu2(Value: TdReal);
  1709. begin
  1710. FSurfaceParams.Mu2 := Value;
  1711. end;
  1712. procedure TGLODECollisionSurface.SetBounce(Value: TdReal);
  1713. begin
  1714. FSurfaceParams.Bounce := Value;
  1715. end;
  1716. procedure TGLODECollisionSurface.SetBounce_Vel(Value: TdReal);
  1717. begin
  1718. FSurfaceParams.Bounce_Vel := Value;
  1719. end;
  1720. procedure TGLODECollisionSurface.SetSoftERP(Value: TdReal);
  1721. begin
  1722. FSurfaceParams.soft_erp := Value;
  1723. end;
  1724. procedure TGLODECollisionSurface.SetSoftCFM(Value: TdReal);
  1725. begin
  1726. FSurfaceParams.soft_cfm := Value;
  1727. end;
  1728. procedure TGLODECollisionSurface.SetMotion1(Value: TdReal);
  1729. begin
  1730. FSurfaceParams.Motion1 := Value;
  1731. end;
  1732. procedure TGLODECollisionSurface.SetMotion2(Value: TdReal);
  1733. begin
  1734. FSurfaceParams.Motion2 := Value;
  1735. end;
  1736. procedure TGLODECollisionSurface.SetSlip1(Value: TdReal);
  1737. begin
  1738. FSurfaceParams.Slip1 := Value;
  1739. end;
  1740. procedure TGLODECollisionSurface.SetSlip2(Value: TdReal);
  1741. begin
  1742. FSurfaceParams.Slip2 := Value;
  1743. end;
  1744. // ---------------
  1745. // --------------- TGLODEBehaviour --------------
  1746. // ---------------
  1747. constructor TGLODEBehaviour.Create(AOwner: TXCollection);
  1748. begin
  1749. inherited;
  1750. FSurface := TGLODECollisionSurface.Create(Self);
  1751. FInitialized := False;
  1752. FOwnerBaseSceneObject := OwnerBaseSceneObject;
  1753. if Assigned(FOwnerBaseSceneObject) then
  1754. RegisterGLSceneObject(OwnerBaseSceneObject);
  1755. end;
  1756. destructor TGLODEBehaviour.Destroy;
  1757. begin
  1758. if Assigned(Manager) then
  1759. Manager := nil;
  1760. if Assigned(FOwnerBaseSceneObject) then
  1761. UnregisterGLSceneObject(FOwnerBaseSceneObject);
  1762. FSurface.Free;
  1763. inherited;
  1764. end;
  1765. procedure TGLODEBehaviour.Initialize;
  1766. begin
  1767. FInitialized := True;
  1768. end;
  1769. procedure TGLODEBehaviour.Finalize;
  1770. begin
  1771. FInitialized := False;
  1772. end;
  1773. procedure TGLODEBehaviour.Reinitialize;
  1774. begin
  1775. if Initialized then
  1776. Finalize;
  1777. Initialize;
  1778. end;
  1779. procedure TGLODEBehaviour.WriteToFiler(writer: TWriter);
  1780. begin
  1781. inherited;
  1782. with writer do
  1783. begin
  1784. WriteInteger(0); // Archive version
  1785. if Assigned(FManager) then
  1786. WriteString(FManager.GetNamePath)
  1787. else
  1788. WriteString('');
  1789. Surface.WriteToFiler(writer);
  1790. end;
  1791. end;
  1792. procedure TGLODEBehaviour.ReadFromFiler(reader: TReader);
  1793. begin
  1794. inherited;
  1795. with reader do
  1796. begin
  1797. Assert(ReadInteger = 0); // Archive version
  1798. FManagerName := ReadString;
  1799. Surface.ReadFromFiler(reader);
  1800. end;
  1801. end;
  1802. procedure TGLODEBehaviour.Loaded;
  1803. var
  1804. mng: TComponent;
  1805. begin
  1806. inherited;
  1807. if FManagerName <> '' then
  1808. begin
  1809. mng := FindManager(TGLODEManager, FManagerName);
  1810. if Assigned(mng) then
  1811. Manager := TGLODEManager(mng);
  1812. FManagerName := '';
  1813. end
  1814. end;
  1815. procedure TGLODEBehaviour.Render(var rci: TGLRenderContextInfo);
  1816. begin
  1817. // virtual
  1818. end;
  1819. procedure TGLODEBehaviour.NotifyChange(Sender: TObject);
  1820. begin
  1821. if Assigned(Manager) then
  1822. Manager.NotifyChange(Self);
  1823. end;
  1824. procedure TGLODEBehaviour.SetManager(Value: TGLODEManager);
  1825. begin
  1826. if FManager <> Value then
  1827. begin
  1828. if Assigned(FManager) then
  1829. begin
  1830. if Initialized then
  1831. Finalize;
  1832. FManager.UnregisterODEBehaviour(Self);
  1833. end;
  1834. FManager := Value;
  1835. if Assigned(FManager) then
  1836. begin
  1837. if not(csDesigning in TComponent(Owner.Owner).ComponentState) then
  1838. // mrqzzz moved here
  1839. Initialize;
  1840. FManager.RegisterODEBehaviour(Self);
  1841. end;
  1842. end;
  1843. end;
  1844. procedure TGLODEBehaviour.SetSurface(Value: TGLODECollisionSurface);
  1845. begin
  1846. FSurface.Assign(Value);
  1847. end;
  1848. function TGLODEBehaviour.GetAbsoluteMatrix: TGLMatrix;
  1849. begin
  1850. Result := IdentityHMGMatrix;
  1851. if Assigned(Owner.Owner) then
  1852. if Owner.Owner is TGLBaseSceneObject then
  1853. Result := TGLBaseSceneObject(Owner.Owner).AbsoluteMatrix;
  1854. end;
  1855. // ---------------
  1856. // --------------- TGLODEDynamic ---------------
  1857. // ---------------
  1858. constructor TGLODEDynamic.Create(AOwner: TXCollection);
  1859. begin
  1860. inherited;
  1861. FElements := TGLODEElements.Create(Self);
  1862. FJointRegister := TList.Create;
  1863. FEnabled := True;
  1864. end;
  1865. destructor TGLODEDynamic.Destroy;
  1866. begin
  1867. FElements.Free;
  1868. FJointRegister.Free;
  1869. inherited;
  1870. end;
  1871. procedure TGLODEDynamic.Render(var rci: TGLRenderContextInfo);
  1872. var
  1873. Mat: TGLMatrix;
  1874. begin
  1875. if Assigned(Owner.Owner) then
  1876. begin
  1877. rci.PipelineTransformation.Push;
  1878. Mat := TGLBaseSceneObject(Owner.Owner).AbsoluteMatrix;
  1879. rci.PipelineTransformation.ModelMatrix^ := Mat;
  1880. end;
  1881. Elements.Render(rci);
  1882. if Assigned(Owner.Owner) then
  1883. rci.PipelineTransformation.Pop;
  1884. end;
  1885. class function TGLODEDynamic.FriendlyName: String;
  1886. begin
  1887. Result := 'ODE Dynamic';
  1888. end;
  1889. procedure TGLODEDynamic.Initialize;
  1890. var
  1891. i: Integer;
  1892. begin
  1893. if (not Assigned(Manager)) or Assigned(FBody) or (FInitialized) then
  1894. Exit;
  1895. if not Assigned(Manager.World) then
  1896. Exit;
  1897. FBody := dBodyCreate(Manager.World);
  1898. AlignBodyToMatrix(OwnerBaseSceneObject.AbsoluteMatrix);
  1899. dMassSetZero(FMass);
  1900. FElements.Initialize;
  1901. CalculateMass;
  1902. CalibrateCenterOfMass;
  1903. if (FMass.Mass > 0) and (FBody <> nil) then // mrqzzz
  1904. dBodySetMass(FBody, @FMass);
  1905. Enabled := FEnabled;
  1906. for i := 0 to FJointRegister.Count - 1 do
  1907. TGLODEJointBase(FJointRegister[i]).Attach;
  1908. inherited;
  1909. end;
  1910. procedure TGLODEDynamic.Finalize;
  1911. var
  1912. i: Integer;
  1913. begin
  1914. if not FInitialized then
  1915. Exit;
  1916. FElements.Finalize;
  1917. if Assigned(FBody) then
  1918. begin
  1919. dBodyDestroy(FBody);
  1920. FBody := nil;
  1921. end;
  1922. dMassSetZero(FMass);
  1923. for i := 0 to FJointRegister.Count - 1 do
  1924. TGLODEJointBase(FJointRegister[i]).Attach;
  1925. inherited;
  1926. end;
  1927. procedure TGLODEDynamic.WriteToFiler(writer: TWriter);
  1928. begin
  1929. inherited;
  1930. with writer do
  1931. begin
  1932. WriteInteger(1); // Archive version
  1933. FElements.WriteToFiler(writer);
  1934. writer.WriteBoolean(FEnabled);
  1935. end;
  1936. end;
  1937. procedure TGLODEDynamic.ReadFromFiler(reader: TReader);
  1938. var
  1939. archiveVersion: Integer;
  1940. begin
  1941. inherited;
  1942. with reader do
  1943. begin
  1944. archiveVersion := ReadInteger;
  1945. Assert((archiveVersion >= 0) and (archiveVersion <= 1)); // Archive version
  1946. // version 0
  1947. FElements.ReadFromFiler(reader);
  1948. // version 1
  1949. if archiveVersion >= 1 then
  1950. begin
  1951. FEnabled := ReadBoolean;
  1952. end;
  1953. end;
  1954. end;
  1955. procedure TGLODEDynamic.RegisterJoint(Joint: TGLODEJointBase);
  1956. begin
  1957. if FJointRegister.IndexOf(Joint) = -1 then
  1958. FJointRegister.Add(Joint);
  1959. end;
  1960. procedure TGLODEDynamic.UnregisterJoint(Joint: TGLODEJointBase);
  1961. begin
  1962. if FJointRegister.IndexOf(Joint) > -1 then
  1963. FJointRegister.Remove(Joint);
  1964. end;
  1965. function TGLODEDynamic.AddNewElement(AChild: TGLODEElementClass): TGLODEElementBase;
  1966. var
  1967. calcmass: TdMass;
  1968. begin
  1969. Result := AChild.Create(FElements);
  1970. // FElements.Add(Result);
  1971. Result.Initialize;
  1972. calcmass := CalculateMass;
  1973. if (calcmass.Mass > 0) and (FBody <> nil) then // mrqzzz
  1974. dBodySetMass(FBody, @calcmass);
  1975. end;
  1976. procedure TGLODEDynamic.AlignObject;
  1977. var
  1978. Pos: PdVector3;
  1979. R: PdMatrix3;
  1980. m: TGLMatrix;
  1981. begin
  1982. Pos := dBodyGetPosition(Body);
  1983. R := dBodyGetRotation(Body);
  1984. ODERToGLSceneMatrix(m, R^, Pos^);
  1985. if OwnerBaseSceneObject.Parent is TGLBaseSceneObject then
  1986. m := MatrixMultiply(m, OwnerBaseSceneObject.Parent.InvAbsoluteMatrix);
  1987. OwnerBaseSceneObject.SetMatrix(m);
  1988. end;
  1989. procedure TGLODEDynamic.AlignBodyToMatrix(Mat: TGLMatrix);
  1990. var
  1991. R: TdMatrix3;
  1992. begin
  1993. if not Assigned(FBody) then
  1994. Exit;
  1995. R[0] := Mat.X.X;
  1996. R[1] := Mat.Y.X;
  1997. R[2] := Mat.Z.X;
  1998. R[3] := 0;
  1999. R[4] := Mat.X.Y;
  2000. R[5] := Mat.Y.Y;
  2001. R[6] := Mat.Z.Y;
  2002. R[7] := 0;
  2003. R[8] := Mat.X.Z;
  2004. R[9] := Mat.Y.Z;
  2005. R[10] := Mat.Z.Z;
  2006. R[11] := 0;
  2007. dBodySetRotation(FBody, R);
  2008. dBodySetPosition(FBody, Mat.W.X, Mat.W.Y, Mat.W.Z);
  2009. end;
  2010. function TGLODEDynamic.CalculateMass: TdMass;
  2011. var
  2012. i: Integer;
  2013. m: TdMass;
  2014. begin
  2015. dMassSetZero(FMass);
  2016. for i := 0 to Elements.Count - 1 do
  2017. begin
  2018. m := TGLODEElementBase(Elements[i]).CalculateMass;
  2019. dMassAdd(FMass, m);
  2020. end;
  2021. Result := FMass;
  2022. end;
  2023. procedure TGLODEDynamic.CalibrateCenterOfMass;
  2024. var
  2025. Pos: TAffineVector;
  2026. begin
  2027. SetAffineVector(Pos, FMass.c[0], FMass.c[1], FMass.c[2]);
  2028. NegateVector(Pos);
  2029. dMassTranslate(FMass, Pos.X, Pos.Y, Pos.Z);
  2030. end;
  2031. function TGLODEDynamic.GetMass: TdMass;
  2032. begin
  2033. dBodyGetMass(FBody, FMass);
  2034. Result := FMass;
  2035. end;
  2036. procedure TGLODEDynamic.SetMass(const Value: TdMass);
  2037. begin
  2038. FMass := Value;
  2039. if FMass.Mass > 0 then
  2040. dBodySetMass(FBody, @FMass);
  2041. end;
  2042. class function TGLODEDynamic.UniqueItem: Boolean;
  2043. begin
  2044. Result := True;
  2045. end;
  2046. procedure TGLODEDynamic.SetEnabled(const Value: Boolean);
  2047. begin
  2048. FEnabled := Value;
  2049. if Assigned(FBody) then
  2050. begin
  2051. if FEnabled then
  2052. dBodyEnable(FBody)
  2053. else
  2054. dBodyDisable(FBody);
  2055. end;
  2056. end;
  2057. function TGLODEDynamic.GetEnabled: Boolean;
  2058. begin
  2059. if Assigned(FBody) then
  2060. FEnabled := (dBodyIsEnabled(FBody) = 1);
  2061. Result := FEnabled;
  2062. end;
  2063. procedure TGLODEDynamic.AddForce(Force: TAffineVector);
  2064. begin
  2065. if Assigned(FBody) then
  2066. dBodyAddForce(FBody, Force.X, Force.Y, Force.Z);
  2067. end;
  2068. procedure TGLODEDynamic.AddForceAtPos(Force, Pos: TAffineVector);
  2069. begin
  2070. if Assigned(FBody) then
  2071. dBodyAddForceAtPos(FBody, Force.X, Force.Y, Force.Z, Pos.X,
  2072. Pos.Y, Pos.Z);
  2073. end;
  2074. procedure TGLODEDynamic.AddForceAtRelPos(Force, Pos: TAffineVector);
  2075. begin
  2076. if Assigned(FBody) then
  2077. dBodyAddForceAtRelPos(FBody, Force.X, Force.Y, Force.Z, Pos.X,
  2078. Pos.Y, Pos.Z);
  2079. end;
  2080. procedure TGLODEDynamic.AddRelForce(Force: TAffineVector);
  2081. begin
  2082. if Assigned(FBody) then
  2083. dBodyAddRelForce(FBody, Force.X, Force.Y, Force.Z);
  2084. end;
  2085. procedure TGLODEDynamic.AddRelForceAtPos(Force, Pos: TAffineVector);
  2086. begin
  2087. if Assigned(FBody) then
  2088. dBodyAddForceAtPos(FBody, Force.X, Force.Y, Force.Z, Pos.X, Pos.Y, Pos.Z);
  2089. end;
  2090. procedure TGLODEDynamic.AddRelForceAtRelPos(Force, Pos: TAffineVector);
  2091. begin
  2092. if Assigned(FBody) then
  2093. dBodyAddRelForceAtRelPos(FBody, Force.X, Force.Y, Force.Z, Pos.X, Pos.Y, Pos.Z);
  2094. end;
  2095. procedure TGLODEDynamic.AddTorque(Torque: TAffineVector);
  2096. begin
  2097. if Assigned(FBody) then
  2098. dBodyAddTorque(FBody, Torque.X, Torque.Y, Torque.Z);
  2099. end;
  2100. procedure TGLODEDynamic.AddRelTorque(Torque: TAffineVector);
  2101. begin
  2102. if Assigned(FBody) then
  2103. dBodyAddRelTorque(FBody, Torque.X, Torque.Y, Torque.Z);
  2104. end;
  2105. // ---------------
  2106. // --------------- TGLODEStatic ---------------
  2107. // ---------------
  2108. constructor TGLODEStatic.Create(AOwner: TXCollection);
  2109. begin
  2110. inherited;
  2111. FElements := TGLODEElements.Create(Self);
  2112. end;
  2113. destructor TGLODEStatic.Destroy;
  2114. begin
  2115. FElements.Free;
  2116. inherited;
  2117. end;
  2118. procedure TGLODEStatic.Render(var rci: TGLRenderContextInfo);
  2119. var
  2120. Mat: TGLMatrix;
  2121. begin
  2122. if Assigned(Owner.Owner) then
  2123. begin
  2124. rci.PipelineTransformation.Push;
  2125. Mat := TGLBaseSceneObject(Owner.Owner).AbsoluteMatrix;
  2126. rci.PipelineTransformation.ModelMatrix^ := Mat;
  2127. end;
  2128. Elements.Render(rci);
  2129. if Assigned(Owner.Owner) then
  2130. rci.PipelineTransformation.Pop;
  2131. end;
  2132. class function TGLODEStatic.FriendlyName: String;
  2133. begin
  2134. Result := 'ODE Static';
  2135. end;
  2136. class function TGLODEStatic.UniqueItem: Boolean;
  2137. begin
  2138. Result := True;
  2139. end;
  2140. procedure TGLODEStatic.Initialize;
  2141. begin
  2142. if (not Assigned(Manager)) or (FInitialized) then
  2143. Exit;
  2144. if not Assigned(Manager.Space) then
  2145. Exit;
  2146. FElements.Initialize;
  2147. inherited;
  2148. end;
  2149. procedure TGLODEStatic.Finalize;
  2150. begin
  2151. if not FInitialized then
  2152. Exit;
  2153. FElements.Finalize;
  2154. inherited;
  2155. end;
  2156. procedure TGLODEStatic.WriteToFiler(writer: TWriter);
  2157. begin
  2158. inherited;
  2159. with writer do
  2160. begin
  2161. WriteInteger(0); // Archive version
  2162. FElements.WriteToFiler(writer);
  2163. end;
  2164. end;
  2165. procedure TGLODEStatic.ReadFromFiler(reader: TReader);
  2166. begin
  2167. inherited;
  2168. with reader do
  2169. begin
  2170. Assert(ReadInteger = 0); // Archive version
  2171. FElements.ReadFromFiler(reader);
  2172. end;
  2173. end;
  2174. function TGLODEStatic.AddNewElement(AChild: TGLODEElementClass): TGLODEElementBase;
  2175. begin
  2176. Result := nil;
  2177. if not Assigned(Manager) then
  2178. Exit;
  2179. Result := AChild.Create(FElements);
  2180. FElements.Add(Result);
  2181. Result.Initialize;
  2182. end;
  2183. procedure TGLODEStatic.AlignElements;
  2184. var
  2185. i: Integer;
  2186. begin
  2187. if not FInitialized then
  2188. Exit;
  2189. for i := 0 to FElements.Count - 1 do
  2190. TGLODEElementBase(FElements[i]).AlignGeomElementToMatrix(
  2191. TGLODEElementBase(FElements[i]).AbsoluteMatrix);
  2192. end;
  2193. // ---------------
  2194. // --------------- TGLODEElements ---------------
  2195. // ---------------
  2196. destructor TGLODEElements.Destroy;
  2197. begin
  2198. Finalize;
  2199. inherited;
  2200. end;
  2201. function TGLODEElements.GetElement(index: Integer): TGLODEElementBase;
  2202. begin
  2203. Result := TGLODEElementBase(Items[index]);
  2204. end;
  2205. class function TGLODEElements.ItemsClass: TXCollectionItemClass;
  2206. begin
  2207. Result := TGLODEElementBase;
  2208. end;
  2209. procedure TGLODEElements.Initialize;
  2210. var
  2211. i: Integer;
  2212. begin
  2213. for i := 0 to Count - 1 do
  2214. TGLODEElementBase(Items[i]).Initialize;
  2215. end;
  2216. procedure TGLODEElements.Finalize;
  2217. var
  2218. i: Integer;
  2219. begin
  2220. for i := 0 to Count - 1 do
  2221. TGLODEElementBase(Items[i]).Finalize;
  2222. end;
  2223. procedure TGLODEElements.Render(var rci: TGLRenderContextInfo);
  2224. var
  2225. i: Integer;
  2226. begin
  2227. for i := 0 to Count - 1 do
  2228. TGLODEElementBase(Items[i]).Render(rci);
  2229. end;
  2230. procedure TGLODEElements.NotifyChange(Sender: TObject);
  2231. begin
  2232. if Assigned(Owner) then
  2233. if Owner is TGLODEBehaviour then
  2234. TGLODEBehaviour(Owner).NotifyChange(Self);
  2235. end;
  2236. // ---------------
  2237. // --------------- TGLODEElementBase ---------------
  2238. // ---------------
  2239. constructor TGLODEElementBase.Create(AOwner: TXCollection);
  2240. begin
  2241. inherited;
  2242. FPosition := TGLCoordinates.CreateInitialized(Self, NullHmgPoint, csPoint);
  2243. FPosition.OnNotifyChange := NotifyChange;
  2244. FDirection := TGLCoordinates.CreateInitialized(Self, ZHmgVector, csVector);
  2245. FDirection.OnNotifyChange := CoordinateChanged;
  2246. FUp := TGLCoordinates.CreateInitialized(Self, YHmgVector, csVector);
  2247. FUp.OnNotifyChange := CoordinateChanged;
  2248. FDensity := 1;
  2249. FInitialized := False;
  2250. FDynamic := (Owner.Owner is TGLODEDynamic);
  2251. FLocalMatrix := IdentityHMGMatrix;
  2252. FIsCalculating := False;
  2253. end;
  2254. destructor TGLODEElementBase.Destroy;
  2255. begin
  2256. if FInitialized then
  2257. Finalize;
  2258. FPosition.Free;
  2259. FDirection.Free;
  2260. FUp.Free;
  2261. inherited;
  2262. end;
  2263. procedure TGLODEElementBase.Render(var rci: TGLRenderContextInfo);
  2264. begin
  2265. // Override this procedure with element drawing OpenGL code
  2266. end;
  2267. procedure TGLODEElementBase.Initialize;
  2268. var
  2269. Manager: TGLODEManager;
  2270. Body: PdxBody;
  2271. begin
  2272. Manager := nil;
  2273. Body := nil;
  2274. if Owner.Owner is TGLODEBehaviour then
  2275. Manager := TGLODEBehaviour(Owner.Owner).Manager;
  2276. if not Assigned(Manager) then
  2277. Exit;
  2278. if FDynamic then
  2279. begin
  2280. if Owner.Owner is TGLODEDynamic then
  2281. Body := TGLODEDynamic(Owner.Owner).Body;
  2282. if not Assigned(Body) then
  2283. Exit;
  2284. end;
  2285. if not Assigned(Manager.World) then
  2286. Exit;
  2287. if FDynamic then
  2288. begin
  2289. FGeomTransform := dCreateGeomTransform(Manager.Space);
  2290. dGeomSetBody(FGeomTransform, Body);
  2291. dGeomTransformSetCleanup(FGeomTransform, 0);
  2292. dGeomTransformSetGeom(FGeomTransform, FGeomElement);
  2293. dGeomSetData(FGeomTransform, Owner.Owner);
  2294. AlignGeomElementToMatrix(FLocalMatrix);
  2295. end
  2296. else
  2297. begin
  2298. dSpaceAdd(Manager.Space, FGeomElement);
  2299. dGeomSetData(FGeomElement, Owner.Owner);
  2300. AlignGeomElementToMatrix(AbsoluteMatrix);
  2301. end;
  2302. FInitialized := True;
  2303. end;
  2304. procedure TGLODEElementBase.Finalize;
  2305. begin
  2306. if not FInitialized then
  2307. Exit;
  2308. if Assigned(FGeomTransform) then
  2309. begin
  2310. dGeomDestroy(FGeomTransform);
  2311. FGeomTransform := nil;
  2312. end;
  2313. if Assigned(FGeomElement) then
  2314. begin
  2315. dGeomDestroy(FGeomElement);
  2316. FGeomElement := nil;
  2317. end;
  2318. FInitialized := False;
  2319. end;
  2320. procedure TGLODEElementBase.WriteToFiler(writer: TWriter);
  2321. begin
  2322. inherited;
  2323. with writer do
  2324. begin
  2325. WriteInteger(0); // Archive version
  2326. FPosition.WriteToFiler(writer);
  2327. FDirection.WriteToFiler(writer);
  2328. FUp.WriteToFiler(writer);
  2329. WriteFloat(Density);
  2330. end;
  2331. end;
  2332. procedure TGLODEElementBase.ReadFromFiler(reader: TReader);
  2333. begin
  2334. inherited;
  2335. with reader do
  2336. begin
  2337. Assert(ReadInteger = 0); // Archive version
  2338. FPosition.ReadFromFiler(reader);
  2339. FDirection.ReadFromFiler(reader);
  2340. FUp.ReadFromFiler(reader);
  2341. Density := ReadFloat;
  2342. end;
  2343. NotifyChange(Self);
  2344. end;
  2345. function TGLODEElementBase.AbsoluteMatrix: TGLMatrix;
  2346. var
  2347. Mat: TGLMatrix;
  2348. begin
  2349. Mat := IdentityHMGMatrix;
  2350. if Owner.Owner is TGLODEBehaviour then
  2351. Mat := TGLODEBehaviour(Owner.Owner).AbsoluteMatrix;
  2352. Result := MatrixMultiply(Mat, FLocalMatrix);
  2353. end;
  2354. function TGLODEElementBase.AbsolutePosition: TAffineVector;
  2355. begin
  2356. Result := AffineVectorMake(AbsoluteMatrix.W);
  2357. end;
  2358. procedure TGLODEElementBase.AlignGeomElementToMatrix(Mat: TGLMatrix);
  2359. var
  2360. R: TdMatrix3;
  2361. begin
  2362. if not Assigned(FGeomElement) then
  2363. Exit;
  2364. dGeomSetPosition(FGeomElement, Mat.W.X, Mat.W.Y, Mat.W.Z);
  2365. R[0] := Mat.X.X;
  2366. R[1] := Mat.Y.X;
  2367. R[2] := Mat.Z.X;
  2368. R[3] := 0;
  2369. R[4] := Mat.X.Y;
  2370. R[5] := Mat.Y.Y;
  2371. R[6] := Mat.Z.Y;
  2372. R[7] := 0;
  2373. R[8] := Mat.X.Z;
  2374. R[9] := Mat.Y.Z;
  2375. R[10] := Mat.Z.Z;
  2376. R[11] := 0;
  2377. dGeomSetRotation(FGeomElement, R);
  2378. FRealignODE := False;
  2379. end;
  2380. procedure TGLODEElementBase.SetGeomElement(aGeom: PdxGeom);
  2381. begin
  2382. FGeomElement := aGeom;
  2383. end;
  2384. function TGLODEElementBase.IsODEInitialized: Boolean;
  2385. var
  2386. Manager: TGLODEManager;
  2387. begin
  2388. Result := False;
  2389. Manager := nil;
  2390. if Owner.Owner is TGLODEBehaviour then
  2391. Manager := TGLODEBehaviour(Owner.Owner).Manager;
  2392. if not Assigned(Manager) then
  2393. Exit;
  2394. Result := Assigned(Manager.Space);
  2395. end;
  2396. function TGLODEElementBase.CalculateMass: TdMass;
  2397. var
  2398. R: TdMatrix3;
  2399. begin
  2400. R[0] := FLocalMatrix.X.X;
  2401. R[1] := FLocalMatrix.Y.X;
  2402. R[2] := FLocalMatrix.Z.X;
  2403. R[3] := 0;
  2404. R[4] := FLocalMatrix.X.Y;
  2405. R[5] := FLocalMatrix.Y.Y;
  2406. R[6] := FLocalMatrix.Z.Y;
  2407. R[7] := 0;
  2408. R[8] := FLocalMatrix.X.Z;
  2409. R[9] := FLocalMatrix.Y.Z;
  2410. R[10] := FLocalMatrix.Z.Z;
  2411. R[11] := 0;
  2412. dMassRotate(FMass, R);
  2413. dMassTranslate(FMass, FLocalMatrix.W.X, FLocalMatrix.W.Y, FLocalMatrix.W.Z);
  2414. Result := FMass;
  2415. end;
  2416. procedure TGLODEElementBase.CoordinateChanged(Sender: TObject);
  2417. var
  2418. rightVector: TGLVector;
  2419. begin
  2420. if FIsCalculating then
  2421. Exit;
  2422. FIsCalculating := True;
  2423. try
  2424. if Sender = FDirection then
  2425. begin
  2426. if FDirection.VectorLength = 0 then
  2427. FDirection.DirectVector := ZHmgVector;
  2428. FDirection.Normalize;
  2429. rightVector := VectorCrossProduct(FDirection.AsVector, FUp.AsVector);
  2430. if VectorLength(rightVector) < 1E-5 then
  2431. begin
  2432. rightVector := VectorCrossProduct(ZHmgVector, FUp.AsVector);
  2433. if VectorLength(rightVector) < 1E-5 then
  2434. rightVector := VectorCrossProduct(XHmgVector, FUp.AsVector);
  2435. end;
  2436. FUp.DirectVector := VectorCrossProduct(rightVector, FDirection.AsVector);
  2437. FUp.Normalize;
  2438. end
  2439. else if Sender = FUp then
  2440. begin
  2441. if FUp.VectorLength = 0 then
  2442. FUp.DirectVector := YHmgVector;
  2443. FUp.Normalize;
  2444. rightVector := VectorCrossProduct(FDirection.AsVector, FUp.AsVector);
  2445. if VectorLength(rightVector) < 1E-5 then
  2446. begin
  2447. rightVector := VectorCrossProduct(ZHmgVector, FUp.AsVector);
  2448. if VectorLength(rightVector) < 1E-5 then
  2449. rightVector := VectorCrossProduct(XHmgVector, FUp.AsVector);
  2450. end;
  2451. FDirection.DirectVector := VectorCrossProduct(FUp.AsVector, rightVector);
  2452. FDirection.Normalize;
  2453. end;
  2454. NotifyChange(Self);
  2455. finally
  2456. FIsCalculating := False;
  2457. end;
  2458. end;
  2459. procedure TGLODEElementBase.NotifyChange(Sender: TObject);
  2460. begin
  2461. RebuildMatrix;
  2462. ODERebuild;
  2463. end;
  2464. function TGLODEElementBase.GetMatrix: TGLMatrix;
  2465. begin
  2466. Result := FLocalMatrix;
  2467. end;
  2468. procedure TGLODEElementBase.RebuildMatrix;
  2469. begin
  2470. VectorCrossProduct(FUp.AsVector, FDirection.AsVector, FLocalMatrix.X);
  2471. SetVector(FLocalMatrix.Y, FUp.AsVector);
  2472. SetVector(FLocalMatrix.Z, FDirection.AsVector);
  2473. SetVector(FLocalMatrix.W, FPosition.AsVector);
  2474. end;
  2475. procedure TGLODEElementBase.RebuildVectors;
  2476. begin
  2477. FUp.SetVector(FLocalMatrix.Y.X, FLocalMatrix.Y.Y, FLocalMatrix.Y.Z);
  2478. FDirection.SetVector(FLocalMatrix.Z.X, FLocalMatrix.Z.Y, FLocalMatrix.Z.Z);
  2479. FPosition.SetPoint(FLocalMatrix.W.X, FLocalMatrix.W.Y, FLocalMatrix.W.Z);
  2480. end;
  2481. procedure TGLODEElementBase.SetDensity(const Value: TdReal);
  2482. begin
  2483. FDensity := Value;
  2484. end;
  2485. procedure TGLODEElementBase.SetMatrix(const Value: TGLMatrix);
  2486. begin
  2487. FLocalMatrix := Value;
  2488. RebuildVectors;
  2489. ODERebuild;
  2490. end;
  2491. procedure TGLODEElementBase.ODERebuild;
  2492. begin
  2493. if Initialized then
  2494. begin
  2495. if FDynamic then
  2496. begin
  2497. CalculateMass;
  2498. AlignGeomElementToMatrix(FLocalMatrix);
  2499. end
  2500. else
  2501. AlignGeomElementToMatrix(AbsoluteMatrix);
  2502. end;
  2503. if Assigned(Owner) then
  2504. TGLODEElements(Owner).NotifyChange(Self);
  2505. end;
  2506. procedure TGLODEElementBase.SetPosition(const Value: TGLCoordinates);
  2507. begin
  2508. FPosition.Assign(Value);
  2509. end;
  2510. procedure TGLODEElementBase.SetDirection(const Value: TGLCoordinates);
  2511. begin
  2512. FDirection.Assign(Value);
  2513. end;
  2514. procedure TGLODEElementBase.SetUp(const Value: TGLCoordinates);
  2515. begin
  2516. FUp.Assign(Value);
  2517. end;
  2518. // ---------------
  2519. // --------------- TGLODEElementBox ---------------
  2520. // ---------------
  2521. procedure TGLODEElementBox.Render(var rci: TGLRenderContextInfo);
  2522. begin
  2523. gl.PushMatrix;
  2524. gl.MultMatrixf(@FLocalMatrix);
  2525. gl.Begin_(GL_LINE_LOOP);
  2526. gl.Vertex3f(-FBoxWidth / 2, -FBoxHeight / 2, -FBoxDepth / 2);
  2527. gl.Vertex3f(-FBoxWidth / 2, FBoxHeight / 2, -FBoxDepth / 2);
  2528. gl.Vertex3f(-FBoxWidth / 2, FBoxHeight / 2, FBoxDepth / 2);
  2529. gl.Vertex3f(-FBoxWidth / 2, -FBoxHeight / 2, FBoxDepth / 2);
  2530. gl.End_;
  2531. gl.Begin_(GL_LINE_LOOP);
  2532. gl.Vertex3f(FBoxWidth / 2, FBoxHeight / 2, FBoxDepth / 2);
  2533. gl.Vertex3f(FBoxWidth / 2, -FBoxHeight / 2, FBoxDepth / 2);
  2534. gl.Vertex3f(FBoxWidth / 2, -FBoxHeight / 2, -FBoxDepth / 2);
  2535. gl.Vertex3f(FBoxWidth / 2, FBoxHeight / 2, -FBoxDepth / 2);
  2536. gl.End_;
  2537. gl.Begin_(GL_LINES);
  2538. gl.Vertex3f(-FBoxWidth / 2, FBoxHeight / 2, -FBoxDepth / 2);
  2539. gl.Vertex3f(FBoxWidth / 2, FBoxHeight / 2, -FBoxDepth / 2);
  2540. gl.Vertex3f(-FBoxWidth / 2, -FBoxHeight / 2, FBoxDepth / 2);
  2541. gl.Vertex3f(FBoxWidth / 2, -FBoxHeight / 2, FBoxDepth / 2);
  2542. gl.Vertex3f(-FBoxWidth / 2, -FBoxHeight / 2, -FBoxDepth / 2);
  2543. gl.Vertex3f(FBoxWidth / 2, -FBoxHeight / 2, -FBoxDepth / 2);
  2544. gl.Vertex3f(-FBoxWidth / 2, FBoxHeight / 2, FBoxDepth / 2);
  2545. gl.Vertex3f(FBoxWidth / 2, FBoxHeight / 2, FBoxDepth / 2);
  2546. gl.End_;
  2547. gl.PopMatrix;
  2548. end;
  2549. constructor TGLODEElementBox.Create(AOwner: TXCollection);
  2550. begin
  2551. inherited;
  2552. BoxWidth := 1;
  2553. BoxHeight := 1;
  2554. BoxDepth := 1;
  2555. end;
  2556. procedure TGLODEElementBox.Initialize;
  2557. begin
  2558. if FInitialized then
  2559. Exit;
  2560. if not IsODEInitialized then
  2561. Exit;
  2562. FGeomElement := dCreateBox(nil, FBoxWidth, FBoxHeight, FBoxDepth);
  2563. inherited;
  2564. end;
  2565. procedure TGLODEElementBox.WriteToFiler(writer: TWriter);
  2566. begin
  2567. inherited;
  2568. with writer do
  2569. begin
  2570. WriteInteger(0); // Archive version
  2571. WriteFloat(BoxWidth);
  2572. WriteFloat(BoxHeight);
  2573. WriteFloat(BoxDepth);
  2574. end;
  2575. end;
  2576. procedure TGLODEElementBox.ReadFromFiler(reader: TReader);
  2577. begin
  2578. inherited;
  2579. with reader do
  2580. begin
  2581. Assert(ReadInteger = 0); // Archive version
  2582. BoxWidth := ReadFloat;
  2583. BoxHeight := ReadFloat;
  2584. BoxDepth := ReadFloat;
  2585. end;
  2586. end;
  2587. class function TGLODEElementBox.FriendlyName: String;
  2588. begin
  2589. Result := 'Box';
  2590. end;
  2591. class function TGLODEElementBox.FriendlyDescription: String;
  2592. begin
  2593. Result := 'The ODE box element implementation';
  2594. end;
  2595. class function TGLODEElementBox.ItemCategory: String;
  2596. begin
  2597. Result := 'Primitives';
  2598. end;
  2599. function TGLODEElementBox.CalculateMass: TdMass;
  2600. begin
  2601. dMassSetBox(FMass, FDensity, BoxWidth, BoxHeight, BoxDepth);
  2602. Result := inherited CalculateMass;
  2603. end;
  2604. function TGLODEElementBox.GetBoxWidth: TdReal;
  2605. var
  2606. vec: TdVector3;
  2607. begin
  2608. if Assigned(FGeomTransform) then
  2609. begin
  2610. dGeomBoxGetLengths(Geom, vec);
  2611. FBoxWidth := vec[0];
  2612. end;
  2613. Result := FBoxWidth;
  2614. end;
  2615. function TGLODEElementBox.GetBoxHeight: TdReal;
  2616. var
  2617. vec: TdVector3;
  2618. begin
  2619. if Assigned(FGeomTransform) then
  2620. begin
  2621. dGeomBoxGetLengths(Geom, vec);
  2622. FBoxHeight := vec[1];
  2623. end;
  2624. Result := FBoxHeight;
  2625. end;
  2626. function TGLODEElementBox.GetBoxDepth: TdReal;
  2627. var
  2628. vec: TdVector3;
  2629. begin
  2630. if Assigned(FGeomTransform) then
  2631. begin
  2632. dGeomBoxGetLengths(Geom, vec);
  2633. FBoxDepth := vec[2];
  2634. end;
  2635. Result := FBoxDepth;
  2636. end;
  2637. procedure TGLODEElementBox.ODERebuild;
  2638. begin
  2639. if Assigned(Geom) then
  2640. dGeomBoxSetLengths(Geom, FBoxWidth, FBoxHeight, FBoxDepth);
  2641. inherited;
  2642. end;
  2643. procedure TGLODEElementBox.SetBoxWidth(const Value: TdReal);
  2644. begin
  2645. FBoxWidth := Value;
  2646. ODERebuild;
  2647. end;
  2648. procedure TGLODEElementBox.SetBoxHeight(const Value: TdReal);
  2649. begin
  2650. FBoxHeight := Value;
  2651. ODERebuild;
  2652. end;
  2653. procedure TGLODEElementBox.SetBoxDepth(const Value: TdReal);
  2654. begin
  2655. FBoxDepth := Value;
  2656. ODERebuild;
  2657. end;
  2658. // ---------------
  2659. // --------------- TGLODEElementSphere ---------------
  2660. // ---------------
  2661. procedure TGLODEElementSphere.Render(var rci: TGLRenderContextInfo);
  2662. var
  2663. AngTop, AngBottom, AngStart, AngStop, StepV, StepH: double;
  2664. SinP, CosP, SinP2, CosP2, SinT, CosT, Phi, Phi2, Theta: double;
  2665. FTop, FBottom, FStart, FStop: Single;
  2666. i, J, FSlices, FStacks: Integer;
  2667. begin
  2668. gl.PushMatrix;
  2669. gl.MultMatrixf(@FLocalMatrix);
  2670. gl.Scalef(Radius, Radius, Radius);
  2671. FTop := 90;
  2672. FBottom := -90;
  2673. FStart := 0;
  2674. FStop := 360;
  2675. FSlices := 16;
  2676. FStacks := 16;
  2677. AngTop := DegToRad(FTop);
  2678. AngBottom := DegToRad(FBottom);
  2679. AngStart := DegToRad(FStart);
  2680. AngStop := DegToRad(FStop);
  2681. StepH := (AngStop - AngStart) / FSlices;
  2682. StepV := (AngTop - AngBottom) / FStacks;
  2683. Phi := AngTop;
  2684. Phi2 := Phi - StepV;
  2685. for J := 0 to FStacks - 1 do
  2686. begin
  2687. Theta := AngStart;
  2688. SinCos(Phi, SinP, CosP);
  2689. SinCos(Phi2, SinP2, CosP2);
  2690. gl.Begin_(GL_LINE_LOOP);
  2691. for i := 0 to FSlices do
  2692. begin
  2693. SinCos(Theta, SinT, CosT);
  2694. gl.Vertex3f(CosP * SinT, SinP, CosP * CosT);
  2695. Theta := Theta + StepH;
  2696. end;
  2697. gl.End_;
  2698. Phi := Phi2;
  2699. Phi2 := Phi2 - StepV;
  2700. end;
  2701. Phi := AngTop;
  2702. Phi2 := Phi - StepV;
  2703. for J := 0 to FStacks - 1 do
  2704. begin
  2705. Theta := AngStart;
  2706. SinCos(Phi, SinP, CosP);
  2707. SinCos(Phi2, SinP2, CosP2);
  2708. gl.Begin_(GL_LINE_LOOP);
  2709. for i := 0 to FSlices do
  2710. begin
  2711. SinCos(Theta, SinT, CosT);
  2712. gl.Vertex3f(SinP, CosP * SinT, CosP * CosT);
  2713. Theta := Theta + StepH;
  2714. end;
  2715. gl.End_;
  2716. Phi := Phi2;
  2717. Phi2 := Phi2 - StepV;
  2718. end;
  2719. gl.PopMatrix;
  2720. end;
  2721. constructor TGLODEElementSphere.Create(AOwner: TXCollection);
  2722. begin
  2723. inherited;
  2724. FRadius := 0.5;
  2725. end;
  2726. procedure TGLODEElementSphere.Initialize;
  2727. begin
  2728. if FInitialized then
  2729. Exit;
  2730. if not IsODEInitialized then
  2731. Exit;
  2732. FGeomElement := dCreateSphere(nil, FRadius);
  2733. inherited;
  2734. end;
  2735. procedure TGLODEElementSphere.WriteToFiler(writer: TWriter);
  2736. begin
  2737. inherited;
  2738. with writer do
  2739. begin
  2740. WriteInteger(0); // Archive version
  2741. WriteFloat(Radius);
  2742. end;
  2743. end;
  2744. procedure TGLODEElementSphere.ReadFromFiler(reader: TReader);
  2745. begin
  2746. inherited;
  2747. with reader do
  2748. begin
  2749. Assert(ReadInteger = 0); // Archive version
  2750. Radius := ReadFloat;
  2751. end;
  2752. end;
  2753. class function TGLODEElementSphere.FriendlyName: String;
  2754. begin
  2755. Result := 'Sphere';
  2756. end;
  2757. class function TGLODEElementSphere.FriendlyDescription: String;
  2758. begin
  2759. Result := 'The ODE sphere element implementation';
  2760. end;
  2761. class function TGLODEElementSphere.ItemCategory: String;
  2762. begin
  2763. Result := 'Primitives';
  2764. end;
  2765. function TGLODEElementSphere.CalculateMass: TdMass;
  2766. begin
  2767. dMassSetSphere(FMass, FDensity, Radius);
  2768. Result := inherited CalculateMass;
  2769. end;
  2770. function TGLODEElementSphere.GetRadius: TdReal;
  2771. begin
  2772. if Assigned(FGeomElement) then
  2773. FRadius := dGeomSphereGetRadius(FGeomElement);
  2774. Result := FRadius;
  2775. end;
  2776. procedure TGLODEElementSphere.ODERebuild;
  2777. begin
  2778. if Assigned(Geom) then
  2779. begin
  2780. dGeomSphereSetRadius(Geom, FRadius);
  2781. end;
  2782. inherited;
  2783. end;
  2784. procedure TGLODEElementSphere.SetRadius(const Value: TdReal);
  2785. begin
  2786. FRadius := Value;
  2787. ODERebuild;
  2788. end;
  2789. // ---------------
  2790. // --------------- TGLODEElementCapsule ---------------
  2791. // ---------------
  2792. procedure TGLODEElementCapsule.Render(var rci: TGLRenderContextInfo);
  2793. var
  2794. i, J, Stacks, Slices: Integer;
  2795. begin
  2796. gl.PushMatrix;
  2797. gl.MultMatrixf(@FLocalMatrix);
  2798. Stacks := 8;
  2799. Slices := 16;
  2800. // Middle horizontal circles
  2801. for J := 0 to Stacks - 1 do
  2802. begin
  2803. gl.Begin_(GL_LINE_LOOP);
  2804. for i := 0 to Slices - 1 do
  2805. gl.Vertex3f(FRadius * sin(2 * i * PI / Slices),
  2806. FRadius * cos(2 * i * PI / Slices),
  2807. -FLength / 2 + FLength * J /(Stacks - 1));
  2808. gl.End_;
  2809. end;
  2810. // Middle vertical lines
  2811. gl.Begin_(GL_LINES);
  2812. for i := 0 to (Slices div 2) - 1 do
  2813. begin
  2814. gl.Vertex3f(FRadius * sin(2 * i * PI / Slices),
  2815. FRadius * cos(2 * i * PI / Slices), -FLength / 2);
  2816. gl.Vertex3f(FRadius * sin(2 * i * PI / Slices),
  2817. FRadius * cos(2 * i * PI / Slices), FLength / 2);
  2818. gl.Vertex3f(-FRadius * sin(2 * i * PI / Slices),
  2819. -FRadius * cos(2 * i * PI / Slices), -FLength / 2);
  2820. gl.Vertex3f(-FRadius * sin(2 * i * PI / Slices),
  2821. -FRadius * cos(2 * i * PI / Slices), FLength / 2);
  2822. end;
  2823. gl.End_;
  2824. // Cap XZ half-circles
  2825. gl.PushMatrix;
  2826. for J := 0 to (Slices div 2) - 1 do
  2827. begin
  2828. // Top
  2829. gl.Begin_(GL_LINE_STRIP);
  2830. for i := 0 to Slices do
  2831. gl.Vertex3f(FRadius * cos(i * PI / Slices), 0,
  2832. FRadius * sin(i * PI / Slices) + FLength / 2);
  2833. gl.End_;
  2834. // Bottom
  2835. gl.Begin_(GL_LINE_STRIP);
  2836. for i := 0 to Slices do
  2837. gl.Vertex3f(FRadius * cos(i * PI / Slices), 0,
  2838. -(FRadius * sin(i * PI / Slices) + FLength / 2));
  2839. gl.End_;
  2840. gl.Rotatef(360 / Slices, 0, 0, 1);
  2841. end;
  2842. gl.PopMatrix;
  2843. gl.PopMatrix;
  2844. end;
  2845. constructor TGLODEElementCapsule.Create(AOwner: TXCollection);
  2846. begin
  2847. inherited;
  2848. FRadius := 0.5;
  2849. FLength := 1;
  2850. end;
  2851. procedure TGLODEElementCapsule.Initialize;
  2852. begin
  2853. if FInitialized then
  2854. Exit;
  2855. if not IsODEInitialized then
  2856. Exit;
  2857. FGeomElement := dCreateCapsule(nil, FRadius, FLength);
  2858. inherited;
  2859. end;
  2860. procedure TGLODEElementCapsule.WriteToFiler(writer: TWriter);
  2861. begin
  2862. inherited;
  2863. with writer do
  2864. begin
  2865. WriteInteger(0); // Archive version
  2866. WriteFloat(Radius);
  2867. WriteFloat(Length);
  2868. end;
  2869. end;
  2870. procedure TGLODEElementCapsule.ReadFromFiler(reader: TReader);
  2871. begin
  2872. inherited;
  2873. with reader do
  2874. begin
  2875. Assert(ReadInteger = 0); // Archive version
  2876. Radius := ReadFloat;
  2877. Length := ReadFloat;
  2878. end;
  2879. end;
  2880. class function TGLODEElementCapsule.FriendlyName: String;
  2881. begin
  2882. Result := 'Capsule';
  2883. end;
  2884. class function TGLODEElementCapsule.FriendlyDescription: String;
  2885. begin
  2886. Result := 'The ODE capped cylinder element implementation';
  2887. end;
  2888. class function TGLODEElementCapsule.ItemCategory: String;
  2889. begin
  2890. Result := 'Primitives';
  2891. end;
  2892. function TGLODEElementCapsule.CalculateMass: TdMass;
  2893. begin
  2894. dMassSetCapsule(FMass, FDensity, 3, FRadius, FLength);
  2895. Result := inherited CalculateMass;
  2896. end;
  2897. function TGLODEElementCapsule.GetRadius: TdReal;
  2898. var
  2899. rad, len: TdReal;
  2900. begin
  2901. if Assigned(FGeomElement) then
  2902. begin
  2903. dGeomCapsuleGetParams(Geom, rad, len);
  2904. FRadius := rad;
  2905. end;
  2906. Result := FRadius;
  2907. end;
  2908. function TGLODEElementCapsule.GetLength: TdReal;
  2909. var
  2910. rad, len: TdReal;
  2911. begin
  2912. if Assigned(FGeomElement) then
  2913. begin
  2914. dGeomCapsuleGetParams(Geom, rad, len);
  2915. FLength := len;
  2916. end;
  2917. Result := FLength;
  2918. end;
  2919. procedure TGLODEElementCapsule.ODERebuild;
  2920. begin
  2921. if Assigned(Geom) then
  2922. dGeomCapsuleSetParams(Geom, FRadius, FLength);
  2923. inherited;
  2924. end;
  2925. procedure TGLODEElementCapsule.SetRadius(const Value: TdReal);
  2926. begin
  2927. FRadius := Value;
  2928. ODERebuild;
  2929. end;
  2930. procedure TGLODEElementCapsule.SetLength(const Value: TdReal);
  2931. begin
  2932. FLength := Value;
  2933. ODERebuild;
  2934. end;
  2935. // ---------------
  2936. // --------------- TGLODEElementCylinder ---------------
  2937. // ---------------
  2938. procedure TGLODEElementCylinder.Render(var rci: TGLRenderContextInfo);
  2939. var
  2940. i, J, Stacks, Slices: Integer;
  2941. begin
  2942. gl.PushMatrix;
  2943. gl.MultMatrixf(@FLocalMatrix);
  2944. Stacks := 8;
  2945. Slices := 16;
  2946. // Middle horizontal circles
  2947. for J := 0 to Stacks - 1 do
  2948. begin
  2949. gl.Begin_(GL_LINE_LOOP);
  2950. for i := 0 to Slices - 1 do
  2951. gl.Vertex3f(FRadius * sin(2 * i * PI / Slices), -FLength / 2 + FLength * J/
  2952. (Stacks - 1), FRadius * cos(2 * i * PI / Slices));
  2953. gl.End_;
  2954. end;
  2955. // Middle vertical lines
  2956. gl.Begin_(GL_LINES);
  2957. for i := 0 to (Slices div 2) - 1 do
  2958. begin
  2959. gl.Vertex3f(FRadius * sin(2 * i * PI / Slices), -FLength / 2,
  2960. FRadius * cos(2 * i * PI / Slices));
  2961. gl.Vertex3f(FRadius * sin(2 * i * PI / Slices), FLength / 2,
  2962. FRadius * cos(2 * i * PI / Slices));
  2963. gl.Vertex3f(-FRadius * sin(2 * i * PI / Slices), -FLength / 2,
  2964. -FRadius * cos(2 * i * PI / Slices));
  2965. gl.Vertex3f(-FRadius * sin(2 * i * PI / Slices), FLength / 2,
  2966. -FRadius * cos(2 * i * PI / Slices));
  2967. end;
  2968. gl.End_;
  2969. // Caps
  2970. gl.PushMatrix;
  2971. for J := 0 to (Slices div 2) - 1 do
  2972. begin
  2973. gl.Begin_(GL_LINES);
  2974. gl.Vertex3f(-FRadius, FLength / 2, 0);
  2975. gl.Vertex3f(FRadius, FLength / 2, 0);
  2976. gl.Vertex3f(-FRadius, -FLength / 2, 0);
  2977. gl.Vertex3f(FRadius, -FLength / 2, 0);
  2978. gl.End_;
  2979. gl.Rotatef(360 / Slices, 0, 1, 0);
  2980. end;
  2981. gl.PopMatrix;
  2982. gl.PopMatrix;
  2983. end;
  2984. constructor TGLODEElementCylinder.Create(AOwner: TXCollection);
  2985. begin
  2986. inherited;
  2987. FRadius := 0.5;
  2988. FLength := 1;
  2989. end;
  2990. procedure TGLODEElementCylinder.Initialize;
  2991. begin
  2992. if FInitialized then
  2993. Exit;
  2994. if not IsODEInitialized then
  2995. Exit;
  2996. FGeomElement := dCreateCylinder(nil, FRadius, FLength);
  2997. inherited;
  2998. end;
  2999. procedure TGLODEElementCylinder.WriteToFiler(writer: TWriter);
  3000. begin
  3001. inherited;
  3002. with writer do
  3003. begin
  3004. WriteInteger(0); // Archive version
  3005. WriteFloat(Radius);
  3006. WriteFloat(Length);
  3007. end;
  3008. end;
  3009. procedure TGLODEElementCylinder.ReadFromFiler(reader: TReader);
  3010. begin
  3011. inherited;
  3012. with reader do
  3013. begin
  3014. Assert(ReadInteger = 0); // Archive version
  3015. Radius := ReadFloat;
  3016. Length := ReadFloat;
  3017. end;
  3018. end;
  3019. class function TGLODEElementCylinder.FriendlyName: String;
  3020. begin
  3021. Result := 'Cylinder';
  3022. end;
  3023. class function TGLODEElementCylinder.FriendlyDescription: String;
  3024. begin
  3025. Result := 'The ODE cylinder element implementation';
  3026. end;
  3027. class function TGLODEElementCylinder.ItemCategory: String;
  3028. begin
  3029. Result := 'Primitives';
  3030. end;
  3031. function TGLODEElementCylinder.CalculateMass: TdMass;
  3032. begin
  3033. dMassSetCylinder(FMass, FDensity, 3, FRadius, FLength);
  3034. Result := inherited CalculateMass;
  3035. end;
  3036. function TGLODEElementCylinder.GetRadius: TdReal;
  3037. var
  3038. rad, len: TdReal;
  3039. begin
  3040. if Assigned(FGeomElement) then
  3041. begin
  3042. dGeomCylinderGetParams(Geom, rad, len);
  3043. FRadius := rad;
  3044. end;
  3045. Result := FRadius;
  3046. end;
  3047. function TGLODEElementCylinder.GetLength: TdReal;
  3048. var
  3049. rad, len: TdReal;
  3050. begin
  3051. if Assigned(FGeomElement) then
  3052. begin
  3053. dGeomCylinderGetParams(Geom, rad, len);
  3054. FLength := len;
  3055. end;
  3056. Result := FLength;
  3057. end;
  3058. procedure TGLODEElementCylinder.ODERebuild;
  3059. begin
  3060. if Assigned(Geom) then
  3061. dGeomCylinderSetParams(Geom, FRadius, FLength);
  3062. inherited;
  3063. end;
  3064. procedure TGLODEElementCylinder.SetRadius(const Value: TdReal);
  3065. begin
  3066. FRadius := Value;
  3067. ODERebuild;
  3068. end;
  3069. procedure TGLODEElementCylinder.SetLength(const Value: TdReal);
  3070. begin
  3071. FLength := Value;
  3072. ODERebuild;
  3073. end;
  3074. // ---------------
  3075. // --------------- TGLODEElementTriMesh ---------------
  3076. // ---------------
  3077. constructor TGLODEElementTriMesh.Create(AOwner: TXCollection);
  3078. begin
  3079. inherited;
  3080. FVertices := TGLAffineVectorList.Create;
  3081. FIndices := TGLIntegerList.Create;
  3082. end;
  3083. destructor TGLODEElementTriMesh.Destroy;
  3084. begin
  3085. FVertices.Free;
  3086. FIndices.Free;
  3087. inherited;
  3088. end;
  3089. procedure TGLODEElementTriMesh.Initialize;
  3090. begin
  3091. if not IsODEInitialized then
  3092. Exit;
  3093. if FInitialized or not((FVertices.Count > 0) and (FIndices.Count > 0)) then
  3094. Exit;
  3095. FTriMeshData := dGeomTriMeshDataCreate;
  3096. dGeomTriMeshDataBuildSingle(FTriMeshData, @FVertices.List[0],
  3097. 3 * SizeOf(Single), FVertices.Count, @FIndices.List[0], FIndices.Count,
  3098. 3 * SizeOf(Integer));
  3099. FGeomElement := dCreateTriMesh(nil, FTriMeshData, nil, nil, nil);
  3100. inherited;
  3101. end;
  3102. procedure TGLODEElementTriMesh.Finalize;
  3103. begin
  3104. if not FInitialized then
  3105. Exit;
  3106. if Assigned(FTriMeshData) then
  3107. dGeomTriMeshDataDestroy(FTriMeshData);
  3108. inherited;
  3109. end;
  3110. procedure TGLODEElementTriMesh.WriteToFiler(writer: TWriter);
  3111. begin
  3112. inherited;
  3113. with writer do
  3114. begin
  3115. WriteInteger(0); // Archive version
  3116. end;
  3117. end;
  3118. procedure TGLODEElementTriMesh.ReadFromFiler(reader: TReader);
  3119. begin
  3120. inherited;
  3121. with reader do
  3122. begin
  3123. Assert(ReadInteger = 0); // Archive version
  3124. end;
  3125. end;
  3126. class function TGLODEElementTriMesh.FriendlyName: String;
  3127. begin
  3128. Result := 'Tri-Mesh';
  3129. end;
  3130. class function TGLODEElementTriMesh.FriendlyDescription: String;
  3131. begin
  3132. Result := 'The ODE tri-mesh element implementation';
  3133. end;
  3134. class function TGLODEElementTriMesh.ItemCategory: String;
  3135. begin
  3136. Result := 'Meshes';
  3137. end;
  3138. function TGLODEElementTriMesh.CalculateMass: TdMass;
  3139. var
  3140. R: Single;
  3141. min, max: TAffineVector;
  3142. begin
  3143. if Vertices.Count > 0 then
  3144. begin
  3145. Vertices.GetExtents(min, max);
  3146. R := MaxFloat(VectorLength(min), VectorLength(max));
  3147. end
  3148. else
  3149. R := 1;
  3150. dMassSetSphere(FMass, FDensity, R);
  3151. Result := inherited CalculateMass;
  3152. end;
  3153. procedure TGLODEElementTriMesh.SetVertices(const Value: TGLAffineVectorList);
  3154. begin
  3155. FVertices.Assign(Value);
  3156. RefreshTriMeshData;
  3157. end;
  3158. procedure TGLODEElementTriMesh.SetIndices(const Value: TGLIntegerList);
  3159. begin
  3160. FIndices.Assign(Value);
  3161. RefreshTriMeshData;
  3162. end;
  3163. procedure TGLODEElementTriMesh.RefreshTriMeshData;
  3164. begin
  3165. if FInitialized then
  3166. Finalize;
  3167. Initialize;
  3168. end;
  3169. // ---------------
  3170. // --------------- TGLODEElementPlane ---------------
  3171. // ---------------
  3172. procedure TGLODEElementPlane.Initialize;
  3173. begin
  3174. if FInitialized then
  3175. Exit;
  3176. if not IsODEInitialized then
  3177. Exit;
  3178. FGeomElement := dCreatePlane(nil, 0, 0, 1, 0);
  3179. inherited;
  3180. end;
  3181. procedure TGLODEElementPlane.WriteToFiler(writer: TWriter);
  3182. begin
  3183. // ArchiveVersion 1, added inherited call
  3184. writer.WriteInteger(1);
  3185. inherited;
  3186. end;
  3187. procedure TGLODEElementPlane.ReadFromFiler(reader: TReader);
  3188. var
  3189. archiveVersion: Integer;
  3190. begin
  3191. archiveVersion := reader.ReadInteger;
  3192. Assert(archiveVersion in [0 .. 1]);
  3193. if archiveVersion >= 1 then
  3194. inherited;
  3195. end;
  3196. class function TGLODEElementPlane.FriendlyName: String;
  3197. begin
  3198. Result := 'Plane';
  3199. end;
  3200. class function TGLODEElementPlane.FriendlyDescription: String;
  3201. begin
  3202. Result := 'The ODE plane element implementation';
  3203. end;
  3204. class function TGLODEElementPlane.ItemCategory: String;
  3205. begin
  3206. Result := 'Primitives';
  3207. end;
  3208. class function TGLODEElementPlane.CanAddTo(collection: TXCollection): Boolean;
  3209. begin
  3210. Result := False;
  3211. if Assigned(TGLODEElements(collection).Owner) then
  3212. if TGLODEElements(collection).Owner is TGLODEStatic then
  3213. Result := True;
  3214. end;
  3215. procedure TGLODEElementPlane.AlignGeomElementToMatrix(Mat: TGLMatrix);
  3216. var
  3217. d: Single;
  3218. begin
  3219. if not Assigned(FGeomElement) then
  3220. Exit;
  3221. d := VectorDotProduct(Mat.Z, Mat.W);
  3222. dGeomPlaneSetParams(FGeomElement, Mat.Z.X, Mat.Z.Y,
  3223. Mat.Z.Z, d);
  3224. end;
  3225. // ---------------
  3226. // --------------- TGLODEJoints ---------------
  3227. // ---------------
  3228. class function TGLODEJoints.ItemsClass: TXCollectionItemClass;
  3229. begin
  3230. Result := TGLODEJointBase;
  3231. end;
  3232. procedure TGLODEJoints.Initialize;
  3233. var
  3234. i: Integer;
  3235. begin
  3236. for i := 0 to Count - 1 do
  3237. Joint[i].Initialize;
  3238. end;
  3239. procedure TGLODEJoints.Finalize;
  3240. var
  3241. i: Integer;
  3242. begin
  3243. for i := 0 to Count - 1 do
  3244. Joint[i].Finalize;
  3245. end;
  3246. function TGLODEJoints.GetJoint(index: Integer): TGLODEJointBase;
  3247. begin
  3248. Result := TGLODEJointBase(Items[index]);
  3249. end;
  3250. // ---------------
  3251. // --------------- TGLODEJointList ---------------
  3252. // ---------------
  3253. constructor TGLODEJointList.Create(AOwner: TComponent);
  3254. begin
  3255. inherited;
  3256. FJoints := TGLODEJoints.Create(Self);
  3257. end;
  3258. destructor TGLODEJointList.Destroy;
  3259. begin
  3260. FJoints.Free;
  3261. inherited;
  3262. end;
  3263. procedure TGLODEJointList.DefineProperties(Filer: TFiler);
  3264. begin
  3265. inherited;
  3266. Filer.DefineBinaryProperty('ODEJointsData', ReadJoints, WriteJoints,
  3267. (Assigned(FJoints) and (FJoints.Count > 0)));
  3268. end;
  3269. procedure TGLODEJointList.WriteJoints(stream: TStream);
  3270. var
  3271. writer: TWriter;
  3272. begin
  3273. writer := TWriter.Create(stream, 16384);
  3274. try
  3275. Joints.WriteToFiler(writer);
  3276. finally
  3277. writer.Free;
  3278. end;
  3279. end;
  3280. procedure TGLODEJointList.ReadJoints(stream: TStream);
  3281. var
  3282. reader: TReader;
  3283. begin
  3284. reader := TReader.Create(stream, 16384);
  3285. try
  3286. Joints.ReadFromFiler(reader);
  3287. finally
  3288. reader.Free;
  3289. end;
  3290. end;
  3291. procedure TGLODEJointList.Loaded;
  3292. var
  3293. i: Integer;
  3294. begin
  3295. inherited;
  3296. for i := 0 to FJoints.Count - 1 do
  3297. FJoints[i].Loaded;
  3298. end;
  3299. procedure TGLODEJointList.Notification(AComponent: TComponent; Operation: TOperation);
  3300. var
  3301. i: Integer;
  3302. begin
  3303. inherited;
  3304. if (Operation = opRemove) and (AComponent is TGLBaseSceneObject) then
  3305. for i := 0 to Joints.Count - 1 do
  3306. begin
  3307. if TGLBaseSceneObject(AComponent) = Joints[i].Object1 then
  3308. Joints[i].Object1 := nil;
  3309. if TGLBaseSceneObject(AComponent) = Joints[i].Object2 then
  3310. Joints[i].Object2 := nil;
  3311. end;
  3312. end;
  3313. // ---------------
  3314. // --------------- TGLODEJointBase ---------------
  3315. // ---------------
  3316. constructor TGLODEJointBase.Create(AOwner: TXCollection);
  3317. begin
  3318. inherited;
  3319. FJointID := nil;
  3320. FEnabled := True;
  3321. FInitialized := False;
  3322. end;
  3323. destructor TGLODEJointBase.Destroy;
  3324. begin
  3325. Finalize;
  3326. inherited;
  3327. end;
  3328. procedure TGLODEJointBase.Initialize;
  3329. begin
  3330. if not IsODEInitialized then
  3331. Exit;
  3332. if Assigned(FObject1) then
  3333. RegisterJointWithObject(FObject1);
  3334. if Assigned(FObject2) then
  3335. RegisterJointWithObject(FObject2);
  3336. Attach;
  3337. FInitialized := True;
  3338. end;
  3339. procedure TGLODEJointBase.Finalize;
  3340. begin
  3341. if not Initialized then
  3342. Exit;
  3343. if Assigned(FObject1) then
  3344. UnregisterJointWithObject(FObject1);
  3345. if Assigned(FObject2) then
  3346. UnregisterJointWithObject(FObject2);
  3347. if FJointID <> nil then
  3348. dJointDestroy(FJointID);
  3349. FInitialized := False;
  3350. end;
  3351. procedure TGLODEJointBase.WriteToFiler(writer: TWriter);
  3352. begin
  3353. inherited;
  3354. with writer do
  3355. begin
  3356. WriteInteger(0); // Archive version
  3357. if Assigned(FManager) then
  3358. WriteString(FManager.GetNamePath)
  3359. else
  3360. WriteString('');
  3361. if Assigned(FObject1) then
  3362. WriteString(FObject1.GetNamePath)
  3363. else
  3364. WriteString('');
  3365. if Assigned(FObject2) then
  3366. WriteString(FObject2.GetNamePath)
  3367. else
  3368. WriteString('');
  3369. WriteBoolean(FEnabled);
  3370. end;
  3371. end;
  3372. procedure TGLODEJointBase.ReadFromFiler(reader: TReader);
  3373. begin
  3374. inherited;
  3375. with reader do
  3376. begin
  3377. Assert(ReadInteger = 0); // Archive version
  3378. FManagerName := ReadString;
  3379. FObject1Name := ReadString;
  3380. FObject2Name := ReadString;
  3381. FEnabled := ReadBoolean;
  3382. end;
  3383. end;
  3384. procedure TGLODEJointBase.Loaded;
  3385. begin
  3386. DoLoaded;
  3387. end;
  3388. procedure TGLODEJointBase.RegisterJointWithObject(Obj: TGLBaseSceneObject);
  3389. var
  3390. temp: TGLODEDynamic;
  3391. begin
  3392. if Assigned(Obj) then
  3393. begin
  3394. temp := TGLODEDynamic(Obj.Behaviours.GetByClass(TGLODEDynamic));
  3395. if Assigned(temp) then
  3396. temp.RegisterJoint(Self);
  3397. end;
  3398. end;
  3399. procedure TGLODEJointBase.UnregisterJointWithObject(Obj: TGLBaseSceneObject);
  3400. var
  3401. temp: TGLODEDynamic;
  3402. begin
  3403. if Assigned(Obj) then
  3404. begin
  3405. temp := TGLODEDynamic(Obj.Behaviours.GetByClass(TGLODEDynamic));
  3406. if Assigned(temp) then
  3407. temp.UnregisterJoint(Self);
  3408. end;
  3409. end;
  3410. function TGLODEJointBase.IsODEInitialized: Boolean;
  3411. begin
  3412. Result := False;
  3413. if not Assigned(Manager) then
  3414. Exit;
  3415. Result := Assigned(Manager.World);
  3416. end;
  3417. procedure TGLODEJointBase.Attach;
  3418. var
  3419. Body1, Body2: PdxBody;
  3420. begin
  3421. if (FJointID = nil) or not FInitialized then
  3422. Exit;
  3423. if Enabled then
  3424. begin
  3425. Body1 := GetBodyFromGLSceneObject(FObject1);
  3426. Body2 := GetBodyFromGLSceneObject(FObject2);
  3427. end
  3428. else
  3429. begin
  3430. Body1 := nil;
  3431. Body2 := nil;
  3432. end;
  3433. if (joBothObjectsMustBeAssigned in JointOptions) then
  3434. if not(Assigned(Body1) and Assigned(Body2)) then
  3435. Exit;
  3436. dJointAttach(FJointID, Body1, Body2);
  3437. if Assigned(Body1) or Assigned(Body2) then
  3438. StructureChanged;
  3439. end;
  3440. procedure TGLODEJointBase.SetManager(const Value: TGLODEManager);
  3441. begin
  3442. if FManager <> Value then
  3443. begin
  3444. if Assigned(FManager) then
  3445. if not(csDesigning in FManager.ComponentState) then
  3446. Finalize;
  3447. FManager := Value;
  3448. if Assigned(FManager) then
  3449. if not(csDesigning in FManager.ComponentState) then
  3450. Initialize;
  3451. end;
  3452. end;
  3453. procedure TGLODEJointBase.SetObject1(const Value: TGLBaseSceneObject);
  3454. begin
  3455. if FObject1 <> Value then
  3456. begin
  3457. if Assigned(FObject1) then
  3458. UnregisterJointWithObject(FObject1);
  3459. FObject1 := Value;
  3460. if Assigned(FObject1) then
  3461. if IsGLODEObject(FObject1) then
  3462. RegisterJointWithObject(FObject1)
  3463. else
  3464. FObject1 := nil;
  3465. Attach;
  3466. end;
  3467. end;
  3468. procedure TGLODEJointBase.SetObject2(const Value: TGLBaseSceneObject);
  3469. begin
  3470. if FObject2 <> Value then
  3471. begin
  3472. if Assigned(FObject2) then
  3473. UnregisterJointWithObject(FObject2);
  3474. FObject2 := Value;
  3475. if Assigned(FObject2) then
  3476. if IsGLODEObject(FObject2) then
  3477. RegisterJointWithObject(FObject2)
  3478. else
  3479. FObject2 := nil;
  3480. Attach;
  3481. end;
  3482. end;
  3483. procedure TGLODEJointBase.SetEnabled(const Value: Boolean);
  3484. begin
  3485. if FEnabled <> Value then
  3486. begin
  3487. FEnabled := Value;
  3488. if IsODEInitialized then
  3489. Attach;
  3490. end;
  3491. end;
  3492. procedure TGLODEJointBase.StructureChanged;
  3493. begin
  3494. // nothing yet
  3495. end;
  3496. procedure TGLODEJointBase.DoLoaded;
  3497. var
  3498. mng: TComponent;
  3499. Obj: TGLBaseSceneObject;
  3500. begin
  3501. inherited;
  3502. if FManagerName <> '' then
  3503. begin
  3504. mng := FindManager(TGLODEManager, FManagerName);
  3505. if Assigned(mng) then
  3506. Manager := TGLODEManager(mng);
  3507. FManagerName := '';
  3508. end;
  3509. if FObject1Name <> '' then
  3510. begin
  3511. Obj := GetGLSceneObject(FObject1Name);
  3512. if Assigned(Obj) then
  3513. Object1 := Obj;
  3514. FObject1Name := '';
  3515. end;
  3516. if FObject2Name <> '' then
  3517. begin
  3518. Obj := GetGLSceneObject(FObject2Name);
  3519. if Assigned(Obj) then
  3520. Object2 := Obj;
  3521. FObject2Name := '';
  3522. end;
  3523. Attach;
  3524. end;
  3525. function TGLODEJointBase.IsAttached: Boolean;
  3526. var
  3527. Body1, Body2: PdxBody;
  3528. begin
  3529. Result := False;
  3530. if JointID <> nil then
  3531. begin
  3532. Body1 := dJointGetBody(JointID, 0);
  3533. Body2 := dJointGetBody(JointID, 1);
  3534. if joBothObjectsMustBeAssigned in JointOptions then
  3535. Result := Assigned(Body1) and Assigned(Body2)
  3536. else
  3537. Result := Assigned(Body1) or Assigned(Body2);
  3538. end;
  3539. end;
  3540. procedure TGLODEJointBase.SetJointOptions(const Value: TGLODEJointOptions);
  3541. begin
  3542. if Value <> FJointOptions then
  3543. begin
  3544. FJointOptions := Value;
  3545. Attach;
  3546. end;
  3547. end;
  3548. // ---------------
  3549. // --------------- TGLODEJointParams ---------------
  3550. // ---------------
  3551. constructor TGLODEJointParams.Create(AOwner: TPersistent);
  3552. begin
  3553. inherited Create;
  3554. FOwner := AOwner;
  3555. end;
  3556. function TGLODEJointParams.GetOwner: TPersistent;
  3557. begin
  3558. Result := FOwner;
  3559. end;
  3560. procedure TGLODEJointParams.Assign(Source: TPersistent);
  3561. begin
  3562. inherited;
  3563. if not Assigned(Source) then
  3564. Exit;
  3565. if Source is TGLODEJointParams then
  3566. begin
  3567. LoStop := TGLODEJointParams(Source).LoStop;
  3568. HiStop := TGLODEJointParams(Source).HiStop;
  3569. Vel := TGLODEJointParams(Source).Vel;
  3570. FMax := TGLODEJointParams(Source).FMax;
  3571. FudgeFactor := TGLODEJointParams(Source).FudgeFactor;
  3572. Bounce := TGLODEJointParams(Source).Bounce;
  3573. CFM := TGLODEJointParams(Source).CFM;
  3574. StopERP := TGLODEJointParams(Source).StopERP;
  3575. StopCFM := TGLODEJointParams(Source).StopCFM;
  3576. SuspensionERP := TGLODEJointParams(Source).SuspensionERP;
  3577. SuspensionCFM := TGLODEJointParams(Source).SuspensionCFM;
  3578. end;
  3579. end;
  3580. procedure TGLODEJointParams.WriteToFiler(writer: TWriter);
  3581. begin
  3582. with writer do
  3583. begin
  3584. WriteInteger(0); // Archive version
  3585. WriteFloat(LoStop);
  3586. WriteFloat(HiStop);
  3587. WriteFloat(Vel);
  3588. WriteFloat(FMax);
  3589. WriteFloat(FudgeFactor);
  3590. WriteFloat(Bounce);
  3591. WriteFloat(CFM);
  3592. WriteFloat(StopERP);
  3593. WriteFloat(StopCFM);
  3594. WriteFloat(SuspensionERP);
  3595. WriteFloat(SuspensionCFM);
  3596. end;
  3597. end;
  3598. procedure TGLODEJointParams.ReadFromFiler(reader: TReader);
  3599. var
  3600. archiveVersion: Integer;
  3601. begin
  3602. with reader do
  3603. begin
  3604. archiveVersion := ReadInteger;
  3605. Assert(archiveVersion = 0);
  3606. LoStop := ReadFloat;
  3607. HiStop := ReadFloat;
  3608. Vel := ReadFloat;
  3609. FMax := ReadFloat;
  3610. FudgeFactor := ReadFloat;
  3611. Bounce := ReadFloat;
  3612. CFM := ReadFloat;
  3613. StopERP := ReadFloat;
  3614. StopCFM := ReadFloat;
  3615. SuspensionERP := ReadFloat;
  3616. SuspensionCFM := ReadFloat;
  3617. end;
  3618. end;
  3619. function TGLODEJointParams.GetLoStop: TdReal;
  3620. begin
  3621. if Assigned(GetCallback) then
  3622. GetCallback(dParamLoStop1, FLoStop);
  3623. Result := FLoStop;
  3624. end;
  3625. function TGLODEJointParams.GetHiStop: TdReal;
  3626. begin
  3627. if Assigned(GetCallback) then
  3628. GetCallback(dParamHiStop1, FHiStop);
  3629. Result := FHiStop;
  3630. end;
  3631. function TGLODEJointParams.GetVel: TdReal;
  3632. begin
  3633. if Assigned(GetCallback) then
  3634. GetCallback(dParamVel1, FVel);
  3635. Result := FVel;
  3636. end;
  3637. function TGLODEJointParams.GetFMax: TdReal;
  3638. begin
  3639. if Assigned(GetCallback) then
  3640. GetCallback(dParamFMax1, FFMax);
  3641. Result := FFMax;
  3642. end;
  3643. function TGLODEJointParams.GetFudgeFactor: TdReal;
  3644. begin
  3645. if Assigned(GetCallback) then
  3646. GetCallback(dParamFudgeFactor1, FFudgeFactor);
  3647. Result := FFudgeFactor;
  3648. end;
  3649. function TGLODEJointParams.GetBounce: TdReal;
  3650. begin
  3651. if Assigned(GetCallback) then
  3652. GetCallback(dParamBounce1, FBounce);
  3653. Result := FBounce;
  3654. end;
  3655. function TGLODEJointParams.GetCFM: TdReal;
  3656. begin
  3657. if Assigned(GetCallback) then
  3658. GetCallback(dParamCFM1, FCFM);
  3659. Result := FCFM;
  3660. end;
  3661. function TGLODEJointParams.GetStopERP: TdReal;
  3662. begin
  3663. if Assigned(GetCallback) then
  3664. GetCallback(dParamStopERP1, FStopERP);
  3665. Result := FStopERP;
  3666. end;
  3667. function TGLODEJointParams.GetStopCFM: TdReal;
  3668. begin
  3669. if Assigned(GetCallback) then
  3670. GetCallback(dParamStopCFM1, FStopCFM);
  3671. Result := FStopCFM;
  3672. end;
  3673. function TGLODEJointParams.GetSuspensionERP: TdReal;
  3674. begin
  3675. if Assigned(GetCallback) then
  3676. GetCallback(dParamSuspensionERP, FSuspensionERP);
  3677. Result := FSuspensionERP;
  3678. end;
  3679. function TGLODEJointParams.GetSuspensionCFM: TdReal;
  3680. begin
  3681. if Assigned(GetCallback) then
  3682. GetCallback(dParamSuspensionCFM, FSuspensionCFM);
  3683. Result := FSuspensionCFM;
  3684. end;
  3685. procedure TGLODEJointParams.SetLoStop(const Value: TdReal);
  3686. begin
  3687. if Value <> FLoStop then
  3688. begin
  3689. FLoStop := Value;
  3690. if Assigned(SetCallback) then
  3691. FFlagLoStop := not SetCallback(dParamLoStop1, FLoStop)
  3692. else
  3693. FFlagLoStop := True;
  3694. end;
  3695. end;
  3696. procedure TGLODEJointParams.SetHiStop(const Value: TdReal);
  3697. begin
  3698. if Value <> FHiStop then
  3699. begin
  3700. FHiStop := Value;
  3701. if Assigned(SetCallback) then
  3702. FFlagHiStop := not SetCallback(dParamHiStop1, FHiStop)
  3703. else
  3704. FFlagHiStop := True;
  3705. end;
  3706. end;
  3707. procedure TGLODEJointParams.SetVel(const Value: TdReal);
  3708. begin
  3709. if Value <> FVel then
  3710. begin
  3711. FVel := Value;
  3712. if Assigned(SetCallback) then
  3713. FFlagVel := not SetCallback(dParamVel1, FVel)
  3714. else
  3715. FFlagVel := True;
  3716. end;
  3717. end;
  3718. procedure TGLODEJointParams.SetFMax(const Value: TdReal);
  3719. begin
  3720. if Value <> FFMax then
  3721. begin
  3722. FFMax := Value;
  3723. if Assigned(SetCallback) then
  3724. FFlagFMax := not SetCallback(dParamFMax1, FFMax)
  3725. else
  3726. FFlagFMax := True;
  3727. end;
  3728. end;
  3729. procedure TGLODEJointParams.SetFudgeFactor(const Value: TdReal);
  3730. begin
  3731. if Value <> FFudgeFactor then
  3732. begin
  3733. FFudgeFactor := Value;
  3734. if Assigned(SetCallback) then
  3735. FFlagFudgeFactor := not SetCallback(dParamFudgeFactor1, FFudgeFactor)
  3736. else
  3737. FFlagFudgeFactor := True;
  3738. end;
  3739. end;
  3740. procedure TGLODEJointParams.SetBounce(const Value: TdReal);
  3741. begin
  3742. if Value <> FBounce then
  3743. begin
  3744. FBounce := Value;
  3745. if Assigned(SetCallback) then
  3746. FFlagBounce := not SetCallback(dParamBounce1, FBounce)
  3747. else
  3748. FFlagBounce := True;
  3749. end;
  3750. end;
  3751. procedure TGLODEJointParams.SetCFM(const Value: TdReal);
  3752. begin
  3753. if Value <> FCFM then
  3754. begin
  3755. FCFM := Value;
  3756. if Assigned(SetCallback) then
  3757. FFlagCFM := not SetCallback(dParamCFM1, FCFM)
  3758. else
  3759. FFlagCFM := True;
  3760. end;
  3761. end;
  3762. procedure TGLODEJointParams.SetStopERP(const Value: TdReal);
  3763. begin
  3764. if Value <> FStopERP then
  3765. begin
  3766. FStopERP := Value;
  3767. if Assigned(SetCallback) then
  3768. FFlagStopERP := not SetCallback(dParamStopERP1, FStopERP)
  3769. else
  3770. FFlagStopERP := True;
  3771. end;
  3772. end;
  3773. procedure TGLODEJointParams.SetStopCFM(const Value: TdReal);
  3774. begin
  3775. if Value <> FStopCFM then
  3776. begin
  3777. FStopCFM := Value;
  3778. if Assigned(SetCallback) then
  3779. FFlagStopCFM := not SetCallback(dParamStopCFM1, FStopCFM)
  3780. else
  3781. FFlagStopCFM := True;
  3782. end;
  3783. end;
  3784. procedure TGLODEJointParams.SetSuspensionERP(const Value: TdReal);
  3785. begin
  3786. if Value <> FSuspensionERP then
  3787. begin
  3788. FSuspensionERP := Value;
  3789. if Assigned(SetCallback) then
  3790. FFlagSuspensionERP := not SetCallback(dParamSuspensionERP, FSuspensionERP)
  3791. else
  3792. FFlagSuspensionERP := True;
  3793. end;
  3794. end;
  3795. procedure TGLODEJointParams.SetSuspensionCFM(const Value: TdReal);
  3796. begin
  3797. if Value <> FSuspensionCFM then
  3798. begin
  3799. FSuspensionCFM := Value;
  3800. if Assigned(SetCallback) then
  3801. FFlagSuspensionCFM := not SetCallback(dParamSuspensionCFM, FSuspensionCFM)
  3802. else
  3803. FFlagSuspensionCFM := True;
  3804. end;
  3805. end;
  3806. procedure TGLODEJointParams.ApplyFlagged;
  3807. begin
  3808. if not Assigned(SetCallback) then
  3809. Exit;
  3810. if FFlagLoStop then
  3811. SetCallback(dParamLoStop1, FLoStop);
  3812. if FFlagHiStop then
  3813. SetCallback(dParamHiStop1, FHiStop);
  3814. if FFlagVel then
  3815. SetCallback(dParamVel1, FVel);
  3816. if FFlagFMax then
  3817. SetCallback(dParamFMax1, FFMax);
  3818. if FFlagFudgeFactor then
  3819. SetCallback(dParamFudgeFactor1, FFudgeFactor);
  3820. if FFlagBounce then
  3821. SetCallback(dParamBounce1, FBounce);
  3822. if FFlagCFM then
  3823. SetCallback(dParamCFM1, FCFM);
  3824. if FFlagStopERP then
  3825. SetCallback(dParamStopERP1, FStopERP);
  3826. if FFlagStopCFM then
  3827. SetCallback(dParamStopCFM1, FStopCFM);
  3828. if FFlagSuspensionERP then
  3829. SetCallback(dParamSuspensionERP, FSuspensionERP);
  3830. if FFlagSuspensionCFM then
  3831. SetCallback(dParamSuspensionCFM, FSuspensionCFM);
  3832. end;
  3833. // ---------------
  3834. // --------------- TGLODEJointHinge ---------------
  3835. // ---------------
  3836. constructor TGLODEJointHinge.Create(AOwner: TXCollection);
  3837. begin
  3838. inherited;
  3839. FAnchor := TGLCoordinates.CreateInitialized(Self, NullHmgPoint, csPoint);
  3840. FAnchor.OnNotifyChange := AnchorChange;
  3841. FAxis := TGLCoordinates.CreateInitialized(Self, ZHmgVector, csVector);
  3842. FAxis.OnNotifyChange := AxisChange;
  3843. FAxisParams := TGLODEJointParams.Create(Self);
  3844. FAxisParams.SetCallback := SetAxisParam;
  3845. FAxisParams.GetCallback := GetAxisParam;
  3846. end;
  3847. destructor TGLODEJointHinge.Destroy;
  3848. begin
  3849. FAnchor.Free;
  3850. FAxis.Free;
  3851. FAxisParams.Free;
  3852. inherited;
  3853. end;
  3854. procedure TGLODEJointHinge.Initialize;
  3855. begin
  3856. if (not IsODEInitialized) or (FInitialized) then
  3857. Exit;
  3858. FJointID := dJointCreateHinge(FManager.World, nil);
  3859. inherited;
  3860. end;
  3861. procedure TGLODEJointHinge.WriteToFiler(writer: TWriter);
  3862. begin
  3863. inherited;
  3864. with writer do
  3865. begin
  3866. WriteInteger(0); // Archive version
  3867. FAnchor.WriteToFiler(writer);
  3868. FAxis.WriteToFiler(writer);
  3869. FAxisParams.WriteToFiler(writer);
  3870. end;
  3871. end;
  3872. procedure TGLODEJointHinge.ReadFromFiler(reader: TReader);
  3873. begin
  3874. inherited;
  3875. with reader do
  3876. begin
  3877. Assert(ReadInteger = 0); // Archive version
  3878. FAnchor.ReadFromFiler(reader);
  3879. FAxis.ReadFromFiler(reader);
  3880. FAxisParams.ReadFromFiler(reader);
  3881. end;
  3882. end;
  3883. procedure TGLODEJointHinge.StructureChanged;
  3884. begin
  3885. AnchorChange(nil);
  3886. AxisChange(nil);
  3887. FAxisParams.ApplyFlagged;
  3888. end;
  3889. procedure TGLODEJointHinge.AnchorChange(Sender: TObject);
  3890. begin
  3891. if IsAttached then
  3892. dJointSetHingeAnchor(FJointID, FAnchor.X, FAnchor.Y, FAnchor.Z);
  3893. end;
  3894. procedure TGLODEJointHinge.AxisChange(Sender: TObject);
  3895. var
  3896. vec: TGLVector;
  3897. begin
  3898. vec := FAxis.DirectVector;
  3899. NormalizeVector(vec);
  3900. FAxis.DirectVector := vec;
  3901. if IsAttached then
  3902. dJointSetHingeAxis(FJointID, FAxis.X, FAxis.Y, FAxis.Z);
  3903. end;
  3904. class function TGLODEJointHinge.FriendlyName: String;
  3905. begin
  3906. Result := 'Hinge';
  3907. end;
  3908. class function TGLODEJointHinge.FriendlyDescription: String;
  3909. begin
  3910. Result := 'ODE Hinge joint';
  3911. end;
  3912. procedure TGLODEJointHinge.SetAnchor(const Value: TGLCoordinates);
  3913. begin
  3914. FAnchor.Assign(Value);
  3915. end;
  3916. procedure TGLODEJointHinge.SetAxis(const Value: TGLCoordinates);
  3917. begin
  3918. FAxis.Assign(Value);
  3919. end;
  3920. procedure TGLODEJointHinge.SetAxisParams(const Value: TGLODEJointParams);
  3921. begin
  3922. AxisParams.Assign(Value);
  3923. end;
  3924. function TGLODEJointHinge.SetAxisParam(Param: Integer; const Value: TdReal): Boolean;
  3925. begin
  3926. if IsAttached then
  3927. begin
  3928. dJointSetHingeParam(JointID, Param, Value);
  3929. Result := True;
  3930. end
  3931. else
  3932. Result := False;
  3933. end;
  3934. function TGLODEJointHinge.GetAxisParam(Param: Integer; var Value: TdReal): Boolean;
  3935. begin
  3936. if IsAttached then
  3937. begin
  3938. Value := dJointGetHingeParam(JointID, Param);
  3939. Result := True;
  3940. end
  3941. else
  3942. Result := False;
  3943. end;
  3944. // ---------------
  3945. // --------------- TGLODEJointBall ---------------
  3946. // ---------------
  3947. constructor TGLODEJointBall.Create(AOwner: TXCollection);
  3948. begin
  3949. inherited;
  3950. FAnchor := TGLCoordinates.CreateInitialized(Self, NullHmgPoint, csPoint);
  3951. FAnchor.OnNotifyChange := AnchorChange;
  3952. end;
  3953. destructor TGLODEJointBall.Destroy;
  3954. begin
  3955. FAnchor.Free;
  3956. inherited;
  3957. end;
  3958. procedure TGLODEJointBall.Initialize;
  3959. begin
  3960. if (not IsODEInitialized) or (FInitialized) then
  3961. Exit;
  3962. FJointID := dJointCreateBall(FManager.World, nil);
  3963. inherited;
  3964. end;
  3965. procedure TGLODEJointBall.WriteToFiler(writer: TWriter);
  3966. begin
  3967. inherited;
  3968. with writer do
  3969. begin
  3970. WriteInteger(0); // Archive version
  3971. FAnchor.WriteToFiler(writer);
  3972. end;
  3973. end;
  3974. procedure TGLODEJointBall.ReadFromFiler(reader: TReader);
  3975. begin
  3976. inherited;
  3977. with reader do
  3978. begin
  3979. Assert(ReadInteger = 0); // Archive version
  3980. FAnchor.ReadFromFiler(reader);
  3981. end;
  3982. end;
  3983. procedure TGLODEJointBall.StructureChanged;
  3984. begin
  3985. AnchorChange(nil);
  3986. end;
  3987. procedure TGLODEJointBall.AnchorChange(Sender: TObject);
  3988. begin
  3989. if IsAttached then
  3990. dJointSetBallAnchor(FJointID, FAnchor.X, FAnchor.Y, FAnchor.Z);
  3991. end;
  3992. class function TGLODEJointBall.FriendlyName: String;
  3993. begin
  3994. Result := 'Ball';
  3995. end;
  3996. class function TGLODEJointBall.FriendlyDescription: String;
  3997. begin
  3998. Result := 'ODE Ball joint implementation';
  3999. end;
  4000. procedure TGLODEJointBall.SetAnchor(const Value: TGLCoordinates);
  4001. begin
  4002. FAnchor.Assign(Value);
  4003. end;
  4004. // ---------------
  4005. // --------------- TGLODEJointSlider ---------------
  4006. // ---------------
  4007. constructor TGLODEJointSlider.Create(AOwner: TXCollection);
  4008. begin
  4009. inherited;
  4010. FAxis := TGLCoordinates.CreateInitialized(Self, ZHmgVector, csVector);
  4011. FAxis.OnNotifyChange := AxisChange;
  4012. FAxisParams := TGLODEJointParams.Create(Self);
  4013. FAxisParams.SetCallback := SetAxisParam;
  4014. FAxisParams.GetCallback := GetAxisParam;
  4015. end;
  4016. destructor TGLODEJointSlider.Destroy;
  4017. begin
  4018. FAxis.Free;
  4019. FAxisParams.Free;
  4020. inherited;
  4021. end;
  4022. procedure TGLODEJointSlider.Initialize;
  4023. begin
  4024. if (not IsODEInitialized) or (FInitialized) then
  4025. Exit;
  4026. FJointID := dJointCreateSlider(FManager.World, nil);
  4027. inherited;
  4028. end;
  4029. procedure TGLODEJointSlider.WriteToFiler(writer: TWriter);
  4030. begin
  4031. inherited;
  4032. with writer do
  4033. begin
  4034. WriteInteger(0); // Archive version
  4035. FAxis.WriteToFiler(writer);
  4036. FAxisParams.WriteToFiler(writer);
  4037. end;
  4038. end;
  4039. procedure TGLODEJointSlider.ReadFromFiler(reader: TReader);
  4040. begin
  4041. inherited;
  4042. with reader do
  4043. begin
  4044. Assert(ReadInteger = 0); // Archive version
  4045. FAxis.ReadFromFiler(reader);
  4046. FAxisParams.ReadFromFiler(reader);
  4047. end;
  4048. end;
  4049. procedure TGLODEJointSlider.StructureChanged;
  4050. begin
  4051. AxisChange(nil);
  4052. AxisParams.ApplyFlagged;
  4053. end;
  4054. procedure TGLODEJointSlider.AxisChange(Sender: TObject);
  4055. var
  4056. vec: TGLVector;
  4057. begin
  4058. vec := FAxis.DirectVector;
  4059. NormalizeVector(vec);
  4060. FAxis.DirectVector := vec;
  4061. if IsAttached then
  4062. dJointSetSliderAxis(FJointID, FAxis.X, FAxis.Y, FAxis.Z);
  4063. end;
  4064. class function TGLODEJointSlider.FriendlyName: String;
  4065. begin
  4066. Result := 'Slider';
  4067. end;
  4068. class function TGLODEJointSlider.FriendlyDescription: String;
  4069. begin
  4070. Result := 'ODE Slider joint implementation';
  4071. end;
  4072. procedure TGLODEJointSlider.SetAxis(const Value: TGLCoordinates);
  4073. begin
  4074. FAxis.Assign(Value);
  4075. end;
  4076. procedure TGLODEJointSlider.SetAxisParams(const Value: TGLODEJointParams);
  4077. begin
  4078. AxisParams.Assign(Value);
  4079. end;
  4080. function TGLODEJointSlider.SetAxisParam(Param: Integer;
  4081. const Value: TdReal): Boolean;
  4082. begin
  4083. if IsAttached then
  4084. begin
  4085. dJointSetSliderParam(JointID, Param, Value);
  4086. Result := True;
  4087. end
  4088. else
  4089. Result := False;
  4090. end;
  4091. function TGLODEJointSlider.GetAxisParam(Param: Integer; var Value: TdReal): Boolean;
  4092. begin
  4093. if IsAttached then
  4094. begin
  4095. Value := dJointGetSliderParam(JointID, Param);
  4096. Result := True;
  4097. end
  4098. else
  4099. Result := False;
  4100. end;
  4101. // ---------------
  4102. // --------------- TGLODEJointFixed ---------------
  4103. // ---------------
  4104. procedure TGLODEJointFixed.Initialize;
  4105. begin
  4106. if (not IsODEInitialized) or (FInitialized) then
  4107. Exit;
  4108. FJointID := dJointCreateFixed(FManager.World, nil);
  4109. inherited;
  4110. end;
  4111. procedure TGLODEJointFixed.WriteToFiler(writer: TWriter);
  4112. begin
  4113. inherited;
  4114. with writer do
  4115. begin
  4116. WriteInteger(0); // Archive version
  4117. end;
  4118. end;
  4119. procedure TGLODEJointFixed.ReadFromFiler(reader: TReader);
  4120. begin
  4121. inherited;
  4122. with reader do
  4123. begin
  4124. Assert(ReadInteger = 0); // Archive version
  4125. end;
  4126. end;
  4127. class function TGLODEJointFixed.FriendlyName: String;
  4128. begin
  4129. Result := 'Fixed';
  4130. end;
  4131. class function TGLODEJointFixed.FriendlyDescription: String;
  4132. begin
  4133. Result := 'ODE Fixed joint implementation';
  4134. end;
  4135. // ---------------
  4136. // --------------- TGLODEJointHinge2 ---------------
  4137. // ---------------
  4138. constructor TGLODEJointHinge2.Create(AOwner: TXCollection);
  4139. begin
  4140. inherited;
  4141. FAnchor := TGLCoordinates.CreateInitialized(Self, NullHmgPoint, csPoint);
  4142. FAnchor.OnNotifyChange := AnchorChange;
  4143. FAxis1 := TGLCoordinates.CreateInitialized(Self, ZHmgVector, csVector);
  4144. FAxis1.OnNotifyChange := Axis1Change;
  4145. FAxis2 := TGLCoordinates.CreateInitialized(Self, ZHmgVector, csVector);
  4146. FAxis2.OnNotifyChange := Axis2Change;
  4147. FAxis1Params := TGLODEJointParams.Create(Self);
  4148. FAxis1Params.SetCallback := SetAxis1Param;
  4149. FAxis1Params.GetCallback := GetAxis1Param;
  4150. FAxis2Params := TGLODEJointParams.Create(Self);
  4151. FAxis2Params.SetCallback := SetAxis2Param;
  4152. FAxis2Params.GetCallback := GetAxis2Param;
  4153. JointOptions := [joBothObjectsMustBeAssigned];
  4154. end;
  4155. destructor TGLODEJointHinge2.Destroy;
  4156. begin
  4157. FAnchor.Free;
  4158. FAxis1.Free;
  4159. FAxis2.Free;
  4160. FAxis1Params.Free;
  4161. FAxis2Params.Free;
  4162. inherited;
  4163. end;
  4164. procedure TGLODEJointHinge2.Initialize;
  4165. begin
  4166. if (not IsODEInitialized) or (FInitialized) then
  4167. Exit;
  4168. FJointID := dJointCreateHinge2(FManager.World, nil);
  4169. inherited;
  4170. end;
  4171. procedure TGLODEJointHinge2.WriteToFiler(writer: TWriter);
  4172. begin
  4173. inherited;
  4174. with writer do
  4175. begin
  4176. WriteInteger(0); // Archive version
  4177. FAnchor.WriteToFiler(writer);
  4178. FAxis1.WriteToFiler(writer);
  4179. FAxis2.WriteToFiler(writer);
  4180. FAxis1Params.WriteToFiler(writer);
  4181. FAxis2Params.WriteToFiler(writer);
  4182. end;
  4183. end;
  4184. procedure TGLODEJointHinge2.ReadFromFiler(reader: TReader);
  4185. begin
  4186. inherited;
  4187. with reader do
  4188. begin
  4189. Assert(ReadInteger = 0); // Archive version
  4190. FAnchor.ReadFromFiler(reader);
  4191. FAxis1.ReadFromFiler(reader);
  4192. FAxis2.ReadFromFiler(reader);
  4193. FAxis1Params.ReadFromFiler(reader);
  4194. FAxis2Params.ReadFromFiler(reader);
  4195. end;
  4196. end;
  4197. procedure TGLODEJointHinge2.StructureChanged;
  4198. begin
  4199. AnchorChange(nil);
  4200. Axis1Change(nil);
  4201. Axis2Change(nil);
  4202. Axis1Params.ApplyFlagged;
  4203. Axis2Params.ApplyFlagged;
  4204. end;
  4205. procedure TGLODEJointHinge2.AnchorChange(Sender: TObject);
  4206. begin
  4207. if IsAttached then
  4208. dJointSetHinge2Anchor(FJointID, FAnchor.X, FAnchor.Y, FAnchor.Z);
  4209. end;
  4210. procedure TGLODEJointHinge2.Axis1Change(Sender: TObject);
  4211. var
  4212. vec: TGLVector;
  4213. begin
  4214. vec := FAxis1.DirectVector;
  4215. NormalizeVector(vec);
  4216. FAxis1.DirectVector := vec;
  4217. if IsAttached then
  4218. dJointSetHinge2Axis1(FJointID, FAxis1.X, FAxis1.Y, FAxis1.Z);
  4219. end;
  4220. procedure TGLODEJointHinge2.Axis2Change(Sender: TObject);
  4221. var
  4222. vec: TGLVector;
  4223. begin
  4224. vec := FAxis2.DirectVector;
  4225. NormalizeVector(vec);
  4226. FAxis2.DirectVector := vec;
  4227. if IsAttached then
  4228. dJointSetHinge2Axis2(FJointID, FAxis2.X, FAxis2.Y, FAxis2.Z);
  4229. end;
  4230. class function TGLODEJointHinge2.FriendlyName: String;
  4231. begin
  4232. Result := 'Hinge2';
  4233. end;
  4234. class function TGLODEJointHinge2.FriendlyDescription: String;
  4235. begin
  4236. Result := 'ODE Double Axis Hinge joint implementation';
  4237. end;
  4238. procedure TGLODEJointHinge2.SetAnchor(const Value: TGLCoordinates);
  4239. begin
  4240. FAnchor.Assign(Value);
  4241. end;
  4242. procedure TGLODEJointHinge2.SetAxis1(const Value: TGLCoordinates);
  4243. begin
  4244. FAxis1.Assign(Value);
  4245. end;
  4246. procedure TGLODEJointHinge2.SetAxis2(const Value: TGLCoordinates);
  4247. begin
  4248. FAxis2.Assign(Value);
  4249. end;
  4250. procedure TGLODEJointHinge2.SetAxis1Params(const Value: TGLODEJointParams);
  4251. begin
  4252. Axis1Params.Assign(Value);
  4253. end;
  4254. procedure TGLODEJointHinge2.SetAxis2Params(const Value: TGLODEJointParams);
  4255. begin
  4256. Axis2Params.Assign(Value);
  4257. end;
  4258. function TGLODEJointHinge2.SetAxis1Param(Param: Integer; const Value: TdReal): Boolean;
  4259. begin
  4260. if IsAttached then
  4261. begin
  4262. dJointSetHinge2Param(JointID, Param, Value);
  4263. Result := True;
  4264. end
  4265. else
  4266. Result := False;
  4267. end;
  4268. function TGLODEJointHinge2.SetAxis2Param(Param: Integer; const Value: TdReal): Boolean;
  4269. begin
  4270. if IsAttached then
  4271. begin
  4272. dJointSetHinge2Param(JointID, dParamLoStop2 + Param, Value);
  4273. Result := True;
  4274. end
  4275. else
  4276. Result := False;
  4277. end;
  4278. function TGLODEJointHinge2.GetAxis1Param(Param: Integer; var Value: TdReal): Boolean;
  4279. begin
  4280. if IsAttached then
  4281. begin
  4282. Value := dJointGetHinge2Param(JointID, Param);
  4283. Result := True;
  4284. end
  4285. else
  4286. Result := False;
  4287. end;
  4288. function TGLODEJointHinge2.GetAxis2Param(Param: Integer; var Value: TdReal): Boolean;
  4289. begin
  4290. if IsAttached then
  4291. begin
  4292. Value := dJointGetHinge2Param(JointID, dParamLoStop2 + Param);
  4293. Result := True;
  4294. end
  4295. else
  4296. Result := False;
  4297. end;
  4298. // ---------------
  4299. // --------------- TGLODEJointUniversal ---------------
  4300. // ---------------
  4301. constructor TGLODEJointUniversal.Create(AOwner: TXCollection);
  4302. begin
  4303. inherited;
  4304. FAnchor := TGLCoordinates.CreateInitialized(Self, NullHmgPoint, csPoint);
  4305. FAnchor.OnNotifyChange := AnchorChange;
  4306. FAxis1 := TGLCoordinates.CreateInitialized(Self, ZHmgVector, csVector);
  4307. FAxis1.OnNotifyChange := Axis1Change;
  4308. FAxis2 := TGLCoordinates.CreateInitialized(Self, XHmgVector, csVector);
  4309. FAxis2.OnNotifyChange := Axis2Change;
  4310. FAxis1Params := TGLODEJointParams.Create(Self);
  4311. FAxis1Params.SetCallback := SetAxis1Param;
  4312. FAxis1Params.GetCallback := GetAxis1Param;
  4313. FAxis2Params := TGLODEJointParams.Create(Self);
  4314. FAxis2Params.SetCallback := SetAxis2Param;
  4315. FAxis2Params.GetCallback := GetAxis2Param;
  4316. JointOptions := [joBothObjectsMustBeAssigned];
  4317. end;
  4318. destructor TGLODEJointUniversal.Destroy;
  4319. begin
  4320. FAnchor.Free;
  4321. FAxis1.Free;
  4322. FAxis2.Free;
  4323. FAxis1Params.Free;
  4324. FAxis2Params.Free;
  4325. inherited;
  4326. end;
  4327. procedure TGLODEJointUniversal.Initialize;
  4328. begin
  4329. if (not IsODEInitialized) or (FInitialized) then
  4330. Exit;
  4331. FJointID := dJointCreateUniversal(FManager.World, nil);
  4332. inherited;
  4333. end;
  4334. procedure TGLODEJointUniversal.WriteToFiler(writer: TWriter);
  4335. begin
  4336. inherited;
  4337. with writer do
  4338. begin
  4339. WriteInteger(0); // Archive version
  4340. FAnchor.WriteToFiler(writer);
  4341. FAxis1.WriteToFiler(writer);
  4342. FAxis2.WriteToFiler(writer);
  4343. FAxis1Params.WriteToFiler(writer);
  4344. FAxis2Params.WriteToFiler(writer);
  4345. end;
  4346. end;
  4347. procedure TGLODEJointUniversal.ReadFromFiler(reader: TReader);
  4348. begin
  4349. inherited;
  4350. with reader do
  4351. begin
  4352. Assert(ReadInteger = 0); // Archive version
  4353. FAnchor.ReadFromFiler(reader);
  4354. FAxis1.ReadFromFiler(reader);
  4355. FAxis2.ReadFromFiler(reader);
  4356. FAxis1Params.ReadFromFiler(reader);
  4357. FAxis2Params.ReadFromFiler(reader);
  4358. end;
  4359. end;
  4360. procedure TGLODEJointUniversal.StructureChanged;
  4361. begin
  4362. AnchorChange(nil);
  4363. Axis1Change(nil);
  4364. Axis2Change(nil);
  4365. Axis1Params.ApplyFlagged;
  4366. Axis2Params.ApplyFlagged;
  4367. end;
  4368. procedure TGLODEJointUniversal.AnchorChange(Sender: TObject);
  4369. begin
  4370. if IsAttached then
  4371. dJointSetUniversalAnchor(FJointID, FAnchor.X, FAnchor.Y, FAnchor.Z);
  4372. end;
  4373. procedure TGLODEJointUniversal.Axis1Change(Sender: TObject);
  4374. var
  4375. vec: TGLVector;
  4376. begin
  4377. vec := FAxis1.DirectVector;
  4378. NormalizeVector(vec);
  4379. FAxis1.DirectVector := vec;
  4380. if IsAttached then
  4381. dJointSetUniversalAxis1(FJointID, FAxis1.X, FAxis1.Y, FAxis1.Z);
  4382. end;
  4383. procedure TGLODEJointUniversal.Axis2Change(Sender: TObject);
  4384. var
  4385. vec: TGLVector;
  4386. begin
  4387. vec := FAxis2.DirectVector;
  4388. NormalizeVector(vec);
  4389. FAxis2.DirectVector := vec;
  4390. if IsAttached then
  4391. dJointSetUniversalAxis2(FJointID, FAxis2.X, FAxis2.Y, FAxis2.Z);
  4392. end;
  4393. class function TGLODEJointUniversal.FriendlyName: String;
  4394. begin
  4395. Result := 'Universal';
  4396. end;
  4397. class function TGLODEJointUniversal.FriendlyDescription: String;
  4398. begin
  4399. Result := 'ODE Universal joint implementation';
  4400. end;
  4401. procedure TGLODEJointUniversal.SetAnchor(const Value: TGLCoordinates);
  4402. begin
  4403. FAnchor.Assign(Value);
  4404. end;
  4405. procedure TGLODEJointUniversal.SetAxis1(const Value: TGLCoordinates);
  4406. begin
  4407. FAxis1.Assign(Value);
  4408. end;
  4409. procedure TGLODEJointUniversal.SetAxis2(const Value: TGLCoordinates);
  4410. begin
  4411. FAxis2.Assign(Value);
  4412. end;
  4413. procedure TGLODEJointUniversal.SetAxis1Params(const Value: TGLODEJointParams);
  4414. begin
  4415. Axis1Params.Assign(Value);
  4416. end;
  4417. procedure TGLODEJointUniversal.SetAxis2Params(const Value: TGLODEJointParams);
  4418. begin
  4419. Axis2Params.Assign(Value);
  4420. end;
  4421. function TGLODEJointUniversal.SetAxis1Param(Param: Integer; const Value: TdReal): Boolean;
  4422. begin
  4423. if IsAttached then
  4424. begin
  4425. dJointSetUniversalParam(JointID, Param, Value);
  4426. Result := True;
  4427. end
  4428. else
  4429. Result := False;
  4430. end;
  4431. function TGLODEJointUniversal.SetAxis2Param(Param: Integer; const Value: TdReal): Boolean;
  4432. begin
  4433. if IsAttached then
  4434. begin
  4435. dJointSetUniversalParam(JointID, dParamLoStop2 + Param, Value);
  4436. Result := True;
  4437. end
  4438. else
  4439. Result := False;
  4440. end;
  4441. function TGLODEJointUniversal.GetAxis1Param(Param: Integer; var Value: TdReal): Boolean;
  4442. begin
  4443. if IsAttached then
  4444. begin
  4445. Value := dJointGetUniversalParam(JointID, Param);
  4446. Result := True;
  4447. end
  4448. else
  4449. Result := False;
  4450. end;
  4451. function TGLODEJointUniversal.GetAxis2Param(Param: Integer; var Value: TdReal): Boolean;
  4452. begin
  4453. if IsAttached then
  4454. begin
  4455. Value := dJointGetUniversalParam(JointID, dParamLoStop2 + Param);
  4456. Result := True;
  4457. end
  4458. else
  4459. Result := False;
  4460. end;
  4461. // ---------------
  4462. // --------------- TGLODECustomCollider --------------
  4463. // ---------------
  4464. constructor TGLODECustomCollider.Create(AOwner: TXCollection);
  4465. begin
  4466. inherited;
  4467. FContactList := TList.Create;
  4468. FContactCache := TList.Create;
  4469. FContactResolution := 1;
  4470. FRenderContacts := False;
  4471. FContactRenderPoints := TGLAffineVectorList.Create;
  4472. FContactColor := TGLColor.CreateInitialized(Self, clrRed, NotifyChange);
  4473. FPointSize := 3;
  4474. end;
  4475. destructor TGLODECustomCollider.Destroy;
  4476. var
  4477. i: Integer;
  4478. begin
  4479. FContactList.Free;
  4480. for i := 0 to FContactCache.Count - 1 do
  4481. TGLODEContactPoint(FContactCache[i]).Free;
  4482. FContactCache.Free;
  4483. FContactRenderPoints.Free;
  4484. FContactColor.Free;
  4485. inherited;
  4486. end;
  4487. procedure TGLODECustomCollider.Initialize;
  4488. begin
  4489. if not Assigned(Manager) then
  4490. exit;
  4491. if not Assigned(Manager.Space) then
  4492. exit;
  4493. if vCustomColliderClassNum = 0 then
  4494. begin
  4495. with vCustomColliderClass do
  4496. begin
  4497. bytes := 0;
  4498. Collider := GetCustomColliderFn;
  4499. aabb := dInfiniteAABB;
  4500. aabb_test := nil;
  4501. dtor := nil;
  4502. end;
  4503. vCustomColliderClassNum := dCreateGeomClass(vCustomColliderClass);
  4504. end;
  4505. FGeom := dCreateGeom(vCustomColliderClassNum);
  4506. dGeomSetData(FGeom, Self);
  4507. dSpaceAdd(Manager.Space, FGeom);
  4508. inherited;
  4509. end;
  4510. procedure TGLODECustomCollider.Finalize;
  4511. begin
  4512. if not Initialized then
  4513. exit;
  4514. if Assigned(FGeom) then
  4515. begin
  4516. dGeomDestroy(FGeom);
  4517. FGeom := nil;
  4518. end;
  4519. inherited;
  4520. end;
  4521. procedure TGLODECustomCollider.WriteToFiler(writer: TWriter);
  4522. begin
  4523. inherited;
  4524. with writer do
  4525. begin
  4526. WriteInteger(0); // Archive version
  4527. WriteFloat(FContactResolution);
  4528. WriteBoolean(FRenderContacts);
  4529. WriteFloat(FPointSize);
  4530. Write(PByte(FContactColor.AsAddress)^, 4);
  4531. end;
  4532. end;
  4533. procedure TGLODECustomCollider.ReadFromFiler(reader: TReader);
  4534. var
  4535. archiveVersion: Integer;
  4536. begin
  4537. inherited;
  4538. with reader do
  4539. begin
  4540. archiveVersion := ReadInteger;
  4541. Assert(archiveVersion = 0); // Archive version
  4542. FContactResolution := ReadFloat;
  4543. FRenderContacts := ReadBoolean;
  4544. FPointSize := ReadFloat;
  4545. Read(PByte(FContactColor.AsAddress)^, 4);
  4546. end;
  4547. end;
  4548. procedure TGLODECustomCollider.ClearContacts;
  4549. begin
  4550. FContactList.Clear;
  4551. end;
  4552. procedure TGLODECustomCollider.AddContact(x, y, z: TdReal);
  4553. begin
  4554. AddContact(AffineVectorMake(x, y, z));
  4555. end;
  4556. procedure TGLODECustomCollider.AddContact(pos: TAffineVector);
  4557. var
  4558. absPos, colPos, colNorm: TAffineVector;
  4559. Depth: Single;
  4560. ContactPoint: TGLODEContactPoint;
  4561. begin
  4562. absPos := AffineVectorMake(VectorTransform(PointMake(pos), FTransform));
  4563. if Collide(absPos, Depth, colPos, colNorm) then
  4564. begin
  4565. if FContactList.Count < FContactCache.Count then
  4566. ContactPoint := FContactCache[FContactList.Count]
  4567. else
  4568. begin
  4569. ContactPoint := TGLODEContactPoint.Create;
  4570. FContactCache.Add(ContactPoint);
  4571. end;
  4572. ContactPoint.Position := colPos;
  4573. ContactPoint.Normal := colNorm;
  4574. ContactPoint.Depth := Depth;
  4575. FContactList.Add(ContactPoint);
  4576. end;
  4577. if FRenderContacts and Manager.Visible and Manager.VisibleAtRunTime then
  4578. FContactRenderPoints.Add(absPos);
  4579. end;
  4580. function TGLODECustomCollider.ApplyContacts(o1, o2: PdxGeom; flags: Integer;
  4581. contact: PdContactGeom; skip: Integer): Integer;
  4582. var
  4583. i, maxContacts: Integer;
  4584. begin
  4585. FContactList.Sort(ContactSort);
  4586. Result := 0;
  4587. maxContacts := flags and $FFFF;
  4588. try
  4589. for i := 0 to FContactList.Count - 1 do
  4590. begin
  4591. if Result >= maxContacts then
  4592. Exit;
  4593. with TGLODEContactPoint(FContactList[i]) do
  4594. begin
  4595. contact.Depth := Depth;
  4596. contact.pos[0] := Position.x;
  4597. contact.pos[1] := Position.y;
  4598. contact.pos[2] := Position.z;
  4599. contact.pos[3] := 1;
  4600. contact.Normal[0] := -Normal.x;
  4601. contact.Normal[1] := -Normal.y;
  4602. contact.Normal[2] := -Normal.z;
  4603. contact.Normal[3] := 0;
  4604. end;
  4605. contact.g1 := o1;
  4606. contact.g2 := o2;
  4607. contact := PdContactGeom(Integer(contact) + skip);
  4608. Inc(Result);
  4609. end;
  4610. finally
  4611. ClearContacts;
  4612. end;
  4613. end;
  4614. procedure TGLODECustomCollider.SetTransform(ATransform: TGLMatrix);
  4615. begin
  4616. FTransform := ATransform;
  4617. end;
  4618. procedure TGLODECustomCollider.SetContactResolution(const Value: Single);
  4619. begin
  4620. FContactResolution := Value;
  4621. if FContactResolution <= 0 then
  4622. FContactResolution := 0.01;
  4623. end;
  4624. procedure TGLODECustomCollider.Render(var rci: TGLRenderContextInfo);
  4625. var
  4626. i: Integer;
  4627. begin
  4628. if FRenderContacts and (FContactRenderPoints.Count>0) then
  4629. begin
  4630. gl.PushAttrib(GL_CURRENT_BIT);
  4631. gl.Color3fv(PGLfloat(FContactColor.AsAddress));
  4632. gl.PointSize(FPointSize);
  4633. gl.Begin_(GL_POINTS);
  4634. for i := 0 to FContactRenderPoints.Count - 1 do
  4635. gl.Vertex3fv(@FContactRenderPoints.List[i]);
  4636. gl.End_;
  4637. gl.PopAttrib;
  4638. end;
  4639. FContactRenderPoints.Clear;
  4640. end;
  4641. procedure TGLODECustomCollider.SetRenderContacts(const Value: Boolean);
  4642. begin
  4643. if Value <> FRenderContacts then
  4644. begin
  4645. FRenderContacts := Value;
  4646. NotifyChange(Self);
  4647. end;
  4648. end;
  4649. procedure TGLODECustomCollider.SetContactColor(const Value: TGLColor);
  4650. begin
  4651. FContactColor.Assign(Value);
  4652. end;
  4653. procedure TGLODECustomCollider.SetPointSize(const Value: Single);
  4654. begin
  4655. if Value <> FPointSize then
  4656. begin
  4657. FPointSize := Value;
  4658. NotifyChange(Self);
  4659. end;
  4660. end;
  4661. // ---------------
  4662. // --------------- TGLODEHeightField --------------
  4663. // ---------------
  4664. constructor TGLODEHeightField.Create(AOwner: TXCollection);
  4665. var
  4666. Allow: Boolean;
  4667. begin
  4668. Allow := False;
  4669. if Assigned(AOwner) then
  4670. begin
  4671. if Assigned(AOwner.Owner) then
  4672. begin
  4673. if ((AOwner.Owner) is TGLTerrainRenderer) or
  4674. ((AOwner.Owner) is TGLHeightField) then
  4675. Allow := True;
  4676. end;
  4677. end;
  4678. if not Allow then
  4679. raise Exception.Create
  4680. ('This element must be a behaviour of a TGLTerrainRenderer or TGLHeightField');
  4681. inherited Create(AOwner);
  4682. end;
  4683. procedure TGLODEHeightField.WriteToFiler(writer: TWriter);
  4684. begin
  4685. inherited;
  4686. with writer do
  4687. begin
  4688. WriteInteger(0); // Archive version
  4689. end;
  4690. end;
  4691. procedure TGLODEHeightField.ReadFromFiler(reader: TReader);
  4692. var
  4693. archiveVersion: Integer;
  4694. begin
  4695. inherited;
  4696. with reader do
  4697. begin
  4698. archiveVersion := ReadInteger;
  4699. Assert(archiveVersion = 0); // Archive version
  4700. end;
  4701. end;
  4702. class function TGLODEHeightField.FriendlyName: string;
  4703. begin
  4704. Result := 'ODE HeightField Collider';
  4705. end;
  4706. class function TGLODEHeightField.FriendlyDescription: string;
  4707. begin
  4708. Result := 'A custom ODE collider powered by it''s parent TGLTerrainRenderer or TGLHeightField';
  4709. end;
  4710. class function TGLODEHeightField.UniqueItem: Boolean;
  4711. begin
  4712. Result := True;
  4713. end;
  4714. class function TGLODEHeightField.CanAddTo(collection: TXCollection): Boolean;
  4715. begin
  4716. Result := False;
  4717. if collection is TGLBehaviours then
  4718. if Assigned(TGLBehaviours(collection).Owner) then
  4719. if (TGLBehaviours(collection).Owner is TGLHeightField)
  4720. or (TGLBehaviours(collection).Owner is TGLTerrainRenderer) then
  4721. Result := True;
  4722. end;
  4723. function TGLODEHeightField.Collide(aPos: TAffineVector; var Depth: Single;
  4724. var cPos, cNorm: TAffineVector): Boolean;
  4725. function AbsoluteToLocal(vec: TGLVector): TGLVector;
  4726. var
  4727. mat: TGLMatrix;
  4728. begin
  4729. if Owner.Owner is TGLHeightField then
  4730. Result := TGLHeightField(Owner.Owner).AbsoluteToLocal(vec)
  4731. else if Owner.Owner is TGLTerrainRenderer then
  4732. begin
  4733. mat := TGLTerrainRenderer(Owner.Owner).AbsoluteMatrix;
  4734. NormalizeMatrix(mat);
  4735. InvertMatrix(mat);
  4736. Result := VectorTransform(vec, mat);
  4737. end
  4738. else
  4739. Assert(False);
  4740. end;
  4741. function LocalToAbsolute(vec: TGLVector): TGLVector;
  4742. var
  4743. mat: TGLMatrix;
  4744. begin
  4745. if Owner.Owner is TGLHeightField then
  4746. Result := TGLHeightField(Owner.Owner).LocalToAbsolute(vec)
  4747. else if Owner.Owner is TGLTerrainRenderer then
  4748. begin
  4749. mat := TGLTerrainRenderer(Owner.Owner).AbsoluteMatrix;
  4750. NormalizeMatrix(mat);
  4751. Result := VectorTransform(vec, mat);
  4752. end
  4753. else
  4754. Assert(False);
  4755. end;
  4756. function GetHeight(pos: TGLVector; var height: Single): Boolean;
  4757. var
  4758. dummy1: TGLVector;
  4759. dummy2: TTexPoint;
  4760. begin
  4761. Result := False;
  4762. if Owner.Owner is TGLTerrainRenderer then
  4763. begin
  4764. height := TGLTerrainRenderer(Owner.Owner).InterpolatedHeight(LocalToAbsolute(pos));
  4765. Result := True;
  4766. end
  4767. else
  4768. if Owner.Owner is TGLHeightField then
  4769. begin
  4770. if Assigned(TGLHeightField(Owner.Owner).OnGetHeight) then
  4771. begin
  4772. TGLHeightField(Owner.Owner).OnGetHeight(pos.x, pos.y, height, dummy1, dummy2);
  4773. Result := True;
  4774. end;
  4775. end;
  4776. end;
  4777. const
  4778. cDelta = 0.1;
  4779. var
  4780. localPos: TGLVector;
  4781. height: Single;
  4782. temp1, temp2: TAffineVector;
  4783. begin
  4784. localPos := AbsoluteToLocal(PointMake(aPos));
  4785. if GetHeight(localPos, height) then
  4786. begin
  4787. Depth := height - localPos.z;
  4788. Result := (Depth > 0);
  4789. if Result then
  4790. begin
  4791. localPos.z := height;
  4792. cPos := AffineVectorMake(LocalToAbsolute(localPos));
  4793. temp1.x:= localPos.x + cDelta;
  4794. temp1.y := localPos.y;
  4795. temp1.z := localPos.z;
  4796. GetHeight(PointMake(temp1), temp1.z);
  4797. temp2.x := localPos.x;
  4798. temp2.y := localPos.y + cDelta;
  4799. temp2.z := localPos.z;
  4800. GetHeight(PointMake(temp2), temp2.z);
  4801. cNorm := CalcPlaneNormal(AffineVectorMake(localPos), temp1, temp2);
  4802. cNorm := AffineVectorMake(LocalToAbsolute(VectorMake(cNorm)));
  4803. end;
  4804. end
  4805. else
  4806. Result := False;
  4807. end;
  4808. // ------------------------------------------------------------------
  4809. initialization
  4810. // ------------------------------------------------------------------
  4811. vODEObjectRegister := TList.Create;
  4812. RegisterXCollectionItemClass(TGLODEDynamic);
  4813. RegisterXCollectionItemClass(TGLODEStatic);
  4814. RegisterXCollectionItemClass(TGLODEElementBox);
  4815. RegisterXCollectionItemClass(TGLODEElementSphere);
  4816. RegisterXCollectionItemClass(TGLODEElementCapsule);
  4817. RegisterXCollectionItemClass(TGLODEElementCylinder);
  4818. RegisterXCollectionItemClass(TGLODEElementTriMesh);
  4819. RegisterXCollectionItemClass(TGLODEElementPlane);
  4820. RegisterXCollectionItemClass(TGLODEJointHinge);
  4821. RegisterXCollectionItemClass(TGLODEJointBall);
  4822. RegisterXCollectionItemClass(TGLODEJointSlider);
  4823. RegisterXCollectionItemClass(TGLODEJointFixed);
  4824. RegisterXCollectionItemClass(TGLODEJointHinge2);
  4825. RegisterXCollectionItemClass(TGLODEJointUniversal);
  4826. RegisterXCollectionItemClass(TGLODEHeightField);
  4827. // ------------------------------------------------------------------
  4828. finalization
  4829. // ------------------------------------------------------------------
  4830. vODEObjectRegister.Free;
  4831. UnregisterXCollectionItemClass(TGLODEDynamic);
  4832. UnregisterXCollectionItemClass(TGLODEStatic);
  4833. UnregisterXCollectionItemClass(TGLODEElementBox);
  4834. UnregisterXCollectionItemClass(TGLODEElementSphere);
  4835. UnregisterXCollectionItemClass(TGLODEElementCapsule);
  4836. UnregisterXCollectionItemClass(TGLODEElementCylinder);
  4837. UnregisterXCollectionItemClass(TGLODEElementTriMesh);
  4838. UnregisterXCollectionItemClass(TGLODEElementPlane);
  4839. UnregisterXCollectionItemClass(TGLODEJointHinge);
  4840. UnregisterXCollectionItemClass(TGLODEJointBall);
  4841. UnregisterXCollectionItemClass(TGLODEJointSlider);
  4842. UnregisterXCollectionItemClass(TGLODEJointFixed);
  4843. UnregisterXCollectionItemClass(TGLODEJointHinge2);
  4844. UnregisterXCollectionItemClass(TGLODEJointUniversal);
  4845. UnregisterXCollectionItemClass(TGLODEHeightField);
  4846. // CloseODE;
  4847. end.