1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455 |
- //
- // The graphics engine GLScene
- //
- unit GLS.ODEManager;
- (* An ODE Manager *)
- interface
- uses
- Winapi.OpenGL,
- System.Classes,
- System.SysUtils,
- System.Math,
- System.Types,
- Stage.OpenGLTokens,
- Stage.VectorTypes,
- GLS.VectorLists,
- Stage.VectorGeometry,
- Stage.PipelineTransform,
- GLS.PersistentClasses,
- Stage.Manager,
- GLS.XCollection,
- GLS.Scene,
- GLS.Context,
- GLS.Texture,
- GLS.Objects,
- GLS.Color,
- GLS.Coordinates,
- GLS.RenderContextInfo,
- GLS.State,
- GLS.TerrainRenderer,
- GLS.Graph,
- ODE.Import,
- GLS.ODEUtils;
- type
- TGLODECustomCollisionEvent = procedure (Geom1, Geom2 : PdxGeom) of object;
- TGLODECollisionEvent = procedure (Sender : TObject; Object1, Object2 : TObject;
- var Contact:TdContact; var HandleCollision:Boolean) of object;
- TGLODEObjectCollisionEvent = procedure (Sender : TObject; Object2 : TObject;
- var Contact:TdContact; var HandleCollision:Boolean) of object;
- TGLODECollisionSurfaceMode = (csmMu2,csmFDir1,csmBounce,csmSoftERP,csmSoftCFM,
- csmMotion1,csmMotion2,csmSlip1,csmSlip2);
- TGLODESurfaceModes = set of TGLODECollisionSurfaceMode;
- TGLODESolverMethod = (osmDefault, osmStepFast, osmQuickStep);
- TGLODEElements = class;
- TGLODEBehaviour = class;
- TGLODEElementBase = class;
- TGLODEJointBase = class;
- // The visual component to manage behaviours of ODE objects
- TGLODEManager = class(TComponent)
- private
- FWorld: PdxWorld;
- FSpace: PdxSpace;
- FContactGroup: TdJointGroupID;
- FGravity: TGLCoordinates;
- FOnCollision: TGLODECollisionEvent;
- FOnCustomCollision: TGLODECustomCollisionEvent;
- FNumContactJoints,
- FMaxContacts: Integer;
- FODEBehaviours: TGLPersistentObjectList;
- FRFContactList: TList;
- FIterations: Integer;
- FSolver: TGLODESolverMethod;
- FContacts: array of TdContact;
- FContactGeoms: array of TdContactGeom;
- FRenderPoint: TGLRenderPoint;
- FVisible,
- FVisibleAtRunTime: Boolean;
- FGeomColorDynD,
- FGeomColorDynE,
- FGeomColorStat: TGLColor;
- protected
- procedure Loaded; override;
- procedure CalcContact(Object1, Object2: TObject; var Contact: TdContact);
- procedure Collision(g1, g2: PdxGeom);
- procedure GravityChange(Sender: TObject);
- procedure SetMaxContacts(const Value: Integer);
- procedure SetGravity(Value: TGLCoordinates);
- procedure SetIterations(const val: Integer);
- function GetODEBehaviour(index: Integer): TGLODEBehaviour;
- procedure RegisterODEBehaviour(ODEBehaviour: TGLODEBehaviour);
- procedure UnregisterODEBehaviour(ODEBehaviour: TGLODEBehaviour);
- procedure SetRenderPoint(const Value: TGLRenderPoint);
- procedure RenderEvent(Sender: TObject; var rci: TGLRenderContextInfo);
- procedure RenderPointFreed(Sender: TObject);
- procedure SetVisible(const Value: Boolean);
- procedure SetVisibleAtRunTime(const Value: Boolean);
- procedure SetGeomColorDynE(const Value: TGLColor);
- procedure GeomColorChangeDynE(Sender: TObject);
- procedure SetGeomColorDynD(const Value: TGLColor);
- procedure GeomColorChangeDynD(Sender: TObject);
- procedure SetGeomColorStat(const Value: TGLColor);
- procedure GeomColorChangeStat(Sender: TObject);
- property ODEBehaviours[index: Integer]: TGLODEBehaviour read GetODEBehaviour;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure Step(deltaTime: double);
- procedure NotifyChange(Sender: TObject);
- property World: PdxWorld read FWorld;
- property Space: PdxSpace read FSpace;
- property ContactGroup: TdJointGroupID read FContactGroup;
- property NumContactJoints: Integer read FNumContactJoints;
- published
- property Gravity: TGLCoordinates read FGravity write SetGravity;
- property OnCollision: TGLODECollisionEvent read FOnCollision write FOnCollision;
- property OnCustomCollision: TGLODECustomCollisionEvent read FOnCustomCollision write FOnCustomCollision;
- property Solver: TGLODESolverMethod read FSolver write FSolver;
- property Iterations: Integer read FIterations write SetIterations;
- property MaxContacts: Integer read FMaxContacts write SetMaxContacts;
- property RenderPoint: TGLRenderPoint read FRenderPoint write SetRenderPoint;
- property Visible: Boolean read FVisible write SetVisible;
- property VisibleAtRunTime: Boolean read FVisibleAtRunTime write SetVisibleAtRunTime;
- property GeomColorDynD: TGLColor read FGeomColorDynD write SetGeomColorDynD;
- property GeomColorDynE: TGLColor read FGeomColorDynE write SetGeomColorDynE;
- property GeomColorStat: TGLColor read FGeomColorStat write SetGeomColorStat;
- end;
- TGLODECollisionSurface = class(TPersistent)
- private
- FOwner: TPersistent;
- FSurfaceParams: TdSurfaceParameters;
- FRFCoeff: Single;
- FRFEnabled: Boolean;
- protected
- procedure WriteToFiler(writer: TWriter);
- procedure ReadFromFiler(reader: TReader);
- function GetSurfaceMode: TGLODESurfaceModes;
- function GetMu: TdReal;
- function GetMu2: TdReal;
- function GetBounce: TdReal;
- function GetBounce_Vel: TdReal;
- function GetSoftERP: TdReal;
- function GetSoftCFM: TdReal;
- function GetMotion1: TdReal;
- function GetMotion2: TdReal;
- function GetSlip1: TdReal;
- function GetSlip2: TdReal;
- procedure SetSurfaceMode(Value: TGLODESurfaceModes);
- procedure SetMu(Value: TdReal);
- procedure SetMu2(Value: TdReal);
- procedure SetBounce(Value: TdReal);
- procedure SetBounce_Vel(Value: TdReal);
- procedure SetSoftERP(Value: TdReal);
- procedure SetSoftCFM(Value: TdReal);
- procedure SetMotion1(Value: TdReal);
- procedure SetMotion2(Value: TdReal);
- procedure SetSlip1(Value: TdReal);
- procedure SetSlip2(Value: TdReal);
- public
- constructor Create(AOwner: TPersistent);
- function GetOwner: TPersistent; override;
- procedure Assign(Source: TPersistent); override;
- published
- property RollingFrictionCoeff: Single read FRFCoeff write FRFCoeff;
- property RollingFrictionEnabled: Boolean read FRFEnabled write FRFEnabled;
- property SurfaceMode: TGLODESurfaceModes read GetSurfaceMode write SetSurfaceMode;
- property Mu: TdReal read GetMu write SetMu;
- property Mu2: TdReal read GetMu2 write SetMu2;
- property Bounce: TdReal read GetBounce write SetBounce;
- property Bounce_Vel: TdReal read GetBounce_Vel write SetBounce_Vel;
- property SoftERP: TdReal read GetSoftERP write SetSoftERP;
- property SoftCFM: TdReal read GetSoftCFM write SetSoftCFM;
- property Motion1: TdReal read GetMotion1 write SetMotion1;
- property Motion2: TdReal read GetMotion2 write SetMotion2;
- property Slip1: TdReal read GetSlip1 write SetSlip1;
- property Slip2: TdReal read GetSlip2 write SetSlip2;
- end;
- TGLODEElementClass = class of TGLODEElementBase;
- // Basis structures for behaviour style implementations
- TGLODEBehaviour = class(TGLBehaviour)
- private
- FManager: TGLODEManager;
- FManagerName: String;
- FSurface: TGLODECollisionSurface;
- FOnCollision: TGLODEObjectCollisionEvent;
- FInitialized: Boolean;
- FOwnerBaseSceneObject: TGLBaseSceneObject;
- protected
- procedure Initialize; virtual;
- procedure Finalize; virtual;
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- procedure Loaded; override;
- procedure SetManager(Value: TGLODEManager);
- procedure SetSurface(Value: TGLODECollisionSurface);
- function GetAbsoluteMatrix: TGLMatrix;
- public
- constructor Create(AOwner: TXCollection); override;
- destructor Destroy; override;
- procedure NotifyChange(Sender: TObject);
- procedure Render(var rci: TGLRenderContextInfo); virtual;
- procedure Reinitialize;
- property Initialized: Boolean read FInitialized;
- property AbsoluteMatrix: TGLMatrix read GetAbsoluteMatrix;
- published
- property Manager: TGLODEManager read FManager write SetManager;
- property Surface: TGLODECollisionSurface read FSurface write SetSurface;
- property OnCollision: TGLODEObjectCollisionEvent read FOnCollision write FOnCollision;
- end;
- TGLODEDynamic = class(TGLODEBehaviour)
- private
- FBody: PdxBody;
- FMass: TdMass;
- FElements: TGLODEElements;
- FEnabled: Boolean;
- FJointRegister: TList;
- protected
- procedure Initialize; override;
- procedure Finalize; override;
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- procedure SetMass(const Value: TdMass);
- function GetMass: TdMass;
- procedure AlignBodyToMatrix(Mat: TGLMatrix);
- procedure SetEnabled(const Value: Boolean);
- function GetEnabled: Boolean;
- procedure RegisterJoint(Joint: TGLODEJointBase);
- procedure UnregisterJoint(Joint: TGLODEJointBase);
- public
- constructor Create(AOwner: TXCollection); override;
- destructor Destroy; override;
- procedure Render(var rci: TGLRenderContextInfo); override;
- class function FriendlyName: String; override;
- class function UniqueItem: Boolean; override;
- function AddNewElement(AChild: TGLODEElementClass): TGLODEElementBase; dynamic;
- procedure AlignObject;
- function CalculateMass: TdMass;
- procedure CalibrateCenterOfMass;
- procedure AddForce(Force: TAffineVector);
- procedure AddForceAtPos(Force, Pos: TAffineVector);
- procedure AddForceAtRelPos(Force, Pos: TAffineVector);
- procedure AddRelForce(Force: TAffineVector);
- procedure AddRelForceAtPos(Force, Pos: TAffineVector);
- procedure AddRelForceAtRelPos(Force, Pos: TAffineVector);
- procedure AddTorque(Torque: TAffineVector);
- procedure AddRelTorque(Torque: TAffineVector);
- property Body: PdxBody read FBody;
- property Mass: TdMass read GetMass write SetMass;
- published
- property Elements: TGLODEElements read FElements;
- property Enabled: Boolean read GetEnabled write SetEnabled;
- end;
- TGLODEStatic = class(TGLODEBehaviour)
- private
- FElements: TGLODEElements;
- protected
- procedure Initialize; override;
- procedure Finalize; override;
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- procedure AlignElements;
- public
- constructor Create(AOwner: TXCollection); override;
- destructor Destroy; override;
- procedure Render(var rci: TGLRenderContextInfo); override;
- class function FriendlyName: String; override;
- class function UniqueItem: Boolean; override;
- function AddNewElement(AChild: TGLODEElementClass): TGLODEElementBase; dynamic;
- published
- property Elements: TGLODEElements read FElements;
- end;
- TGLODEElements = class(TXCollection)
- private
- function GetElement(index: Integer): TGLODEElementBase;
- public
- destructor Destroy; override;
- class function ItemsClass: TXCollectionItemClass; override;
- procedure Initialize;
- procedure Finalize;
- procedure NotifyChange(Sender: TObject);
- procedure Render(var rci: TGLRenderContextInfo);
- property Element[index: Integer]: TGLODEElementBase read GetElement;
- end;
- TGLODEElementBase = class(TXCollectionItem)
- private
- FMass: TdMass;
- FDensity: TdReal;
- FGeomTransform,
- FGeomElement: PdxGeom;
- FPosition,
- FDirection,
- FUp: TGLCoordinates;
- FLocalMatrix: TGLMatrix;
- FRealignODE,
- FInitialized,
- FDynamic,
- FIsCalculating: Boolean;
- protected
- procedure Initialize; virtual;
- procedure Finalize; virtual;
- function CalculateMass: TdMass; virtual;
- procedure ODERebuild; virtual;
- procedure NotifyChange(Sender: TObject);
- procedure CoordinateChanged(Sender: TObject);
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- function IsODEInitialized: Boolean;
- procedure AlignGeomElementToMatrix(Mat: TGLMatrix); virtual;
- procedure SetGeomElement(aGeom: PdxGeom);
- procedure RebuildMatrix;
- procedure RebuildVectors;
- procedure SetDensity(const Value: TdReal);
- procedure SetMatrix(const Value: TGLMatrix);
- function GetMatrix: TGLMatrix;
- procedure SetPosition(const Value: TGLCoordinates);
- procedure SetDirection(const Value: TGLCoordinates);
- procedure SetUp(const Value: TGLCoordinates);
- public
- constructor Create(AOwner: TXCollection); override;
- destructor Destroy; override;
- procedure Render(var rci: TGLRenderContextInfo); virtual;
- function AbsoluteMatrix: TGLMatrix;
- function AbsolutePosition: TAffineVector;
- property Matrix: TGLMatrix read GetMatrix write SetMatrix;
- property GeomTransform: PdxGeom read FGeomTransform;
- property Geom: PdxGeom read FGeomElement;
- property Initialized: Boolean read FInitialized;
- published
- property Density: TdReal read FDensity write SetDensity;
- property Position: TGLCoordinates read FPosition write SetPosition;
- property Direction: TGLCoordinates read FDirection write SetDirection;
- property Up: TGLCoordinates read FUp write SetUp;
- end;
- // ODE box implementation
- TGLODEElementBox = class(TGLODEElementBase)
- private
- FBoxWidth,
- FBoxHeight,
- FBoxDepth: TdReal;
- protected
- procedure Initialize; override;
- function CalculateMass: TdMass; override;
- procedure ODERebuild; override;
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- function GetBoxWidth: TdReal;
- function GetBoxHeight: TdReal;
- function GetBoxDepth: TdReal;
- procedure SetBoxWidth(const Value: TdReal);
- procedure SetBoxHeight(const Value: TdReal);
- procedure SetBoxDepth(const Value: TdReal);
- public
- constructor Create(AOwner: TXCollection); override;
- procedure Render(var rci: TGLRenderContextInfo); override;
- class function FriendlyName: String; override;
- class function FriendlyDescription: String; override;
- class function ItemCategory: String; override;
- published
- property BoxWidth: TdReal read GetBoxWidth write SetBoxWidth;
- property BoxHeight: TdReal read GetBoxHeight write SetBoxHeight;
- property BoxDepth: TdReal read GetBoxDepth write SetBoxDepth;
- end;
- // ODE sphere implementation
- TGLODEElementSphere = class(TGLODEElementBase)
- private
- FRadius: TdReal;
- protected
- procedure Initialize; override;
- function CalculateMass: TdMass; override;
- procedure ODERebuild; override;
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- function GetRadius: TdReal;
- procedure SetRadius(const Value: TdReal);
- public
- constructor Create(AOwner: TXCollection); override;
- procedure Render(var rci: TGLRenderContextInfo); override;
- class function FriendlyName: String; override;
- class function FriendlyDescription: String; override;
- class function ItemCategory: String; override;
- published
- property Radius: TdReal read GetRadius write SetRadius;
- end;
- // ODE capped cylinder implementation
- TGLODEElementCapsule = class(TGLODEElementBase)
- private
- FRadius,
- FLength: TdReal;
- protected
- procedure Initialize; override;
- function CalculateMass: TdMass; override;
- procedure ODERebuild; override;
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- function GetRadius: TdReal;
- function GetLength: TdReal;
- procedure SetRadius(const Value: TdReal);
- procedure SetLength(const Value: TdReal);
- public
- constructor Create(AOwner: TXCollection); override;
- procedure Render(var rci: TGLRenderContextInfo); override;
- class function FriendlyName: String; override;
- class function FriendlyDescription: String; override;
- class function ItemCategory: String; override;
- published
- property Radius: TdReal read GetRadius write SetRadius;
- property Length: TdReal read GetLength write SetLength;
- end;
- // ODE cylinder implementation
- TGLODEElementCylinder = class(TGLODEElementBase)
- private
- FRadius,
- FLength: TdReal;
- protected
- procedure Initialize; override;
- function CalculateMass: TdMass; override;
- procedure ODERebuild; override;
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- function GetRadius: TdReal;
- function GetLength: TdReal;
- procedure SetRadius(const Value: TdReal);
- procedure SetLength(const Value: TdReal);
- public
- constructor Create(AOwner: TXCollection); override;
- procedure Render(var rci: TGLRenderContextInfo); override;
- class function FriendlyName: String; override;
- class function FriendlyDescription: String; override;
- class function ItemCategory: String; override;
- published
- property Radius: TdReal read GetRadius write SetRadius;
- property Length: TdReal read GetLength write SetLength;
- end;
- // ODE tri-mesh implementation
- TGLODEElementTriMesh = class(TGLODEElementBase)
- private
- FTriMeshData: PdxTriMeshData;
- FVertices: TGLAffineVectorList;
- FIndices: TGLIntegerList;
- protected
- procedure Initialize; override;
- procedure Finalize; override;
- function CalculateMass: TdMass; override;
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- procedure SetVertices(const Value: TGLAffineVectorList);
- procedure SetIndices(const Value: TGLIntegerList);
- public
- constructor Create(AOwner: TXCollection); override;
- destructor Destroy; override;
- class function FriendlyName: String; override;
- class function FriendlyDescription: String; override;
- class function ItemCategory: String; override;
- procedure RefreshTriMeshData;
- property Vertices: TGLAffineVectorList read FVertices write SetVertices;
- property Indices: TGLIntegerList read FIndices write SetIndices;
- end;
- // ODE plane implementation
- TGLODEElementPlane = class(TGLODEElementBase)
- protected
- procedure Initialize; override;
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- procedure AlignGeomElementToMatrix(Mat: TGLMatrix); override;
- public
- class function FriendlyName: String; override;
- class function FriendlyDescription: String; override;
- class function ItemCategory: String; override;
- class function CanAddTo(collection: TXCollection): Boolean; override;
- end;
- // An XCollection decendant for ODE Joints
- TGLODEJoints = class(TXCollection)
- protected
- function GetJoint(index: Integer): TGLODEJointBase;
- public
- class function ItemsClass: TXCollectionItemClass; override;
- procedure Initialize;
- procedure Finalize;
- property Joint[index: Integer]: TGLODEJointBase read GetJoint; default;
- end;
- // Component front-end for storing ODE Joints
- TGLODEJointList = class(TComponent)
- private
- FJoints: TGLODEJoints;
- protected
- procedure WriteJoints(stream: TStream);
- procedure ReadJoints(stream: TStream);
- procedure DefineProperties(Filer: TFiler); override;
- procedure Loaded; override;
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- published
- property Joints: TGLODEJoints read FJoints;
- end;
- TGLODEJointOption = (joBothObjectsMustBeAssigned);
- TGLODEJointOptions = set of TGLODEJointOption;
- // Base structures for ODE Joints
- TGLODEJointBase = class(TXCollectionItem)
- private
- FJointID: TdJointID;
- FObject1,
- FObject2: TGLBaseSceneObject;
- FManager: TGLODEManager;
- FObject1Name,
- FObject2Name,
- FManagerName: String;
- FInitialized,
- FEnabled: Boolean;
- FJointOptions : TGLODEJointOptions;
- protected
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- procedure Loaded; override;
- function IsODEInitialized: Boolean;
- procedure RegisterJointWithObject(Obj: TGLBaseSceneObject);
- procedure UnregisterJointWithObject(Obj: TGLBaseSceneObject);
- procedure Attach;
- procedure SetManager(const Value: TGLODEManager);
- procedure SetObject1(const Value: TGLBaseSceneObject);
- procedure SetObject2(const Value: TGLBaseSceneObject);
- procedure SetEnabled(const Value: Boolean);
- procedure SetJointOptions(const Value : TGLODEJointOptions);
- property JointOptions : TGLODEJointOptions read FJointOptions write SetJointOptions;
- public
- constructor Create(AOwner: TXCollection); override;
- destructor Destroy; override;
- procedure StructureChanged; virtual;
- procedure Initialize; virtual;
- procedure Finalize; virtual;
- function IsAttached: Boolean;
- procedure DoLoaded;
- property JointID: TdJointID read FJointID;
- property Initialized: Boolean read FInitialized;
- published
- property Manager: TGLODEManager read FManager write SetManager;
- property Object1: TGLBaseSceneObject read FObject1 write SetObject1;
- property Object2: TGLBaseSceneObject read FObject2 write SetObject2;
- property Enabled: Boolean read FEnabled write SetEnabled;
- end;
- TGLODESetParamCallback = function(Param: Integer; const Value: TdReal): Boolean of object;
- TGLODEGetParamCallback = function(Param: Integer; var Value: TdReal): Boolean of object;
- TGLODEJointParams = class(TPersistent)
- private
- FOwner: TPersistent;
- FSetCallback: TGLODESetParamCallback;
- FGetCallback: TGLODEGetParamCallback;
- FLoStop,
- FHiStop,
- FVel,
- FFMax,
- FFudgeFactor,
- FBounce,
- FCFM,
- FStopERP,
- FStopCFM,
- FSuspensionERP,
- FSuspensionCFM: TdReal;
- FFlagLoStop,
- FFlagHiStop,
- FFlagVel,
- FFlagFMax,
- FFlagFudgeFactor,
- FFlagBounce,
- FFlagCFM,
- FFlagStopERP,
- FFlagStopCFM,
- FFlagSuspensionERP,
- FFlagSuspensionCFM: Boolean;
- protected
- function GetLoStop: TdReal;
- function GetHiStop: TdReal;
- function GetVel: TdReal;
- function GetFMax: TdReal;
- function GetFudgeFactor: TdReal;
- function GetBounce: TdReal;
- function GetCFM: TdReal;
- function GetStopERP: TdReal;
- function GetStopCFM: TdReal;
- function GetSuspensionERP: TdReal;
- function GetSuspensionCFM: TdReal;
- procedure SetLoStop(const Value: TdReal);
- procedure SetHiStop(const Value: TdReal);
- procedure SetVel(const Value: TdReal);
- procedure SetFMax(const Value: TdReal);
- procedure SetFudgeFactor(const Value: TdReal);
- procedure SetBounce(const Value: TdReal);
- procedure SetCFM(const Value: TdReal);
- procedure SetStopERP(const Value: TdReal);
- procedure SetStopCFM(const Value: TdReal);
- procedure SetSuspensionERP(const Value: TdReal);
- procedure SetSuspensionCFM(const Value: TdReal);
- procedure WriteToFiler(writer: TWriter);
- procedure ReadFromFiler(reader: TReader);
- public
- constructor Create(AOwner: TPersistent);
- function GetOwner: TPersistent; override;
- procedure Assign(Source: TPersistent); override;
- procedure ApplyFlagged;
- property SetCallback: TGLODESetParamCallback read FSetCallback write FSetCallback;
- property GetCallback: TGLODEGetParamCallback read FGetCallback write FGetCallback;
- published
- property LoStop: TdReal read GetLoStop write SetLoStop;
- property HiStop: TdReal read GetHiStop write SetHiStop;
- property Vel: TdReal read GetVel write SetVel;
- property FMax: TdReal read GetFMax write SetFMax;
- property FudgeFactor: TdReal read GetFudgeFactor write SetFudgeFactor;
- property Bounce: TdReal read GetBounce write SetBounce;
- property CFM: TdReal read GetCFM write SetCFM;
- property StopERP: TdReal read GetStopERP write SetStopERP;
- property StopCFM: TdReal read GetStopCFM write SetStopCFM;
- property SuspensionERP: TdReal read GetSuspensionERP write SetSuspensionERP;
- property SuspensionCFM: TdReal read GetSuspensionCFM write SetSuspensionCFM;
- end;
- // ODE hinge joint implementation
- TGLODEJointHinge = class(TGLODEJointBase)
- private
- FAnchor,
- FAxis: TGLCoordinates;
- FAxisParams: TGLODEJointParams;
- protected
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- procedure SetAnchor(const Value: TGLCoordinates);
- procedure SetAxis(const Value: TGLCoordinates);
- procedure AnchorChange(Sender: TObject);
- procedure AxisChange(Sender: TObject);
- procedure SetAxisParams(const Value: TGLODEJointParams);
- function SetAxisParam(Param: Integer; const Value: TdReal): Boolean;
- function GetAxisParam(Param: Integer; var Value: TdReal): Boolean;
- public
- constructor Create(AOwner: TXCollection); override;
- destructor Destroy; override;
- procedure StructureChanged; override;
- procedure Initialize; override;
- class function FriendlyName: String; override;
- class function FriendlyDescription: String; override;
- published
- property Anchor: TGLCoordinates read FAnchor write SetAnchor;
- property Axis: TGLCoordinates read FAxis write SetAxis;
- property AxisParams: TGLODEJointParams read FAxisParams write SetAxisParams;
- end;
- // ODE ball joint implementation
- TGLODEJointBall = class(TGLODEJointBase)
- private
- FAnchor: TGLCoordinates;
- protected
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- procedure SetAnchor(const Value: TGLCoordinates);
- procedure AnchorChange(Sender: TObject);
- public
- constructor Create(AOwner: TXCollection); override;
- destructor Destroy; override;
- procedure StructureChanged; override;
- procedure Initialize; override;
- class function FriendlyName: String; override;
- class function FriendlyDescription: String; override;
- published
- property Anchor: TGLCoordinates read FAnchor write SetAnchor;
- end;
- // ODE slider joint implementation
- TGLODEJointSlider = class(TGLODEJointBase)
- private
- FAxis: TGLCoordinates;
- FAxisParams: TGLODEJointParams;
- protected
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- procedure SetAxis(const Value: TGLCoordinates);
- procedure AxisChange(Sender: TObject);
- procedure SetAxisParams(const Value: TGLODEJointParams);
- function SetAxisParam(Param: Integer; const Value: TdReal): Boolean;
- function GetAxisParam(Param: Integer; var Value: TdReal): Boolean;
- public
- constructor Create(AOwner: TXCollection); override;
- destructor Destroy; override;
- procedure StructureChanged; override;
- procedure Initialize; override;
- class function FriendlyName: String; override;
- class function FriendlyDescription: String; override;
- published
- property Axis: TGLCoordinates read FAxis write SetAxis;
- property AxisParams: TGLODEJointParams read FAxisParams write SetAxisParams;
- end;
- // ODE fixed joint implementation
- TGLODEJointFixed = class(TGLODEJointBase)
- protected
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- public
- class function FriendlyName: String; override;
- class function FriendlyDescription: String; override;
- procedure Initialize; override;
- end;
- // ODE hinge2 joint implementation
- TGLODEJointHinge2 = class(TGLODEJointBase)
- private
- FAnchor,
- FAxis1,
- FAxis2: TGLCoordinates;
- FAxis1Params,
- FAxis2Params: TGLODEJointParams;
- protected
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- procedure SetAnchor(const Value: TGLCoordinates);
- procedure SetAxis1(const Value: TGLCoordinates);
- procedure SetAxis2(const Value: TGLCoordinates);
- procedure AnchorChange(Sender: TObject);
- procedure Axis1Change(Sender: TObject);
- procedure Axis2Change(Sender: TObject);
- procedure SetAxis1Params(const Value: TGLODEJointParams);
- procedure SetAxis2Params(const Value: TGLODEJointParams);
- function SetAxis1Param(Param: Integer; const Value: TdReal): Boolean;
- function SetAxis2Param(Param: Integer; const Value: TdReal): Boolean;
- function GetAxis1Param(Param: Integer; var Value: TdReal): Boolean;
- function GetAxis2Param(Param: Integer; var Value: TdReal): Boolean;
- public
- constructor Create(AOwner: TXCollection); override;
- destructor Destroy; override;
- procedure StructureChanged; override;
- procedure Initialize; override;
- class function FriendlyName: String; override;
- class function FriendlyDescription: String; override;
- published
- property Anchor: TGLCoordinates read FAnchor write SetAnchor;
- property Axis1: TGLCoordinates read FAxis1 write SetAxis1;
- property Axis2: TGLCoordinates read FAxis2 write SetAxis2;
- property Axis1Params: TGLODEJointParams read FAxis1Params write SetAxis1Params;
- property Axis2Params: TGLODEJointParams read FAxis2Params write SetAxis2Params;
- end;
- // ODE universal joint implementation
- TGLODEJointUniversal = class(TGLODEJointBase)
- private
- FAnchor,
- FAxis1,
- FAxis2: TGLCoordinates;
- FAxis1Params,
- FAxis2Params: TGLODEJointParams;
- protected
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- procedure SetAnchor(const Value: TGLCoordinates);
- procedure SetAxis1(const Value: TGLCoordinates);
- procedure SetAxis2(const Value: TGLCoordinates);
- procedure AnchorChange(Sender: TObject);
- procedure Axis1Change(Sender: TObject);
- procedure Axis2Change(Sender: TObject);
- procedure SetAxis1Params(const Value: TGLODEJointParams);
- procedure SetAxis2Params(const Value: TGLODEJointParams);
- function SetAxis1Param(Param: Integer; const Value: TdReal): Boolean;
- function SetAxis2Param(Param: Integer; const Value: TdReal): Boolean;
- function GetAxis1Param(Param: Integer; var Value: TdReal): Boolean;
- function GetAxis2Param(Param: Integer; var Value: TdReal): Boolean;
- public
- constructor Create(AOwner: TXCollection); override;
- destructor Destroy; override;
- procedure Initialize; override;
- procedure StructureChanged; override;
- class function FriendlyName: String; override;
- class function FriendlyDescription: String; override;
- published
- property Anchor: TGLCoordinates read FAnchor write SetAnchor;
- property Axis1: TGLCoordinates read FAxis1 write SetAxis1;
- property Axis2: TGLCoordinates read FAxis2 write SetAxis2;
- property Axis1Params: TGLODEJointParams read FAxis1Params write SetAxis1Params;
- property Axis2Params: TGLODEJointParams read FAxis2Params write SetAxis2Params;
- end;
- TGLODEContactPoint = class
- public
- Position: TAffineVector;
- Normal: TAffineVector;
- Depth: Single;
- end;
- (*The custom collider is designed for generic contact handling. There is a
- contact point generator for sphere, box, capped cylinder, cylinder and cone geoms.
- Once the contact points for a collision are generated the abstract Collide
- function is called to generate the depth and the contact position and normal.
- These points are then sorted and the deepest are applied to ODE *)
- TGLODECustomCollider = class(TGLODEBehaviour)
- private
- FGeom: PdxGeom;
- FContactList,
- FContactCache: TList;
- FTransform: TGLMatrix;
- FContactResolution: Single;
- FRenderContacts: Boolean;
- FContactRenderPoints: TGLAffineVectorList;
- FPointSize: Single;
- FContactColor: TGLColor;
- protected
- procedure Initialize; override;
- procedure Finalize; override;
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- // Test a position for a collision and fill out the contact information.
- function Collide(aPos: TAffineVector; var Depth: Single;
- var cPos, cNorm: TAffineVector): Boolean; virtual; abstract;
- // Clears the contact list so it's ready for another collision.
- procedure ClearContacts;
- // Add a contact point to the list for ApplyContacts to processes.
- procedure AddContact(x, y, z: TdReal); overload;
- procedure AddContact(pos: TAffineVector); overload;
- // Sort the current contact list and apply the deepest to ODE.
- function ApplyContacts(o1, o2: PdxGeom; flags: Integer;
- contact: PdContactGeom; skip: Integer): Integer;
- // Set the transform used that transforms contact points generated with AddContact
- procedure SetTransform(ATransform: TGLMatrix);
- procedure SetContactResolution(const Value: Single);
- procedure SetRenderContacts(const Value: Boolean);
- procedure SetPointSize(const Value: Single);
- procedure SetContactColor(const Value: TGLColor);
- public
- constructor Create(AOwner: TXCollection); override;
- destructor Destroy; override;
- procedure Render(var rci: TGLRenderContextInfo); override;
- property Geom: PdxGeom read FGeom;
- published
- (* Defines the resolution of the contact points created for the colliding
- Geom. The number of contact points generated change base don the size
- of the object and the ContactResolution. Lower values generate higher
- resolution contact boundaries, and thus smoother but slower collisions. *)
- property ContactResolution: Single read FContactResolution write SetContactResolution;
- (* Toggle contact point rendering on and off. (Rendered through the assigned
- Manager.RenderPoint. *)
- property RenderContacts: Boolean read FRenderContacts write SetRenderContacts;
- // Contact point rendering size (in pixels).
- property PointSize: Single read FPointSize write SetPointSize;
- // Contact point rendering color.
- property ContactColor: TGLColor read FContactColor write SetContactColor;
- end;
- (* Add this behaviour to a TGLHeightField or TGLTerrainRenderer to enable
- height based collisions for spheres, boxes, capped cylinders, cylinders and cones. *)
- TGLODEHeightField = class(TGLODECustomCollider)
- protected
- procedure WriteToFiler(writer: TWriter); override;
- procedure ReadFromFiler(reader: TReader); override;
- function Collide(aPos: TAffineVector; var Depth: Single;
- var cPos, cNorm: TAffineVector): Boolean; override;
- public
- constructor Create(AOwner: TXCollection); override;
- class function FriendlyName: string; override;
- class function FriendlyDescription: string; override;
- class function UniqueItem: Boolean; override;
- class function CanAddTo(collection: TXCollection): Boolean; override;
- end;
- (* ODE nearCallBack, throws near callback to the collision procedure
- of the ODE manager linked by the Data pointer *)
- procedure nearCallBack(Data: Pointer; o1, o2: PdxGeom); cdecl;
- { Helper functions for extracting data from objects with different inheritance. }
- function GetBodyFromObject(anObject: TObject): PdxBody;
- function GetBodyFromGLSceneObject(anObject: TGLBaseSceneObject): PdxBody;
- function GetSurfaceFromObject(anObject: TObject): TGLODECollisionSurface;
- // GLODEObject register methods (used for joint object persistence)
- procedure RegisterGLSceneObject(anObject: TGLBaseSceneObject);
- procedure UnregisterGLSceneObject(anObject: TGLBaseSceneObject);
- function GetGLSceneObject(anObjectName: String): TGLBaseSceneObject;
- // Get and GetOrCreate functions for ode behaviours
- function GetOdeStatic(obj: TGLBaseSceneObject): TGLODEStatic;
- function GetOrCreateOdeStatic(obj: TGLBaseSceneObject): TGLODEStatic;
- function GetOdeDynamic(obj: TGLBaseSceneObject): TGLODEDynamic;
- function GetOrCreateOdeDynamic(obj: TGLBaseSceneObject): TGLODEDynamic;
- // Get and GetOrCreate functions for ODE HeightField
- function GetODEHeightField(obj: TGLBaseSceneObject): TGLODEHeightField;
- function GetOrCreateODEHeightField(obj: TGLBaseSceneObject): TGLODEHeightField;
- var
- vODEObjectRegister: TList;
- vCustomColliderClass: TdGeomClass;
- vCustomColliderClassNum: Integer;
- // ------------------------------------------------------------------
- implementation
- // ------------------------------------------------------------------
- procedure nearCallBack(Data: Pointer; o1, o2: PdxGeom); cdecl;
- begin
- TGLODEManager(Data).Collision(o1, o2);
- end;
- function GetBodyFromObject(anObject: TObject): PdxBody;
- begin
- Result := nil;
- if Assigned(anObject) then
- if anObject is TGLODEDynamic then
- Result := TGLODEDynamic(anObject).Body;
- end;
- function GetBodyFromGLSceneObject(anObject: TGLBaseSceneObject): PdxBody;
- var
- temp: TGLODEDynamic;
- begin
- Result := nil;
- if Assigned(anObject) then
- begin
- temp := TGLODEDynamic(anObject.Behaviours.GetByClass(TGLODEDynamic));
- if temp <> nil then
- Result := temp.Body;
- end;
- end;
- function GetSurfaceFromObject(anObject: TObject): TGLODECollisionSurface;
- var
- ODEBehaviour: TGLODEBehaviour;
- begin
- Result := nil;
- if Assigned(anObject) then
- if anObject is TGLODEBehaviour then
- Result := TGLODEBehaviour(anObject).Surface
- else
- begin
- if (anObject is TGLBaseSceneObject) then
- begin
- ODEBehaviour := TGLODEBehaviour(TGLBaseSceneObject(anObject).Behaviours.GetByClass(TGLODEBehaviour));
- if Assigned(ODEBehaviour) then
- Result := ODEBehaviour.Surface
- end;
- end;
- end;
- function IsGLODEObject(Obj: TGLBaseSceneObject): Boolean;
- var
- temp: TGLODEDynamic;
- begin
- Result := False;
- if Assigned(Obj) then
- begin
- temp := TGLODEDynamic(Obj.Behaviours.GetByClass(TGLODEDynamic));
- Result := Assigned(temp);
- end;
- end;
- procedure RegisterGLSceneObject(anObject: TGLBaseSceneObject);
- begin
- if vODEObjectRegister.IndexOf(anObject) = -1 then
- vODEObjectRegister.Add(anObject);
- end;
- procedure UnregisterGLSceneObject(anObject: TGLBaseSceneObject);
- begin
- vODEObjectRegister.Remove(anObject);
- end;
- function GetGLSceneObject(anObjectName: String): TGLBaseSceneObject;
- var
- i: Integer;
- begin
- Result := nil;
- for i := 0 to vODEObjectRegister.Count - 1 do
- if TGLBaseSceneObject(vODEObjectRegister[i]).GetNamePath = anObjectName then
- begin
- Result := vODEObjectRegister[i];
- Exit;
- end;
- end;
- function GetODEStatic(Obj: TGLBaseSceneObject): TGLODEStatic;
- begin
- Result := TGLODEStatic(Obj.Behaviours.GetByClass(TGLODEStatic));
- end;
- function GetOrCreateOdeStatic(Obj: TGLBaseSceneObject): TGLODEStatic;
- begin
- Result := TGLODEStatic(Obj.GetOrCreateBehaviour(TGLODEStatic));
- end;
- function GetODEDynamic(Obj: TGLBaseSceneObject): TGLODEDynamic;
- begin
- Result := TGLODEDynamic(Obj.Behaviours.GetByClass(TGLODEDynamic));
- end;
- function GetOrCreateOdeDynamic(Obj: TGLBaseSceneObject): TGLODEDynamic;
- begin
- Result := TGLODEDynamic(Obj.GetOrCreateBehaviour(TGLODEDynamic));
- end;
- function GetODEHeightField(obj: TGLBaseSceneObject): TGLODEHeightField;
- begin
- Result:= TGLODEHeightField(obj.Behaviours.GetByClass(TGLODEHeightField));
- end;
- function GetOrCreateODEHeightField(obj: TGLBaseSceneObject): TGLODEHeightField;
- begin
- Result:= TGLODEHeightField(obj.GetOrCreateBehaviour(TGLODEHeightField));
- end;
- function GetColliderFromGeom(aGeom: PdxGeom): TGLODECustomCollider;
- var
- temp: TObject;
- begin
- Result:= nil;
- temp:= dGeomGetData(aGeom);
- if Assigned(temp) then
- if temp is TGLODECustomCollider then
- Result:= TGLODECustomCollider(temp);
- end;
- function ContactSort(Item1, Item2: Pointer): Integer;
- var
- c1, c2: TGLODEContactPoint;
- begin
- c1 := TGLODEContactPoint(Item1);
- c2 := TGLODEContactPoint(Item2);
- if c1.Depth > c2.Depth then
- result := -1
- else if c1.Depth = c2.Depth then
- result := 0
- else
- result := 1;
- end;
- function CollideSphere(o1, o2: PdxGeom; flags: Integer; contact: PdContactGeom;
- skip: Integer): Integer; cdecl;
- var
- Collider: TGLODECustomCollider;
- i, j, res: Integer;
- pos: PdVector3;
- R: PdMatrix3;
- rmat, mat: TGLMatrix;
- rad, dx, dy, dz: TdReal;
- begin
- Result := 0;
- Collider := GetColliderFromGeom(o1);
- if not Assigned(Collider) then
- exit;
- pos := dGeomGetPosition(o2);
- R := dGeomGetRotation(o2);
- ODERToGLSceneMatrix(mat, R^, pos^);
- Collider.SetTransform(mat);
- rad := dGeomSphereGetRadius(o2);
- res := Round(10 * rad / Collider.ContactResolution);
- if res < 8 then
- res := 8;
- Collider.AddContact(0, 0, -rad);
- Collider.AddContact(0, 0, rad);
- rmat := CreateRotationMatrixZ(2 * Pi / res);
- for i := 0 to res - 1 do
- begin
- mat := MatrixMultiply(rmat, mat);
- Collider.SetTransform(mat);
- for j := -(res div 2) + 1 to (res div 2) - 1 do
- begin
- dx := rad * cos(j * Pi / res);
- dy := 0;
- dz := rad * sin(j * Pi / res);
- Collider.AddContact(dx, dy, dz);
- end;
- end;
- Result := Collider.ApplyContacts(o1, o2, flags, contact, skip);
- Collider.SetTransform(IdentityHMGMatrix);
- end;
- function CollideBox(o1, o2: PdxGeom; flags: Integer; contact: PdContactGeom;
- skip: Integer): Integer; cdecl;
- var
- Collider: TGLODECustomCollider;
- i, j, res: Integer;
- rcpres, len1, len2: Single;
- s: TdVector3;
- pos: PdVector3;
- R: PdMatrix3;
- mat: TGLMatrix;
- begin
- Result := 0;
- Collider := GetColliderFromGeom(o1);
- if not Assigned(Collider) then
- exit;
- pos := dGeomGetPosition(o2);
- R := dGeomGetRotation(o2);
- ODERToGLSceneMatrix(mat, R^, pos^);
- Collider.SetTransform(mat);
- dGeomBoxGetLengths(o2, s);
- res := Round(Sqrt(MaxFloat([s[0], s[1], s[2]])) / Collider.ContactResolution);
- if res < 1 then
- res := 1;
- rcpres := 1 / res;
- s[0] := 0.5 * s[0];
- s[1] := 0.5 * s[1];
- s[2] := 0.5 * s[2];
- with Collider do
- begin
- // Corners
- AddContact(s[0], s[1], s[2]);
- AddContact(s[0], s[1], -s[2]);
- AddContact(s[0], -s[1], s[2]);
- AddContact(s[0], -s[1], -s[2]);
- AddContact(-s[0], s[1], s[2]);
- AddContact(-s[0], s[1], -s[2]);
- AddContact(-s[0], -s[1], s[2]);
- AddContact(-s[0], -s[1], -s[2]);
- // Edges
- for i := -(res - 1) to (res - 1) do
- begin
- len1 := i * rcpres * s[0];
- AddContact(len1, s[1], s[2]);
- AddContact(len1, s[1], -s[2]);
- AddContact(len1, -s[1], s[2]);
- AddContact(len1, -s[1], -s[2]);
- len1 := i * rcpres * s[1];
- AddContact(s[0], len1, s[2]);
- AddContact(s[0], len1, -s[2]);
- AddContact(-s[0], len1, s[2]);
- AddContact(-s[0], len1, -s[2]);
- len1 := i * rcpres * s[2];
- AddContact(s[0], s[1], len1);
- AddContact(s[0], -s[1], len1);
- AddContact(-s[0], s[1], len1);
- AddContact(-s[0], -s[1], len1);
- end;
- // Faces
- for i := -(res - 1) to (res - 1) do
- for j := -(res - 1) to (res - 1) do
- begin
- len1 := i * rcpres * s[0];
- len2 := j * rcpres * s[1];
- AddContact(len1, len2, s[2]);
- AddContact(len1, len2, -s[2]);
- len2 := j * rcpres * s[2];
- AddContact(len1, s[1], len2);
- AddContact(len1, -s[1], len2);
- len1 := i * rcpres * s[1];
- AddContact(s[0], len1, len2);
- AddContact(-s[0], len1, len2);
- end;
- end;
- Result := Collider.ApplyContacts(o1, o2, flags, contact, skip);
- Collider.SetTransform(IdentityHMGMatrix);
- end;
- function CollideCapsule(o1, o2: PdxGeom; flags: Integer; contact: PdContactGeom;
- skip: Integer): Integer; cdecl;
- var
- Collider: TGLODECustomCollider;
- i, j, res: Integer;
- pos: PdVector3;
- R: PdMatrix3;
- mat, rmat: TGLMatrix;
- rad, len, dx, dy, dz: TdReal;
- begin
- Result := 0;
- Collider := GetColliderFromGeom(o1);
- if not Assigned(Collider) then
- exit;
- pos := dGeomGetPosition(o2);
- R := dGeomGetRotation(o2);
- ODERToGLSceneMatrix(mat, R^, pos^);
- Collider.SetTransform(mat);
- dGeomCapsuleGetParams(o2, rad, len);
- res := Round(5 * MaxFloat(4 * rad, len) / Collider.ContactResolution);
- if res < 8 then
- res := 8;
- rmat := CreateRotationMatrixZ(2 * Pi / res);
- with Collider do
- begin
- AddContact(0, 0, -rad - 0.5 * len);
- AddContact(0, 0, rad + 0.5 * len);
- for i := 0 to res - 1 do
- begin
- mat := MatrixMultiply(rmat, mat);
- SetTransform(mat);
- for j := 0 to res do
- AddContact(rad, 0, len * (j / res - 0.5));
- for j := 1 to (res div 2) - 1 do
- begin
- dx := rad * cos(j * Pi / res);
- dy := 0;
- dz := rad * sin(j * Pi / res);
- Collider.AddContact(dx, dy, -dz - 0.5 * len);
- Collider.AddContact(dx, dy, dz + 0.5 * len);
- end;
- end;
- end;
- Result := Collider.ApplyContacts(o1, o2, flags, contact, skip);
- Collider.SetTransform(IdentityHMGMatrix);
- end;
- function CollideCylinder(o1, o2: PdxGeom; flags: Integer;
- contact: PdContactGeom; skip: Integer): Integer; cdecl;
- var
- Collider: TGLODECustomCollider;
- i, j, res: Integer;
- pos: PdVector3;
- R: PdMatrix3;
- mat: TGLMatrix;
- rad, len, dx, dy: TdReal;
- begin
- Result := 0;
- Collider := GetColliderFromGeom(o1);
- if not Assigned(Collider) then
- exit;
- pos := dGeomGetPosition(o2);
- R := dGeomGetRotation(o2);
- ODERToGLSceneMatrix(mat, R^, pos^);
- Collider.SetTransform(mat);
- dGeomCylinderGetParams(o2, rad, len);
- res := Round(5 * MaxFloat(4 * rad, len) / Collider.ContactResolution);
- if res < 8 then
- res := 8;
- with Collider do
- begin
- AddContact(0, -0.5 * len, 0);
- AddContact(0, 0.5 * len, 0);
- for i := 0 to res - 1 do
- begin
- SinCosine(2 * Pi * i / res, rad, dy, dx);
- AddContact(dx, -0.5 * len, dy);
- AddContact(dx, 0, dy);
- AddContact(dx, 0.5 * len, dy);
- for j := 0 to res do
- AddContact(dx, len * (j / res - 0.5), dy);
- for j := 1 to (res div 2) - 1 do
- begin
- SinCosine(2 * Pi * i / res, rad * j / (res div 2), dy, dx);
- AddContact(dx, -0.5 * len, dy);
- AddContact(dx, 0.5 * len, dy);
- end;
- end;
- end;
- Result := Collider.ApplyContacts(o1, o2, flags, contact, skip);
- Collider.SetTransform(IdentityHMGMatrix);
- end;
- function GetCustomColliderFn(num: Integer): TdColliderFn; cdecl;
- begin
- if num = dSphereClass then
- Result := CollideSphere
- else if num = dBoxClass then
- Result := CollideBox
- else if num = dCapsuleClass then
- Result := CollideCapsule
- else if num = dCylinderClass then
- Result := CollideCylinder
- else
- Result := nil;
- end;
- // ---------------
- // --------------- TGLODEManager ---------------
- // ---------------
- constructor TGLODEManager.Create(AOwner: TComponent);
- begin
- FWorld := nil;
- if not InitODE('') then
- raise Exception.Create('ODE failed to initialize.');
- inherited;
- FODEBehaviours:= TGLPersistentObjectList.Create;
- FRFContactList:= TList.Create;
- FGravity:= TGLCoordinates.CreateInitialized(Self, NullHmgPoint, csVector);
- FGravity.OnNotifyChange:= GravityChange;
- FSolver:= osmDefault;
- FIterations:= 3;
- MaxContacts:= 8;
- if not (csDesigning in ComponentState) then
- begin
- FWorld := dWorldCreate;
- FSpace := dHashSpaceCreate(nil);
- dWorldSetCFM(FWorld, 1E-5);
- dWorldSetQuickStepNumIterations(FWorld, FIterations);
- FContactGroup := dJointGroupCreate(100);
- end;
- FGeomColorDynD := TGLColor.CreateInitialized(Self, clrRed, GeomColorChangeDynD);
- FGeomColorDynE := TGLColor.CreateInitialized(Self, clrLime, GeomColorChangeDynE);
- FGeomColorStat := TGLColor.CreateInitialized(Self, clrBlue, GeomColorChangeStat);
- RegisterManager(Self);
- end;
- destructor TGLODEManager.Destroy;
- begin
- RenderPoint := nil;
- // Unregister everything
- while FODEBehaviours.Count > 0 do
- ODEBehaviours[0].Manager:= nil;
- // Clean up everything
- FODEBehaviours.Free;
- FGravity.Free;
- FRFContactList.Free;
- if Assigned(FWorld) then
- begin
- dJointGroupEmpty(FContactGroup);
- dJointGroupDestroy(FContactGroup);
- dSpaceDestroy(FSpace);
- dWorldDestroy(FWorld);
- end;
- FGeomColorDynD.Free;
- FGeomColorDynE.Free;
- FGeomColorStat.Free;
- DeregisterManager(Self);
- inherited Destroy;
- end;
- procedure TGLODEManager.RegisterODEBehaviour(ODEBehaviour: TGLODEBehaviour);
- begin
- FODEBehaviours.Add(ODEBehaviour);
- end;
- procedure TGLODEManager.UnregisterODEBehaviour(ODEBehaviour: TGLODEBehaviour);
- begin
- FODEBehaviours.Remove(ODEBehaviour);
- end;
- procedure TGLODEManager.Loaded;
- begin
- GravityChange(Self);
- end;
- procedure TGLODEManager.SetGravity(Value: TGLCoordinates);
- begin
- FGravity.SetPoint(Value.DirectX, Value.DirectY, Value.DirectZ);
- end;
- procedure TGLODEManager.GravityChange(Sender: TObject);
- begin
- if Assigned(FWorld) then
- dWorldSetGravity(FWorld, FGravity.X, FGravity.Y, FGravity.Z);
- end;
- procedure TGLODEManager.CalcContact(Object1, Object2: TObject; var Contact: TdContact);
- var
- Surface1, Surface2: TGLODECollisionSurface;
- Body1, Body2: PdxBody;
- begin
- Surface1 := GetSurfaceFromObject(Object1);
- Surface2 := GetSurfaceFromObject(Object2);
- if not(Assigned(Surface1) and Assigned(Surface2)) then
- Exit;
- with Contact.Surface do
- begin
- // Average the involved contact information and assign it to the contact.
- // Better methods for contact calculation will be looked into in the future.
- mode:= Surface1.FSurfaceParams.mode or Surface2.FSurfaceParams.mode;
- Mu:= (Surface1.Mu + Surface2.Mu) * 0.5;
- Mu2:= (Surface1.Mu2 + Surface2.Mu2) * 0.5;
- Bounce:= (Surface1.Bounce + Surface2.Bounce) * 0.5;
- Bounce_Vel:= (Surface1.Bounce_Vel + Surface2.Bounce_Vel) * 0.5;
- soft_erp:= (Surface1.SoftERP + Surface2.SoftERP) * 0.5;
- soft_cfm:= (Surface1.SoftCFM + Surface2.SoftCFM) * 0.5;
- Motion1:= (Surface1.Motion1 + Surface2.Motion1) * 0.5;
- Motion2:= (Surface1.Motion2 + Surface2.Motion2) * 0.5;
- Slip1:= (Surface1.Slip1 + Surface2.Slip1) * 0.5;
- Slip2:= (Surface1.Slip2 + Surface2.Slip2) * 0.5;
- end;
- // Rolling friction
- Body1:= GetBodyFromObject(Object1);
- Body2:= GetBodyFromObject(Object2);
- if (Surface1.RollingFrictionEnabled) and Assigned(Body1) then
- FRFContactList.Add(Object1);
- if (Surface2.RollingFrictionEnabled) and Assigned(Body2) then
- FRFContactList.Add(Object2);
- end;
- procedure TGLODEManager.Collision(g1, g2: PdxGeom);
- var
- i, flags, num_contacts: Integer;
- Obj1, Obj2: Pointer;
- b1, b2: PdxBody;
- Joint: TdJointID;
- HandleCollision: Boolean;
- begin
- // Check for custom collision handling event
- if Assigned(FOnCustomCollision) then
- begin
- FOnCustomCollision(g1, g2);
- Exit;
- end;
- Obj1:= dGeomGetData(g1);
- Obj2:= dGeomGetData(g2);
- b1:= dGeomGetBody(g1);
- b2:= dGeomGetBody(g2);
- // don't create contact between static objects
- if not Assigned(b1) and not Assigned(b2) then
- Exit;
- if Assigned(b1) and Assigned(b2) then
- if dAreConnected(b1, b2) = 1 then
- Exit;
- // Get the collisions
- flags := $0000FFFF and FMaxContacts;
- num_contacts := dCollide(g1, g2, flags, FContactGeoms[0], SizeOf(TdContactGeom));
- // Set up the initial contact info
- for i := 0 to num_contacts - 1 do
- begin
- FContacts[i].Geom := FContactGeoms[i];
- end;
- for i := 0 to num_contacts - 1 do
- begin
- HandleCollision := True;
- if Assigned(Obj1) and Assigned(Obj2) then
- begin
- // Calculate the contact based on Obj1 and Obj2 surface info
- CalcContact(Obj1, Obj2, FContacts[i]);
- if Assigned(FOnCollision) then
- begin
- // Fire the Scene level OnCollision event for last minute
- // customization to the contact before the contact joint
- // is created
- FOnCollision(Self, Obj1, Obj2, FContacts[i], HandleCollision);
- end;
- // Fire the OnCollision event for each object
- if TObject(Obj1) is TGLODEBehaviour then
- if Assigned(TGLODEBehaviour(Obj1).FOnCollision) then
- TGLODEBehaviour(Obj1).FOnCollision(Self, Obj2, FContacts[i], HandleCollision);
- if TObject(Obj2) is TGLODEBehaviour then
- if Assigned(TGLODEBehaviour(Obj2).FOnCollision) then
- TGLODEBehaviour(Obj2).FOnCollision(Self, Obj1, FContacts[i], HandleCollision);
- end
- else
- begin
- // Default surface values
- FContacts[i].Surface.Mu := 1000;
- end;
- if HandleCollision then
- begin
- // Creates and assign the contact joint
- Joint := dJointCreateContact(FWorld, FContactGroup, @FContacts[i]);
- dJointAttach(Joint, b1, b2);
- // Increment the number of contact joints this step
- Inc(FNumContactJoints);
- end;
- end;
- end;
- procedure TGLODEManager.Step(deltaTime: double);
- var
- i: Integer;
- vec: PdVector3;
- Body: PdxBody;
- Coeff: Single;
- begin
- if not Assigned(World) then
- Exit;
- // Reset the contact joint counter
- FNumContactJoints:= 0;
- // Align static elements to their GLScene parent objects
- for i:= 0 to FODEBehaviours.Count - 1 do
- if ODEBehaviours[i] is TGLODEStatic then
- if ODEBehaviours[i].Initialized then
- TGLODEStatic(ODEBehaviours[i]).AlignElements;
- // Run ODE collisions and step the scene
- dSpaceCollide(FSpace, Self, nearCallBack);
- case FSolver of
- osmDefault: dWorldStep(FWorld, deltaTime);
- osmQuickStep: dWorldQuickStep(FWorld, deltaTime);
- end;
- dJointGroupEmpty(FContactGroup);
- // Align dynamic objects to their ODE bodies
- for i := 0 to FODEBehaviours.Count - 1 do
- if ODEBehaviours[i] is TGLODEDynamic then
- if ODEBehaviours[i].Initialized then
- TGLODEDynamic(ODEBehaviours[i]).AlignObject;
- // Process rolling friction
- Coeff := 0;
- Body := nil;
- while FRFContactList.Count > 0 do
- begin
- if TObject(FRFContactList[0]) is TGLODEDynamic then
- begin
- Body := TGLODEDynamic(FRFContactList[0]).Body;
- Coeff := 1 - (TGLODEDynamic(FRFContactList[0]).Surface.RollingFrictionCoeff /
- TGLODEDynamic(FRFContactList[0]).Mass.Mass);
- end;
- vec := dBodyGetAngularVel(Body);
- dBodySetAngularVel(Body, vec[0] * Coeff, vec[1] * Coeff, vec[2] * Coeff);
- FRFContactList.Delete(0);
- end;
- end;
- procedure TGLODEManager.NotifyChange(Sender: TObject);
- begin
- if Assigned(RenderPoint) then
- RenderPoint.StructureChanged;
- end;
- procedure TGLODEManager.SetIterations(const val: Integer);
- begin
- FIterations := val;
- if Assigned(FWorld) then
- dWorldSetQuickStepNumIterations(FWorld, FIterations);
- end;
- procedure TGLODEManager.SetMaxContacts(const Value: Integer);
- begin
- if Value <> FMaxContacts then
- begin
- FMaxContacts := Value;
- SetLength(FContacts, FMaxContacts);
- SetLength(FContactGeoms, FMaxContacts);
- end;
- end;
- function TGLODEManager.GetODEBehaviour(index: Integer): TGLODEBehaviour;
- begin
- Result := TGLODEBehaviour(FODEBehaviours[index]);
- end;
- procedure TGLODEManager.SetRenderPoint(const Value: TGLRenderPoint);
- begin
- if FRenderPoint <> Value then
- begin
- if Assigned(FRenderPoint) then
- FRenderPoint.UnRegisterCallBack(RenderEvent);
- FRenderPoint := Value;
- if Assigned(FRenderPoint) then
- FRenderPoint.RegisterCallBack(RenderEvent, RenderPointFreed);
- end;
- end;
- procedure TGLODEManager.RenderEvent(Sender: TObject; var rci: TGLRenderContextInfo);
- var
- i: Integer;
- begin
- if not Visible then
- Exit;
- if not(csDesigning in ComponentState) then
- if not VisibleAtRunTime then
- Exit;
- gl.PushAttrib(GL_ENABLE_BIT + GL_CURRENT_BIT + GL_POLYGON_BIT);
- gl.Disable(GL_LIGHTING);
- gl.Enable(GL_POLYGON_OFFSET_LINE);
- gl.PolygonOffset(1, 2);
- for i := 0 to FODEBehaviours.Count - 1 do
- begin
- if ODEBehaviours[i] is TGLODEDynamic then
- if TGLODEDynamic(ODEBehaviours[i]).GetEnabled then
- gl.Color4fv(PGLFloat(GeomColorDynE.AsAddress))
- else
- gl.Color4fv(PGLFloat(GeomColorDynD.AsAddress))
- else
- gl.Color4fv(PGLFloat(GeomColorStat.AsAddress));
- ODEBehaviours[i].Render(rci);
- end;
- end;
- procedure TGLODEManager.RenderPointFreed(Sender: TObject);
- begin
- FRenderPoint := nil;
- end;
- procedure TGLODEManager.SetVisible(const Value: Boolean);
- begin
- if Value <> FVisible then
- begin
- FVisible := Value;
- NotifyChange(Self);
- end;
- end;
- procedure TGLODEManager.SetVisibleAtRunTime(const Value: Boolean);
- begin
- if Value <> FVisibleAtRunTime then
- begin
- FVisibleAtRunTime := Value;
- NotifyChange(Self);
- end;
- end;
- procedure TGLODEManager.SetGeomColorDynD(const Value: TGLColor);
- begin
- FGeomColorDynD.Assign(Value);
- NotifyChange(Self);
- end;
- procedure TGLODEManager.GeomColorChangeDynD(Sender: TObject);
- begin
- NotifyChange(Self);
- end;
- procedure TGLODEManager.SetGeomColorDynE(const Value: TGLColor);
- begin
- FGeomColorDynE.Assign(Value);
- NotifyChange(Self);
- end;
- procedure TGLODEManager.GeomColorChangeDynE(Sender: TObject);
- begin
- NotifyChange(Self);
- end;
- procedure TGLODEManager.SetGeomColorStat(const Value: TGLColor);
- begin
- FGeomColorStat.Assign(Value);
- NotifyChange(Self);
- end;
- procedure TGLODEManager.GeomColorChangeStat(Sender: TObject);
- begin
- NotifyChange(Self);
- end;
- // ---------------
- // --------------- TGLODECollisionSurface ---------------
- // ---------------
- constructor TGLODECollisionSurface.Create(AOwner: TPersistent);
- begin
- inherited Create;
- FOwner := AOwner;
- Mu := 1000;
- RollingFrictionEnabled := False;
- RollingFrictionCoeff := 0.001; // Larger Coeff = more friction
- end;
- function TGLODECollisionSurface.GetOwner: TPersistent;
- begin
- Result := FOwner;
- end;
- procedure TGLODECollisionSurface.Assign(Source: TPersistent);
- begin
- inherited;
- if not Assigned(Source) then
- Exit;
- if Source is TGLODECollisionSurface then
- begin
- RollingFrictionCoeff := TGLODECollisionSurface(Source).RollingFrictionCoeff;
- RollingFrictionEnabled := TGLODECollisionSurface(Source).RollingFrictionEnabled;
- SurfaceMode := TGLODECollisionSurface(Source).SurfaceMode;
- Mu := TGLODECollisionSurface(Source).Mu;
- Mu2 := TGLODECollisionSurface(Source).Mu2;
- Bounce := TGLODECollisionSurface(Source).Bounce;
- Bounce_Vel := TGLODECollisionSurface(Source).Bounce_Vel;
- SoftERP := TGLODECollisionSurface(Source).SoftERP;
- SoftCFM := TGLODECollisionSurface(Source).SoftCFM;
- Motion1 := TGLODECollisionSurface(Source).Motion1;
- Motion2 := TGLODECollisionSurface(Source).Motion2;
- Slip1 := TGLODECollisionSurface(Source).Slip1;
- Slip2 := TGLODECollisionSurface(Source).Slip2;
- end;
- end;
- procedure TGLODECollisionSurface.WriteToFiler(writer: TWriter);
- var
- mode: TGLODESurfaceModes;
- begin
- with writer do
- begin
- WriteInteger(0);
- WriteFloat(RollingFrictionCoeff);
- WriteBoolean(RollingFrictionEnabled);
- mode := SurfaceMode;
- Write(mode, SizeOf(TGLODESurfaceModes));
- WriteFloat(Mu);
- WriteFloat(Mu2);
- WriteFloat(Bounce);
- WriteFloat(Bounce_Vel);
- WriteFloat(SoftERP);
- WriteFloat(SoftCFM);
- WriteFloat(Motion1);
- WriteFloat(Motion2);
- WriteFloat(Slip1);
- WriteFloat(Slip2);
- end;
- end;
- procedure TGLODECollisionSurface.ReadFromFiler(reader: TReader);
- var
- archiveVersion: Integer;
- mode: TGLODESurfaceModes;
- begin
- with reader do
- begin
- archiveVersion := ReadInteger;
- Assert(archiveVersion = 0);
- RollingFrictionCoeff := ReadFloat;
- RollingFrictionEnabled := ReadBoolean;
- Read(mode, SizeOf(TGLODESurfaceModes));
- SurfaceMode := mode;
- Mu := ReadFloat;
- Mu2 := ReadFloat;
- Bounce := ReadFloat;
- Bounce_Vel := ReadFloat;
- SoftERP := ReadFloat;
- SoftCFM := ReadFloat;
- Motion1 := ReadFloat;
- Motion2 := ReadFloat;
- Slip1 := ReadFloat;
- Slip2 := ReadFloat;
- end;
- end;
- function TGLODECollisionSurface.GetSurfaceMode: TGLODESurfaceModes;
- var
- ASurfaceModes: TGLODESurfaceModes;
- begin
- ASurfaceModes := [];
- if (FSurfaceParams.mode and dContactSlip2) <> 0 then
- ASurfaceModes := ASurfaceModes + [csmSlip2];
- if (FSurfaceParams.mode and dContactSlip1) <> 0 then
- ASurfaceModes := ASurfaceModes + [csmSlip1];
- if (FSurfaceParams.mode and dContactMotion2) <> 0 then
- ASurfaceModes := ASurfaceModes + [csmMotion2];
- if (FSurfaceParams.mode and dContactMotion1) <> 0 then
- ASurfaceModes := ASurfaceModes + [csmMotion1];
- if (FSurfaceParams.mode and dContactSoftCFM) <> 0 then
- ASurfaceModes := ASurfaceModes + [csmSoftCFM];
- if (FSurfaceParams.mode and dContactSoftERP) <> 0 then
- ASurfaceModes := ASurfaceModes + [csmSoftERP];
- if (FSurfaceParams.mode and dContactBounce) <> 0 then
- ASurfaceModes := ASurfaceModes + [csmBounce];
- if (FSurfaceParams.mode and dContactFDir1) <> 0 then
- ASurfaceModes := ASurfaceModes + [csmFDir1];
- if (FSurfaceParams.mode and dContactMu2) <> 0 then
- ASurfaceModes := ASurfaceModes + [csmMu2];
- Result := ASurfaceModes;
- end;
- procedure TGLODECollisionSurface.SetSurfaceMode(Value: TGLODESurfaceModes);
- var
- AMode: Integer;
- begin
- AMode := 0;
- if csmSlip2 in Value then
- AMode := AMode or dContactSlip2;
- if csmSlip1 in Value then
- AMode := AMode or dContactSlip1;
- if csmMotion2 in Value then
- AMode := AMode or dContactMotion2;
- if csmMotion1 in Value then
- AMode := AMode or dContactMotion1;
- if csmSoftCFM in Value then
- AMode := AMode or dContactSoftCFM;
- if csmSoftERP in Value then
- AMode := AMode or dContactSoftERP;
- if csmBounce in Value then
- AMode := AMode or dContactBounce;
- if csmFDir1 in Value then
- AMode := AMode or dContactFDir1;
- if csmMu2 in Value then
- AMode := AMode or dContactMu2;
- FSurfaceParams.mode := AMode;
- end;
- function TGLODECollisionSurface.GetMu: TdReal;
- begin
- Result := FSurfaceParams.Mu;
- end;
- function TGLODECollisionSurface.GetMu2: TdReal;
- begin
- Result := FSurfaceParams.Mu2;
- end;
- function TGLODECollisionSurface.GetBounce: TdReal;
- begin
- Result := FSurfaceParams.Bounce;
- end;
- function TGLODECollisionSurface.GetBounce_Vel: TdReal;
- begin
- Result := FSurfaceParams.Bounce_Vel;
- end;
- function TGLODECollisionSurface.GetSoftERP: TdReal;
- begin
- Result := FSurfaceParams.soft_erp;
- end;
- function TGLODECollisionSurface.GetSoftCFM: TdReal;
- begin
- Result := FSurfaceParams.soft_cfm;
- end;
- function TGLODECollisionSurface.GetMotion1: TdReal;
- begin
- Result := FSurfaceParams.Motion1;
- end;
- function TGLODECollisionSurface.GetMotion2: TdReal;
- begin
- Result := FSurfaceParams.Motion2;
- end;
- function TGLODECollisionSurface.GetSlip1: TdReal;
- begin
- Result := FSurfaceParams.Slip1;
- end;
- function TGLODECollisionSurface.GetSlip2: TdReal;
- begin
- Result := FSurfaceParams.Slip2;
- end;
- procedure TGLODECollisionSurface.SetMu(Value: TdReal);
- begin
- FSurfaceParams.Mu := Value;
- end;
- procedure TGLODECollisionSurface.SetMu2(Value: TdReal);
- begin
- FSurfaceParams.Mu2 := Value;
- end;
- procedure TGLODECollisionSurface.SetBounce(Value: TdReal);
- begin
- FSurfaceParams.Bounce := Value;
- end;
- procedure TGLODECollisionSurface.SetBounce_Vel(Value: TdReal);
- begin
- FSurfaceParams.Bounce_Vel := Value;
- end;
- procedure TGLODECollisionSurface.SetSoftERP(Value: TdReal);
- begin
- FSurfaceParams.soft_erp := Value;
- end;
- procedure TGLODECollisionSurface.SetSoftCFM(Value: TdReal);
- begin
- FSurfaceParams.soft_cfm := Value;
- end;
- procedure TGLODECollisionSurface.SetMotion1(Value: TdReal);
- begin
- FSurfaceParams.Motion1 := Value;
- end;
- procedure TGLODECollisionSurface.SetMotion2(Value: TdReal);
- begin
- FSurfaceParams.Motion2 := Value;
- end;
- procedure TGLODECollisionSurface.SetSlip1(Value: TdReal);
- begin
- FSurfaceParams.Slip1 := Value;
- end;
- procedure TGLODECollisionSurface.SetSlip2(Value: TdReal);
- begin
- FSurfaceParams.Slip2 := Value;
- end;
- // ---------------
- // --------------- TGLODEBehaviour --------------
- // ---------------
- constructor TGLODEBehaviour.Create(AOwner: TXCollection);
- begin
- inherited;
- FSurface := TGLODECollisionSurface.Create(Self);
- FInitialized := False;
- FOwnerBaseSceneObject := OwnerBaseSceneObject;
- if Assigned(FOwnerBaseSceneObject) then
- RegisterGLSceneObject(OwnerBaseSceneObject);
- end;
- destructor TGLODEBehaviour.Destroy;
- begin
- if Assigned(Manager) then
- Manager := nil;
- if Assigned(FOwnerBaseSceneObject) then
- UnregisterGLSceneObject(FOwnerBaseSceneObject);
- FSurface.Free;
- inherited;
- end;
- procedure TGLODEBehaviour.Initialize;
- begin
- FInitialized := True;
- end;
- procedure TGLODEBehaviour.Finalize;
- begin
- FInitialized := False;
- end;
- procedure TGLODEBehaviour.Reinitialize;
- begin
- if Initialized then
- Finalize;
- Initialize;
- end;
- procedure TGLODEBehaviour.WriteToFiler(writer: TWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(0); // Archive version
- if Assigned(FManager) then
- WriteString(FManager.GetNamePath)
- else
- WriteString('');
- Surface.WriteToFiler(writer);
- end;
- end;
- procedure TGLODEBehaviour.ReadFromFiler(reader: TReader);
- begin
- inherited;
- with reader do
- begin
- Assert(ReadInteger = 0); // Archive version
- FManagerName := ReadString;
- Surface.ReadFromFiler(reader);
- end;
- end;
- procedure TGLODEBehaviour.Loaded;
- var
- mng: TComponent;
- begin
- inherited;
- if FManagerName <> '' then
- begin
- mng := FindManager(TGLODEManager, FManagerName);
- if Assigned(mng) then
- Manager := TGLODEManager(mng);
- FManagerName := '';
- end
- end;
- procedure TGLODEBehaviour.Render(var rci: TGLRenderContextInfo);
- begin
- // virtual
- end;
- procedure TGLODEBehaviour.NotifyChange(Sender: TObject);
- begin
- if Assigned(Manager) then
- Manager.NotifyChange(Self);
- end;
- procedure TGLODEBehaviour.SetManager(Value: TGLODEManager);
- begin
- if FManager <> Value then
- begin
- if Assigned(FManager) then
- begin
- if Initialized then
- Finalize;
- FManager.UnregisterODEBehaviour(Self);
- end;
- FManager := Value;
- if Assigned(FManager) then
- begin
- if not(csDesigning in TComponent(Owner.Owner).ComponentState) then
- // mrqzzz moved here
- Initialize;
- FManager.RegisterODEBehaviour(Self);
- end;
- end;
- end;
- procedure TGLODEBehaviour.SetSurface(Value: TGLODECollisionSurface);
- begin
- FSurface.Assign(Value);
- end;
- function TGLODEBehaviour.GetAbsoluteMatrix: TGLMatrix;
- begin
- Result := IdentityHMGMatrix;
- if Assigned(Owner.Owner) then
- if Owner.Owner is TGLBaseSceneObject then
- Result := TGLBaseSceneObject(Owner.Owner).AbsoluteMatrix;
- end;
- // ---------------
- // --------------- TGLODEDynamic ---------------
- // ---------------
- constructor TGLODEDynamic.Create(AOwner: TXCollection);
- begin
- inherited;
- FElements := TGLODEElements.Create(Self);
- FJointRegister := TList.Create;
- FEnabled := True;
- end;
- destructor TGLODEDynamic.Destroy;
- begin
- FElements.Free;
- FJointRegister.Free;
- inherited;
- end;
- procedure TGLODEDynamic.Render(var rci: TGLRenderContextInfo);
- var
- Mat: TGLMatrix;
- begin
- if Assigned(Owner.Owner) then
- begin
- rci.PipelineTransformation.Push;
- Mat := TGLBaseSceneObject(Owner.Owner).AbsoluteMatrix;
- rci.PipelineTransformation.ModelMatrix^ := Mat;
- end;
- Elements.Render(rci);
- if Assigned(Owner.Owner) then
- rci.PipelineTransformation.Pop;
- end;
- class function TGLODEDynamic.FriendlyName: String;
- begin
- Result := 'ODE Dynamic';
- end;
- procedure TGLODEDynamic.Initialize;
- var
- i: Integer;
- begin
- if (not Assigned(Manager)) or Assigned(FBody) or (FInitialized) then
- Exit;
- if not Assigned(Manager.World) then
- Exit;
- FBody := dBodyCreate(Manager.World);
- AlignBodyToMatrix(OwnerBaseSceneObject.AbsoluteMatrix);
- dMassSetZero(FMass);
- FElements.Initialize;
- CalculateMass;
- CalibrateCenterOfMass;
- if (FMass.Mass > 0) and (FBody <> nil) then // mrqzzz
- dBodySetMass(FBody, @FMass);
- Enabled := FEnabled;
- for i := 0 to FJointRegister.Count - 1 do
- TGLODEJointBase(FJointRegister[i]).Attach;
- inherited;
- end;
- procedure TGLODEDynamic.Finalize;
- var
- i: Integer;
- begin
- if not FInitialized then
- Exit;
- FElements.Finalize;
- if Assigned(FBody) then
- begin
- dBodyDestroy(FBody);
- FBody := nil;
- end;
- dMassSetZero(FMass);
- for i := 0 to FJointRegister.Count - 1 do
- TGLODEJointBase(FJointRegister[i]).Attach;
- inherited;
- end;
- procedure TGLODEDynamic.WriteToFiler(writer: TWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(1); // Archive version
- FElements.WriteToFiler(writer);
- writer.WriteBoolean(FEnabled);
- end;
- end;
- procedure TGLODEDynamic.ReadFromFiler(reader: TReader);
- var
- archiveVersion: Integer;
- begin
- inherited;
- with reader do
- begin
- archiveVersion := ReadInteger;
- Assert((archiveVersion >= 0) and (archiveVersion <= 1)); // Archive version
- // version 0
- FElements.ReadFromFiler(reader);
- // version 1
- if archiveVersion >= 1 then
- begin
- FEnabled := ReadBoolean;
- end;
- end;
- end;
- procedure TGLODEDynamic.RegisterJoint(Joint: TGLODEJointBase);
- begin
- if FJointRegister.IndexOf(Joint) = -1 then
- FJointRegister.Add(Joint);
- end;
- procedure TGLODEDynamic.UnregisterJoint(Joint: TGLODEJointBase);
- begin
- if FJointRegister.IndexOf(Joint) > -1 then
- FJointRegister.Remove(Joint);
- end;
- function TGLODEDynamic.AddNewElement(AChild: TGLODEElementClass): TGLODEElementBase;
- var
- calcmass: TdMass;
- begin
- Result := AChild.Create(FElements);
- // FElements.Add(Result);
- Result.Initialize;
- calcmass := CalculateMass;
- if (calcmass.Mass > 0) and (FBody <> nil) then // mrqzzz
- dBodySetMass(FBody, @calcmass);
- end;
- procedure TGLODEDynamic.AlignObject;
- var
- Pos: PdVector3;
- R: PdMatrix3;
- m: TGLMatrix;
- begin
- Pos := dBodyGetPosition(Body);
- R := dBodyGetRotation(Body);
- ODERToGLSceneMatrix(m, R^, Pos^);
- if OwnerBaseSceneObject.Parent is TGLBaseSceneObject then
- m := MatrixMultiply(m, OwnerBaseSceneObject.Parent.InvAbsoluteMatrix);
- OwnerBaseSceneObject.SetMatrix(m);
- end;
- procedure TGLODEDynamic.AlignBodyToMatrix(Mat: TGLMatrix);
- var
- R: TdMatrix3;
- begin
- if not Assigned(FBody) then
- Exit;
- R[0] := Mat.X.X;
- R[1] := Mat.Y.X;
- R[2] := Mat.Z.X;
- R[3] := 0;
- R[4] := Mat.X.Y;
- R[5] := Mat.Y.Y;
- R[6] := Mat.Z.Y;
- R[7] := 0;
- R[8] := Mat.X.Z;
- R[9] := Mat.Y.Z;
- R[10] := Mat.Z.Z;
- R[11] := 0;
- dBodySetRotation(FBody, R);
- dBodySetPosition(FBody, Mat.W.X, Mat.W.Y, Mat.W.Z);
- end;
- function TGLODEDynamic.CalculateMass: TdMass;
- var
- i: Integer;
- m: TdMass;
- begin
- dMassSetZero(FMass);
- for i := 0 to Elements.Count - 1 do
- begin
- m := TGLODEElementBase(Elements[i]).CalculateMass;
- dMassAdd(FMass, m);
- end;
- Result := FMass;
- end;
- procedure TGLODEDynamic.CalibrateCenterOfMass;
- var
- Pos: TAffineVector;
- begin
- SetAffineVector(Pos, FMass.c[0], FMass.c[1], FMass.c[2]);
- NegateVector(Pos);
- dMassTranslate(FMass, Pos.X, Pos.Y, Pos.Z);
- end;
- function TGLODEDynamic.GetMass: TdMass;
- begin
- dBodyGetMass(FBody, FMass);
- Result := FMass;
- end;
- procedure TGLODEDynamic.SetMass(const Value: TdMass);
- begin
- FMass := Value;
- if FMass.Mass > 0 then
- dBodySetMass(FBody, @FMass);
- end;
- class function TGLODEDynamic.UniqueItem: Boolean;
- begin
- Result := True;
- end;
- procedure TGLODEDynamic.SetEnabled(const Value: Boolean);
- begin
- FEnabled := Value;
- if Assigned(FBody) then
- begin
- if FEnabled then
- dBodyEnable(FBody)
- else
- dBodyDisable(FBody);
- end;
- end;
- function TGLODEDynamic.GetEnabled: Boolean;
- begin
- if Assigned(FBody) then
- FEnabled := (dBodyIsEnabled(FBody) = 1);
- Result := FEnabled;
- end;
- procedure TGLODEDynamic.AddForce(Force: TAffineVector);
- begin
- if Assigned(FBody) then
- dBodyAddForce(FBody, Force.X, Force.Y, Force.Z);
- end;
- procedure TGLODEDynamic.AddForceAtPos(Force, Pos: TAffineVector);
- begin
- if Assigned(FBody) then
- dBodyAddForceAtPos(FBody, Force.X, Force.Y, Force.Z, Pos.X,
- Pos.Y, Pos.Z);
- end;
- procedure TGLODEDynamic.AddForceAtRelPos(Force, Pos: TAffineVector);
- begin
- if Assigned(FBody) then
- dBodyAddForceAtRelPos(FBody, Force.X, Force.Y, Force.Z, Pos.X,
- Pos.Y, Pos.Z);
- end;
- procedure TGLODEDynamic.AddRelForce(Force: TAffineVector);
- begin
- if Assigned(FBody) then
- dBodyAddRelForce(FBody, Force.X, Force.Y, Force.Z);
- end;
- procedure TGLODEDynamic.AddRelForceAtPos(Force, Pos: TAffineVector);
- begin
- if Assigned(FBody) then
- dBodyAddForceAtPos(FBody, Force.X, Force.Y, Force.Z, Pos.X, Pos.Y, Pos.Z);
- end;
- procedure TGLODEDynamic.AddRelForceAtRelPos(Force, Pos: TAffineVector);
- begin
- if Assigned(FBody) then
- dBodyAddRelForceAtRelPos(FBody, Force.X, Force.Y, Force.Z, Pos.X, Pos.Y, Pos.Z);
- end;
- procedure TGLODEDynamic.AddTorque(Torque: TAffineVector);
- begin
- if Assigned(FBody) then
- dBodyAddTorque(FBody, Torque.X, Torque.Y, Torque.Z);
- end;
- procedure TGLODEDynamic.AddRelTorque(Torque: TAffineVector);
- begin
- if Assigned(FBody) then
- dBodyAddRelTorque(FBody, Torque.X, Torque.Y, Torque.Z);
- end;
- // ---------------
- // --------------- TGLODEStatic ---------------
- // ---------------
- constructor TGLODEStatic.Create(AOwner: TXCollection);
- begin
- inherited;
- FElements := TGLODEElements.Create(Self);
- end;
- destructor TGLODEStatic.Destroy;
- begin
- FElements.Free;
- inherited;
- end;
- procedure TGLODEStatic.Render(var rci: TGLRenderContextInfo);
- var
- Mat: TGLMatrix;
- begin
- if Assigned(Owner.Owner) then
- begin
- rci.PipelineTransformation.Push;
- Mat := TGLBaseSceneObject(Owner.Owner).AbsoluteMatrix;
- rci.PipelineTransformation.ModelMatrix^ := Mat;
- end;
- Elements.Render(rci);
- if Assigned(Owner.Owner) then
- rci.PipelineTransformation.Pop;
- end;
- class function TGLODEStatic.FriendlyName: String;
- begin
- Result := 'ODE Static';
- end;
- class function TGLODEStatic.UniqueItem: Boolean;
- begin
- Result := True;
- end;
- procedure TGLODEStatic.Initialize;
- begin
- if (not Assigned(Manager)) or (FInitialized) then
- Exit;
- if not Assigned(Manager.Space) then
- Exit;
- FElements.Initialize;
- inherited;
- end;
- procedure TGLODEStatic.Finalize;
- begin
- if not FInitialized then
- Exit;
- FElements.Finalize;
- inherited;
- end;
- procedure TGLODEStatic.WriteToFiler(writer: TWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(0); // Archive version
- FElements.WriteToFiler(writer);
- end;
- end;
- procedure TGLODEStatic.ReadFromFiler(reader: TReader);
- begin
- inherited;
- with reader do
- begin
- Assert(ReadInteger = 0); // Archive version
- FElements.ReadFromFiler(reader);
- end;
- end;
- function TGLODEStatic.AddNewElement(AChild: TGLODEElementClass): TGLODEElementBase;
- begin
- Result := nil;
- if not Assigned(Manager) then
- Exit;
- Result := AChild.Create(FElements);
- FElements.Add(Result);
- Result.Initialize;
- end;
- procedure TGLODEStatic.AlignElements;
- var
- i: Integer;
- begin
- if not FInitialized then
- Exit;
- for i := 0 to FElements.Count - 1 do
- TGLODEElementBase(FElements[i]).AlignGeomElementToMatrix(
- TGLODEElementBase(FElements[i]).AbsoluteMatrix);
- end;
- // ---------------
- // --------------- TGLODEElements ---------------
- // ---------------
- destructor TGLODEElements.Destroy;
- begin
- Finalize;
- inherited;
- end;
- function TGLODEElements.GetElement(index: Integer): TGLODEElementBase;
- begin
- Result := TGLODEElementBase(Items[index]);
- end;
- class function TGLODEElements.ItemsClass: TXCollectionItemClass;
- begin
- Result := TGLODEElementBase;
- end;
- procedure TGLODEElements.Initialize;
- var
- i: Integer;
- begin
- for i := 0 to Count - 1 do
- TGLODEElementBase(Items[i]).Initialize;
- end;
- procedure TGLODEElements.Finalize;
- var
- i: Integer;
- begin
- for i := 0 to Count - 1 do
- TGLODEElementBase(Items[i]).Finalize;
- end;
- procedure TGLODEElements.Render(var rci: TGLRenderContextInfo);
- var
- i: Integer;
- begin
- for i := 0 to Count - 1 do
- TGLODEElementBase(Items[i]).Render(rci);
- end;
- procedure TGLODEElements.NotifyChange(Sender: TObject);
- begin
- if Assigned(Owner) then
- if Owner is TGLODEBehaviour then
- TGLODEBehaviour(Owner).NotifyChange(Self);
- end;
- // ---------------
- // --------------- TGLODEElementBase ---------------
- // ---------------
- constructor TGLODEElementBase.Create(AOwner: TXCollection);
- begin
- inherited;
- FPosition := TGLCoordinates.CreateInitialized(Self, NullHmgPoint, csPoint);
- FPosition.OnNotifyChange := NotifyChange;
- FDirection := TGLCoordinates.CreateInitialized(Self, ZHmgVector, csVector);
- FDirection.OnNotifyChange := CoordinateChanged;
- FUp := TGLCoordinates.CreateInitialized(Self, YHmgVector, csVector);
- FUp.OnNotifyChange := CoordinateChanged;
- FDensity := 1;
- FInitialized := False;
- FDynamic := (Owner.Owner is TGLODEDynamic);
- FLocalMatrix := IdentityHMGMatrix;
- FIsCalculating := False;
- end;
- destructor TGLODEElementBase.Destroy;
- begin
- if FInitialized then
- Finalize;
- FPosition.Free;
- FDirection.Free;
- FUp.Free;
- inherited;
- end;
- procedure TGLODEElementBase.Render(var rci: TGLRenderContextInfo);
- begin
- // Override this procedure with element drawing OpenGL code
- end;
- procedure TGLODEElementBase.Initialize;
- var
- Manager: TGLODEManager;
- Body: PdxBody;
- begin
- Manager := nil;
- Body := nil;
- if Owner.Owner is TGLODEBehaviour then
- Manager := TGLODEBehaviour(Owner.Owner).Manager;
- if not Assigned(Manager) then
- Exit;
- if FDynamic then
- begin
- if Owner.Owner is TGLODEDynamic then
- Body := TGLODEDynamic(Owner.Owner).Body;
- if not Assigned(Body) then
- Exit;
- end;
- if not Assigned(Manager.World) then
- Exit;
- if FDynamic then
- begin
- FGeomTransform := dCreateGeomTransform(Manager.Space);
- dGeomSetBody(FGeomTransform, Body);
- dGeomTransformSetCleanup(FGeomTransform, 0);
- dGeomTransformSetGeom(FGeomTransform, FGeomElement);
- dGeomSetData(FGeomTransform, Owner.Owner);
- AlignGeomElementToMatrix(FLocalMatrix);
- end
- else
- begin
- dSpaceAdd(Manager.Space, FGeomElement);
- dGeomSetData(FGeomElement, Owner.Owner);
- AlignGeomElementToMatrix(AbsoluteMatrix);
- end;
- FInitialized := True;
- end;
- procedure TGLODEElementBase.Finalize;
- begin
- if not FInitialized then
- Exit;
- if Assigned(FGeomTransform) then
- begin
- dGeomDestroy(FGeomTransform);
- FGeomTransform := nil;
- end;
- if Assigned(FGeomElement) then
- begin
- dGeomDestroy(FGeomElement);
- FGeomElement := nil;
- end;
- FInitialized := False;
- end;
- procedure TGLODEElementBase.WriteToFiler(writer: TWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(0); // Archive version
- FPosition.WriteToFiler(writer);
- FDirection.WriteToFiler(writer);
- FUp.WriteToFiler(writer);
- WriteFloat(Density);
- end;
- end;
- procedure TGLODEElementBase.ReadFromFiler(reader: TReader);
- begin
- inherited;
- with reader do
- begin
- Assert(ReadInteger = 0); // Archive version
- FPosition.ReadFromFiler(reader);
- FDirection.ReadFromFiler(reader);
- FUp.ReadFromFiler(reader);
- Density := ReadFloat;
- end;
- NotifyChange(Self);
- end;
- function TGLODEElementBase.AbsoluteMatrix: TGLMatrix;
- var
- Mat: TGLMatrix;
- begin
- Mat := IdentityHMGMatrix;
- if Owner.Owner is TGLODEBehaviour then
- Mat := TGLODEBehaviour(Owner.Owner).AbsoluteMatrix;
- Result := MatrixMultiply(Mat, FLocalMatrix);
- end;
- function TGLODEElementBase.AbsolutePosition: TAffineVector;
- begin
- Result := AffineVectorMake(AbsoluteMatrix.W);
- end;
- procedure TGLODEElementBase.AlignGeomElementToMatrix(Mat: TGLMatrix);
- var
- R: TdMatrix3;
- begin
- if not Assigned(FGeomElement) then
- Exit;
- dGeomSetPosition(FGeomElement, Mat.W.X, Mat.W.Y, Mat.W.Z);
- R[0] := Mat.X.X;
- R[1] := Mat.Y.X;
- R[2] := Mat.Z.X;
- R[3] := 0;
- R[4] := Mat.X.Y;
- R[5] := Mat.Y.Y;
- R[6] := Mat.Z.Y;
- R[7] := 0;
- R[8] := Mat.X.Z;
- R[9] := Mat.Y.Z;
- R[10] := Mat.Z.Z;
- R[11] := 0;
- dGeomSetRotation(FGeomElement, R);
- FRealignODE := False;
- end;
- procedure TGLODEElementBase.SetGeomElement(aGeom: PdxGeom);
- begin
- FGeomElement := aGeom;
- end;
- function TGLODEElementBase.IsODEInitialized: Boolean;
- var
- Manager: TGLODEManager;
- begin
- Result := False;
- Manager := nil;
- if Owner.Owner is TGLODEBehaviour then
- Manager := TGLODEBehaviour(Owner.Owner).Manager;
- if not Assigned(Manager) then
- Exit;
- Result := Assigned(Manager.Space);
- end;
- function TGLODEElementBase.CalculateMass: TdMass;
- var
- R: TdMatrix3;
- begin
- R[0] := FLocalMatrix.X.X;
- R[1] := FLocalMatrix.Y.X;
- R[2] := FLocalMatrix.Z.X;
- R[3] := 0;
- R[4] := FLocalMatrix.X.Y;
- R[5] := FLocalMatrix.Y.Y;
- R[6] := FLocalMatrix.Z.Y;
- R[7] := 0;
- R[8] := FLocalMatrix.X.Z;
- R[9] := FLocalMatrix.Y.Z;
- R[10] := FLocalMatrix.Z.Z;
- R[11] := 0;
- dMassRotate(FMass, R);
- dMassTranslate(FMass, FLocalMatrix.W.X, FLocalMatrix.W.Y, FLocalMatrix.W.Z);
- Result := FMass;
- end;
- procedure TGLODEElementBase.CoordinateChanged(Sender: TObject);
- var
- rightVector: TGLVector;
- begin
- if FIsCalculating then
- Exit;
- FIsCalculating := True;
- try
- if Sender = FDirection then
- begin
- if FDirection.VectorLength = 0 then
- FDirection.DirectVector := ZHmgVector;
- FDirection.Normalize;
- rightVector := VectorCrossProduct(FDirection.AsVector, FUp.AsVector);
- if VectorLength(rightVector) < 1E-5 then
- begin
- rightVector := VectorCrossProduct(ZHmgVector, FUp.AsVector);
- if VectorLength(rightVector) < 1E-5 then
- rightVector := VectorCrossProduct(XHmgVector, FUp.AsVector);
- end;
- FUp.DirectVector := VectorCrossProduct(rightVector, FDirection.AsVector);
- FUp.Normalize;
- end
- else if Sender = FUp then
- begin
- if FUp.VectorLength = 0 then
- FUp.DirectVector := YHmgVector;
- FUp.Normalize;
- rightVector := VectorCrossProduct(FDirection.AsVector, FUp.AsVector);
- if VectorLength(rightVector) < 1E-5 then
- begin
- rightVector := VectorCrossProduct(ZHmgVector, FUp.AsVector);
- if VectorLength(rightVector) < 1E-5 then
- rightVector := VectorCrossProduct(XHmgVector, FUp.AsVector);
- end;
- FDirection.DirectVector := VectorCrossProduct(FUp.AsVector, rightVector);
- FDirection.Normalize;
- end;
- NotifyChange(Self);
- finally
- FIsCalculating := False;
- end;
- end;
- procedure TGLODEElementBase.NotifyChange(Sender: TObject);
- begin
- RebuildMatrix;
- ODERebuild;
- end;
- function TGLODEElementBase.GetMatrix: TGLMatrix;
- begin
- Result := FLocalMatrix;
- end;
- procedure TGLODEElementBase.RebuildMatrix;
- begin
- VectorCrossProduct(FUp.AsVector, FDirection.AsVector, FLocalMatrix.X);
- SetVector(FLocalMatrix.Y, FUp.AsVector);
- SetVector(FLocalMatrix.Z, FDirection.AsVector);
- SetVector(FLocalMatrix.W, FPosition.AsVector);
- end;
- procedure TGLODEElementBase.RebuildVectors;
- begin
- FUp.SetVector(FLocalMatrix.Y.X, FLocalMatrix.Y.Y, FLocalMatrix.Y.Z);
- FDirection.SetVector(FLocalMatrix.Z.X, FLocalMatrix.Z.Y, FLocalMatrix.Z.Z);
- FPosition.SetPoint(FLocalMatrix.W.X, FLocalMatrix.W.Y, FLocalMatrix.W.Z);
- end;
- procedure TGLODEElementBase.SetDensity(const Value: TdReal);
- begin
- FDensity := Value;
- end;
- procedure TGLODEElementBase.SetMatrix(const Value: TGLMatrix);
- begin
- FLocalMatrix := Value;
- RebuildVectors;
- ODERebuild;
- end;
- procedure TGLODEElementBase.ODERebuild;
- begin
- if Initialized then
- begin
- if FDynamic then
- begin
- CalculateMass;
- AlignGeomElementToMatrix(FLocalMatrix);
- end
- else
- AlignGeomElementToMatrix(AbsoluteMatrix);
- end;
- if Assigned(Owner) then
- TGLODEElements(Owner).NotifyChange(Self);
- end;
- procedure TGLODEElementBase.SetPosition(const Value: TGLCoordinates);
- begin
- FPosition.Assign(Value);
- end;
- procedure TGLODEElementBase.SetDirection(const Value: TGLCoordinates);
- begin
- FDirection.Assign(Value);
- end;
- procedure TGLODEElementBase.SetUp(const Value: TGLCoordinates);
- begin
- FUp.Assign(Value);
- end;
- // ---------------
- // --------------- TGLODEElementBox ---------------
- // ---------------
- procedure TGLODEElementBox.Render(var rci: TGLRenderContextInfo);
- begin
- gl.PushMatrix;
- gl.MultMatrixf(@FLocalMatrix);
- gl.Begin_(GL_LINE_LOOP);
- gl.Vertex3f(-FBoxWidth / 2, -FBoxHeight / 2, -FBoxDepth / 2);
- gl.Vertex3f(-FBoxWidth / 2, FBoxHeight / 2, -FBoxDepth / 2);
- gl.Vertex3f(-FBoxWidth / 2, FBoxHeight / 2, FBoxDepth / 2);
- gl.Vertex3f(-FBoxWidth / 2, -FBoxHeight / 2, FBoxDepth / 2);
- gl.End_;
- gl.Begin_(GL_LINE_LOOP);
- gl.Vertex3f(FBoxWidth / 2, FBoxHeight / 2, FBoxDepth / 2);
- gl.Vertex3f(FBoxWidth / 2, -FBoxHeight / 2, FBoxDepth / 2);
- gl.Vertex3f(FBoxWidth / 2, -FBoxHeight / 2, -FBoxDepth / 2);
- gl.Vertex3f(FBoxWidth / 2, FBoxHeight / 2, -FBoxDepth / 2);
- gl.End_;
- gl.Begin_(GL_LINES);
- gl.Vertex3f(-FBoxWidth / 2, FBoxHeight / 2, -FBoxDepth / 2);
- gl.Vertex3f(FBoxWidth / 2, FBoxHeight / 2, -FBoxDepth / 2);
- gl.Vertex3f(-FBoxWidth / 2, -FBoxHeight / 2, FBoxDepth / 2);
- gl.Vertex3f(FBoxWidth / 2, -FBoxHeight / 2, FBoxDepth / 2);
- gl.Vertex3f(-FBoxWidth / 2, -FBoxHeight / 2, -FBoxDepth / 2);
- gl.Vertex3f(FBoxWidth / 2, -FBoxHeight / 2, -FBoxDepth / 2);
- gl.Vertex3f(-FBoxWidth / 2, FBoxHeight / 2, FBoxDepth / 2);
- gl.Vertex3f(FBoxWidth / 2, FBoxHeight / 2, FBoxDepth / 2);
- gl.End_;
- gl.PopMatrix;
- end;
- constructor TGLODEElementBox.Create(AOwner: TXCollection);
- begin
- inherited;
- BoxWidth := 1;
- BoxHeight := 1;
- BoxDepth := 1;
- end;
- procedure TGLODEElementBox.Initialize;
- begin
- if FInitialized then
- Exit;
- if not IsODEInitialized then
- Exit;
- FGeomElement := dCreateBox(nil, FBoxWidth, FBoxHeight, FBoxDepth);
- inherited;
- end;
- procedure TGLODEElementBox.WriteToFiler(writer: TWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(0); // Archive version
- WriteFloat(BoxWidth);
- WriteFloat(BoxHeight);
- WriteFloat(BoxDepth);
- end;
- end;
- procedure TGLODEElementBox.ReadFromFiler(reader: TReader);
- begin
- inherited;
- with reader do
- begin
- Assert(ReadInteger = 0); // Archive version
- BoxWidth := ReadFloat;
- BoxHeight := ReadFloat;
- BoxDepth := ReadFloat;
- end;
- end;
- class function TGLODEElementBox.FriendlyName: String;
- begin
- Result := 'Box';
- end;
- class function TGLODEElementBox.FriendlyDescription: String;
- begin
- Result := 'The ODE box element implementation';
- end;
- class function TGLODEElementBox.ItemCategory: String;
- begin
- Result := 'Primitives';
- end;
- function TGLODEElementBox.CalculateMass: TdMass;
- begin
- dMassSetBox(FMass, FDensity, BoxWidth, BoxHeight, BoxDepth);
- Result := inherited CalculateMass;
- end;
- function TGLODEElementBox.GetBoxWidth: TdReal;
- var
- vec: TdVector3;
- begin
- if Assigned(FGeomTransform) then
- begin
- dGeomBoxGetLengths(Geom, vec);
- FBoxWidth := vec[0];
- end;
- Result := FBoxWidth;
- end;
- function TGLODEElementBox.GetBoxHeight: TdReal;
- var
- vec: TdVector3;
- begin
- if Assigned(FGeomTransform) then
- begin
- dGeomBoxGetLengths(Geom, vec);
- FBoxHeight := vec[1];
- end;
- Result := FBoxHeight;
- end;
- function TGLODEElementBox.GetBoxDepth: TdReal;
- var
- vec: TdVector3;
- begin
- if Assigned(FGeomTransform) then
- begin
- dGeomBoxGetLengths(Geom, vec);
- FBoxDepth := vec[2];
- end;
- Result := FBoxDepth;
- end;
- procedure TGLODEElementBox.ODERebuild;
- begin
- if Assigned(Geom) then
- dGeomBoxSetLengths(Geom, FBoxWidth, FBoxHeight, FBoxDepth);
- inherited;
- end;
- procedure TGLODEElementBox.SetBoxWidth(const Value: TdReal);
- begin
- FBoxWidth := Value;
- ODERebuild;
- end;
- procedure TGLODEElementBox.SetBoxHeight(const Value: TdReal);
- begin
- FBoxHeight := Value;
- ODERebuild;
- end;
- procedure TGLODEElementBox.SetBoxDepth(const Value: TdReal);
- begin
- FBoxDepth := Value;
- ODERebuild;
- end;
- // ---------------
- // --------------- TGLODEElementSphere ---------------
- // ---------------
- procedure TGLODEElementSphere.Render(var rci: TGLRenderContextInfo);
- var
- AngTop, AngBottom, AngStart, AngStop, StepV, StepH: double;
- SinP, CosP, SinP2, CosP2, SinT, CosT, Phi, Phi2, Theta: double;
- FTop, FBottom, FStart, FStop: Single;
- i, J, FSlices, FStacks: Integer;
- begin
- gl.PushMatrix;
- gl.MultMatrixf(@FLocalMatrix);
- gl.Scalef(Radius, Radius, Radius);
- FTop := 90;
- FBottom := -90;
- FStart := 0;
- FStop := 360;
- FSlices := 16;
- FStacks := 16;
- AngTop := DegToRad(FTop);
- AngBottom := DegToRad(FBottom);
- AngStart := DegToRad(FStart);
- AngStop := DegToRad(FStop);
- StepH := (AngStop - AngStart) / FSlices;
- StepV := (AngTop - AngBottom) / FStacks;
- Phi := AngTop;
- Phi2 := Phi - StepV;
- for J := 0 to FStacks - 1 do
- begin
- Theta := AngStart;
- SinCos(Phi, SinP, CosP);
- SinCos(Phi2, SinP2, CosP2);
- gl.Begin_(GL_LINE_LOOP);
- for i := 0 to FSlices do
- begin
- SinCos(Theta, SinT, CosT);
- gl.Vertex3f(CosP * SinT, SinP, CosP * CosT);
- Theta := Theta + StepH;
- end;
- gl.End_;
- Phi := Phi2;
- Phi2 := Phi2 - StepV;
- end;
- Phi := AngTop;
- Phi2 := Phi - StepV;
- for J := 0 to FStacks - 1 do
- begin
- Theta := AngStart;
- SinCos(Phi, SinP, CosP);
- SinCos(Phi2, SinP2, CosP2);
- gl.Begin_(GL_LINE_LOOP);
- for i := 0 to FSlices do
- begin
- SinCos(Theta, SinT, CosT);
- gl.Vertex3f(SinP, CosP * SinT, CosP * CosT);
- Theta := Theta + StepH;
- end;
- gl.End_;
- Phi := Phi2;
- Phi2 := Phi2 - StepV;
- end;
- gl.PopMatrix;
- end;
- constructor TGLODEElementSphere.Create(AOwner: TXCollection);
- begin
- inherited;
- FRadius := 0.5;
- end;
- procedure TGLODEElementSphere.Initialize;
- begin
- if FInitialized then
- Exit;
- if not IsODEInitialized then
- Exit;
- FGeomElement := dCreateSphere(nil, FRadius);
- inherited;
- end;
- procedure TGLODEElementSphere.WriteToFiler(writer: TWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(0); // Archive version
- WriteFloat(Radius);
- end;
- end;
- procedure TGLODEElementSphere.ReadFromFiler(reader: TReader);
- begin
- inherited;
- with reader do
- begin
- Assert(ReadInteger = 0); // Archive version
- Radius := ReadFloat;
- end;
- end;
- class function TGLODEElementSphere.FriendlyName: String;
- begin
- Result := 'Sphere';
- end;
- class function TGLODEElementSphere.FriendlyDescription: String;
- begin
- Result := 'The ODE sphere element implementation';
- end;
- class function TGLODEElementSphere.ItemCategory: String;
- begin
- Result := 'Primitives';
- end;
- function TGLODEElementSphere.CalculateMass: TdMass;
- begin
- dMassSetSphere(FMass, FDensity, Radius);
- Result := inherited CalculateMass;
- end;
- function TGLODEElementSphere.GetRadius: TdReal;
- begin
- if Assigned(FGeomElement) then
- FRadius := dGeomSphereGetRadius(FGeomElement);
- Result := FRadius;
- end;
- procedure TGLODEElementSphere.ODERebuild;
- begin
- if Assigned(Geom) then
- begin
- dGeomSphereSetRadius(Geom, FRadius);
- end;
- inherited;
- end;
- procedure TGLODEElementSphere.SetRadius(const Value: TdReal);
- begin
- FRadius := Value;
- ODERebuild;
- end;
- // ---------------
- // --------------- TGLODEElementCapsule ---------------
- // ---------------
- procedure TGLODEElementCapsule.Render(var rci: TGLRenderContextInfo);
- var
- i, J, Stacks, Slices: Integer;
- begin
- gl.PushMatrix;
- gl.MultMatrixf(@FLocalMatrix);
- Stacks := 8;
- Slices := 16;
- // Middle horizontal circles
- for J := 0 to Stacks - 1 do
- begin
- gl.Begin_(GL_LINE_LOOP);
- for i := 0 to Slices - 1 do
- gl.Vertex3f(FRadius * sin(2 * i * PI / Slices),
- FRadius * cos(2 * i * PI / Slices),
- -FLength / 2 + FLength * J /(Stacks - 1));
- gl.End_;
- end;
- // Middle vertical lines
- gl.Begin_(GL_LINES);
- for i := 0 to (Slices div 2) - 1 do
- begin
- gl.Vertex3f(FRadius * sin(2 * i * PI / Slices),
- FRadius * cos(2 * i * PI / Slices), -FLength / 2);
- gl.Vertex3f(FRadius * sin(2 * i * PI / Slices),
- FRadius * cos(2 * i * PI / Slices), FLength / 2);
- gl.Vertex3f(-FRadius * sin(2 * i * PI / Slices),
- -FRadius * cos(2 * i * PI / Slices), -FLength / 2);
- gl.Vertex3f(-FRadius * sin(2 * i * PI / Slices),
- -FRadius * cos(2 * i * PI / Slices), FLength / 2);
- end;
- gl.End_;
- // Cap XZ half-circles
- gl.PushMatrix;
- for J := 0 to (Slices div 2) - 1 do
- begin
- // Top
- gl.Begin_(GL_LINE_STRIP);
- for i := 0 to Slices do
- gl.Vertex3f(FRadius * cos(i * PI / Slices), 0,
- FRadius * sin(i * PI / Slices) + FLength / 2);
- gl.End_;
- // Bottom
- gl.Begin_(GL_LINE_STRIP);
- for i := 0 to Slices do
- gl.Vertex3f(FRadius * cos(i * PI / Slices), 0,
- -(FRadius * sin(i * PI / Slices) + FLength / 2));
- gl.End_;
- gl.Rotatef(360 / Slices, 0, 0, 1);
- end;
- gl.PopMatrix;
- gl.PopMatrix;
- end;
- constructor TGLODEElementCapsule.Create(AOwner: TXCollection);
- begin
- inherited;
- FRadius := 0.5;
- FLength := 1;
- end;
- procedure TGLODEElementCapsule.Initialize;
- begin
- if FInitialized then
- Exit;
- if not IsODEInitialized then
- Exit;
- FGeomElement := dCreateCapsule(nil, FRadius, FLength);
- inherited;
- end;
- procedure TGLODEElementCapsule.WriteToFiler(writer: TWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(0); // Archive version
- WriteFloat(Radius);
- WriteFloat(Length);
- end;
- end;
- procedure TGLODEElementCapsule.ReadFromFiler(reader: TReader);
- begin
- inherited;
- with reader do
- begin
- Assert(ReadInteger = 0); // Archive version
- Radius := ReadFloat;
- Length := ReadFloat;
- end;
- end;
- class function TGLODEElementCapsule.FriendlyName: String;
- begin
- Result := 'Capsule';
- end;
- class function TGLODEElementCapsule.FriendlyDescription: String;
- begin
- Result := 'The ODE capped cylinder element implementation';
- end;
- class function TGLODEElementCapsule.ItemCategory: String;
- begin
- Result := 'Primitives';
- end;
- function TGLODEElementCapsule.CalculateMass: TdMass;
- begin
- dMassSetCapsule(FMass, FDensity, 3, FRadius, FLength);
- Result := inherited CalculateMass;
- end;
- function TGLODEElementCapsule.GetRadius: TdReal;
- var
- rad, len: TdReal;
- begin
- if Assigned(FGeomElement) then
- begin
- dGeomCapsuleGetParams(Geom, rad, len);
- FRadius := rad;
- end;
- Result := FRadius;
- end;
- function TGLODEElementCapsule.GetLength: TdReal;
- var
- rad, len: TdReal;
- begin
- if Assigned(FGeomElement) then
- begin
- dGeomCapsuleGetParams(Geom, rad, len);
- FLength := len;
- end;
- Result := FLength;
- end;
- procedure TGLODEElementCapsule.ODERebuild;
- begin
- if Assigned(Geom) then
- dGeomCapsuleSetParams(Geom, FRadius, FLength);
- inherited;
- end;
- procedure TGLODEElementCapsule.SetRadius(const Value: TdReal);
- begin
- FRadius := Value;
- ODERebuild;
- end;
- procedure TGLODEElementCapsule.SetLength(const Value: TdReal);
- begin
- FLength := Value;
- ODERebuild;
- end;
- // ---------------
- // --------------- TGLODEElementCylinder ---------------
- // ---------------
- procedure TGLODEElementCylinder.Render(var rci: TGLRenderContextInfo);
- var
- i, J, Stacks, Slices: Integer;
- begin
- gl.PushMatrix;
- gl.MultMatrixf(@FLocalMatrix);
- Stacks := 8;
- Slices := 16;
- // Middle horizontal circles
- for J := 0 to Stacks - 1 do
- begin
- gl.Begin_(GL_LINE_LOOP);
- for i := 0 to Slices - 1 do
- gl.Vertex3f(FRadius * sin(2 * i * PI / Slices), -FLength / 2 + FLength * J/
- (Stacks - 1), FRadius * cos(2 * i * PI / Slices));
- gl.End_;
- end;
- // Middle vertical lines
- gl.Begin_(GL_LINES);
- for i := 0 to (Slices div 2) - 1 do
- begin
- gl.Vertex3f(FRadius * sin(2 * i * PI / Slices), -FLength / 2,
- FRadius * cos(2 * i * PI / Slices));
- gl.Vertex3f(FRadius * sin(2 * i * PI / Slices), FLength / 2,
- FRadius * cos(2 * i * PI / Slices));
- gl.Vertex3f(-FRadius * sin(2 * i * PI / Slices), -FLength / 2,
- -FRadius * cos(2 * i * PI / Slices));
- gl.Vertex3f(-FRadius * sin(2 * i * PI / Slices), FLength / 2,
- -FRadius * cos(2 * i * PI / Slices));
- end;
- gl.End_;
- // Caps
- gl.PushMatrix;
- for J := 0 to (Slices div 2) - 1 do
- begin
- gl.Begin_(GL_LINES);
- gl.Vertex3f(-FRadius, FLength / 2, 0);
- gl.Vertex3f(FRadius, FLength / 2, 0);
- gl.Vertex3f(-FRadius, -FLength / 2, 0);
- gl.Vertex3f(FRadius, -FLength / 2, 0);
- gl.End_;
- gl.Rotatef(360 / Slices, 0, 1, 0);
- end;
- gl.PopMatrix;
- gl.PopMatrix;
- end;
- constructor TGLODEElementCylinder.Create(AOwner: TXCollection);
- begin
- inherited;
- FRadius := 0.5;
- FLength := 1;
- end;
- procedure TGLODEElementCylinder.Initialize;
- begin
- if FInitialized then
- Exit;
- if not IsODEInitialized then
- Exit;
- FGeomElement := dCreateCylinder(nil, FRadius, FLength);
- inherited;
- end;
- procedure TGLODEElementCylinder.WriteToFiler(writer: TWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(0); // Archive version
- WriteFloat(Radius);
- WriteFloat(Length);
- end;
- end;
- procedure TGLODEElementCylinder.ReadFromFiler(reader: TReader);
- begin
- inherited;
- with reader do
- begin
- Assert(ReadInteger = 0); // Archive version
- Radius := ReadFloat;
- Length := ReadFloat;
- end;
- end;
- class function TGLODEElementCylinder.FriendlyName: String;
- begin
- Result := 'Cylinder';
- end;
- class function TGLODEElementCylinder.FriendlyDescription: String;
- begin
- Result := 'The ODE cylinder element implementation';
- end;
- class function TGLODEElementCylinder.ItemCategory: String;
- begin
- Result := 'Primitives';
- end;
- function TGLODEElementCylinder.CalculateMass: TdMass;
- begin
- dMassSetCylinder(FMass, FDensity, 3, FRadius, FLength);
- Result := inherited CalculateMass;
- end;
- function TGLODEElementCylinder.GetRadius: TdReal;
- var
- rad, len: TdReal;
- begin
- if Assigned(FGeomElement) then
- begin
- dGeomCylinderGetParams(Geom, rad, len);
- FRadius := rad;
- end;
- Result := FRadius;
- end;
- function TGLODEElementCylinder.GetLength: TdReal;
- var
- rad, len: TdReal;
- begin
- if Assigned(FGeomElement) then
- begin
- dGeomCylinderGetParams(Geom, rad, len);
- FLength := len;
- end;
- Result := FLength;
- end;
- procedure TGLODEElementCylinder.ODERebuild;
- begin
- if Assigned(Geom) then
- dGeomCylinderSetParams(Geom, FRadius, FLength);
- inherited;
- end;
- procedure TGLODEElementCylinder.SetRadius(const Value: TdReal);
- begin
- FRadius := Value;
- ODERebuild;
- end;
- procedure TGLODEElementCylinder.SetLength(const Value: TdReal);
- begin
- FLength := Value;
- ODERebuild;
- end;
- // ---------------
- // --------------- TGLODEElementTriMesh ---------------
- // ---------------
- constructor TGLODEElementTriMesh.Create(AOwner: TXCollection);
- begin
- inherited;
- FVertices := TGLAffineVectorList.Create;
- FIndices := TGLIntegerList.Create;
- end;
- destructor TGLODEElementTriMesh.Destroy;
- begin
- FVertices.Free;
- FIndices.Free;
- inherited;
- end;
- procedure TGLODEElementTriMesh.Initialize;
- begin
- if not IsODEInitialized then
- Exit;
- if FInitialized or not((FVertices.Count > 0) and (FIndices.Count > 0)) then
- Exit;
- FTriMeshData := dGeomTriMeshDataCreate;
- dGeomTriMeshDataBuildSingle(FTriMeshData, @FVertices.List[0],
- 3 * SizeOf(Single), FVertices.Count, @FIndices.List[0], FIndices.Count,
- 3 * SizeOf(Integer));
- FGeomElement := dCreateTriMesh(nil, FTriMeshData, nil, nil, nil);
- inherited;
- end;
- procedure TGLODEElementTriMesh.Finalize;
- begin
- if not FInitialized then
- Exit;
- if Assigned(FTriMeshData) then
- dGeomTriMeshDataDestroy(FTriMeshData);
- inherited;
- end;
- procedure TGLODEElementTriMesh.WriteToFiler(writer: TWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(0); // Archive version
- end;
- end;
- procedure TGLODEElementTriMesh.ReadFromFiler(reader: TReader);
- begin
- inherited;
- with reader do
- begin
- Assert(ReadInteger = 0); // Archive version
- end;
- end;
- class function TGLODEElementTriMesh.FriendlyName: String;
- begin
- Result := 'Tri-Mesh';
- end;
- class function TGLODEElementTriMesh.FriendlyDescription: String;
- begin
- Result := 'The ODE tri-mesh element implementation';
- end;
- class function TGLODEElementTriMesh.ItemCategory: String;
- begin
- Result := 'Meshes';
- end;
- function TGLODEElementTriMesh.CalculateMass: TdMass;
- var
- R: Single;
- min, max: TAffineVector;
- begin
- if Vertices.Count > 0 then
- begin
- Vertices.GetExtents(min, max);
- R := MaxFloat(VectorLength(min), VectorLength(max));
- end
- else
- R := 1;
- dMassSetSphere(FMass, FDensity, R);
- Result := inherited CalculateMass;
- end;
- procedure TGLODEElementTriMesh.SetVertices(const Value: TGLAffineVectorList);
- begin
- FVertices.Assign(Value);
- RefreshTriMeshData;
- end;
- procedure TGLODEElementTriMesh.SetIndices(const Value: TGLIntegerList);
- begin
- FIndices.Assign(Value);
- RefreshTriMeshData;
- end;
- procedure TGLODEElementTriMesh.RefreshTriMeshData;
- begin
- if FInitialized then
- Finalize;
- Initialize;
- end;
- // ---------------
- // --------------- TGLODEElementPlane ---------------
- // ---------------
- procedure TGLODEElementPlane.Initialize;
- begin
- if FInitialized then
- Exit;
- if not IsODEInitialized then
- Exit;
- FGeomElement := dCreatePlane(nil, 0, 0, 1, 0);
- inherited;
- end;
- procedure TGLODEElementPlane.WriteToFiler(writer: TWriter);
- begin
- // ArchiveVersion 1, added inherited call
- writer.WriteInteger(1);
- inherited;
- end;
- procedure TGLODEElementPlane.ReadFromFiler(reader: TReader);
- var
- archiveVersion: Integer;
- begin
- archiveVersion := reader.ReadInteger;
- Assert(archiveVersion in [0 .. 1]);
- if archiveVersion >= 1 then
- inherited;
- end;
- class function TGLODEElementPlane.FriendlyName: String;
- begin
- Result := 'Plane';
- end;
- class function TGLODEElementPlane.FriendlyDescription: String;
- begin
- Result := 'The ODE plane element implementation';
- end;
- class function TGLODEElementPlane.ItemCategory: String;
- begin
- Result := 'Primitives';
- end;
- class function TGLODEElementPlane.CanAddTo(collection: TXCollection): Boolean;
- begin
- Result := False;
- if Assigned(TGLODEElements(collection).Owner) then
- if TGLODEElements(collection).Owner is TGLODEStatic then
- Result := True;
- end;
- procedure TGLODEElementPlane.AlignGeomElementToMatrix(Mat: TGLMatrix);
- var
- d: Single;
- begin
- if not Assigned(FGeomElement) then
- Exit;
- d := VectorDotProduct(Mat.Z, Mat.W);
- dGeomPlaneSetParams(FGeomElement, Mat.Z.X, Mat.Z.Y,
- Mat.Z.Z, d);
- end;
- // ---------------
- // --------------- TGLODEJoints ---------------
- // ---------------
- class function TGLODEJoints.ItemsClass: TXCollectionItemClass;
- begin
- Result := TGLODEJointBase;
- end;
- procedure TGLODEJoints.Initialize;
- var
- i: Integer;
- begin
- for i := 0 to Count - 1 do
- Joint[i].Initialize;
- end;
- procedure TGLODEJoints.Finalize;
- var
- i: Integer;
- begin
- for i := 0 to Count - 1 do
- Joint[i].Finalize;
- end;
- function TGLODEJoints.GetJoint(index: Integer): TGLODEJointBase;
- begin
- Result := TGLODEJointBase(Items[index]);
- end;
- // ---------------
- // --------------- TGLODEJointList ---------------
- // ---------------
- constructor TGLODEJointList.Create(AOwner: TComponent);
- begin
- inherited;
- FJoints := TGLODEJoints.Create(Self);
- end;
- destructor TGLODEJointList.Destroy;
- begin
- FJoints.Free;
- inherited;
- end;
- procedure TGLODEJointList.DefineProperties(Filer: TFiler);
- begin
- inherited;
- Filer.DefineBinaryProperty('ODEJointsData', ReadJoints, WriteJoints,
- (Assigned(FJoints) and (FJoints.Count > 0)));
- end;
- procedure TGLODEJointList.WriteJoints(stream: TStream);
- var
- writer: TWriter;
- begin
- writer := TWriter.Create(stream, 16384);
- try
- Joints.WriteToFiler(writer);
- finally
- writer.Free;
- end;
- end;
- procedure TGLODEJointList.ReadJoints(stream: TStream);
- var
- reader: TReader;
- begin
- reader := TReader.Create(stream, 16384);
- try
- Joints.ReadFromFiler(reader);
- finally
- reader.Free;
- end;
- end;
- procedure TGLODEJointList.Loaded;
- var
- i: Integer;
- begin
- inherited;
- for i := 0 to FJoints.Count - 1 do
- FJoints[i].Loaded;
- end;
- procedure TGLODEJointList.Notification(AComponent: TComponent; Operation: TOperation);
- var
- i: Integer;
- begin
- inherited;
- if (Operation = opRemove) and (AComponent is TGLBaseSceneObject) then
- for i := 0 to Joints.Count - 1 do
- begin
- if TGLBaseSceneObject(AComponent) = Joints[i].Object1 then
- Joints[i].Object1 := nil;
- if TGLBaseSceneObject(AComponent) = Joints[i].Object2 then
- Joints[i].Object2 := nil;
- end;
- end;
- // ---------------
- // --------------- TGLODEJointBase ---------------
- // ---------------
- constructor TGLODEJointBase.Create(AOwner: TXCollection);
- begin
- inherited;
- FJointID := nil;
- FEnabled := True;
- FInitialized := False;
- end;
- destructor TGLODEJointBase.Destroy;
- begin
- Finalize;
- inherited;
- end;
- procedure TGLODEJointBase.Initialize;
- begin
- if not IsODEInitialized then
- Exit;
- if Assigned(FObject1) then
- RegisterJointWithObject(FObject1);
- if Assigned(FObject2) then
- RegisterJointWithObject(FObject2);
- Attach;
- FInitialized := True;
- end;
- procedure TGLODEJointBase.Finalize;
- begin
- if not Initialized then
- Exit;
- if Assigned(FObject1) then
- UnregisterJointWithObject(FObject1);
- if Assigned(FObject2) then
- UnregisterJointWithObject(FObject2);
- if FJointID <> nil then
- dJointDestroy(FJointID);
- FInitialized := False;
- end;
- procedure TGLODEJointBase.WriteToFiler(writer: TWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(0); // Archive version
- if Assigned(FManager) then
- WriteString(FManager.GetNamePath)
- else
- WriteString('');
- if Assigned(FObject1) then
- WriteString(FObject1.GetNamePath)
- else
- WriteString('');
- if Assigned(FObject2) then
- WriteString(FObject2.GetNamePath)
- else
- WriteString('');
- WriteBoolean(FEnabled);
- end;
- end;
- procedure TGLODEJointBase.ReadFromFiler(reader: TReader);
- begin
- inherited;
- with reader do
- begin
- Assert(ReadInteger = 0); // Archive version
- FManagerName := ReadString;
- FObject1Name := ReadString;
- FObject2Name := ReadString;
- FEnabled := ReadBoolean;
- end;
- end;
- procedure TGLODEJointBase.Loaded;
- begin
- DoLoaded;
- end;
- procedure TGLODEJointBase.RegisterJointWithObject(Obj: TGLBaseSceneObject);
- var
- temp: TGLODEDynamic;
- begin
- if Assigned(Obj) then
- begin
- temp := TGLODEDynamic(Obj.Behaviours.GetByClass(TGLODEDynamic));
- if Assigned(temp) then
- temp.RegisterJoint(Self);
- end;
- end;
- procedure TGLODEJointBase.UnregisterJointWithObject(Obj: TGLBaseSceneObject);
- var
- temp: TGLODEDynamic;
- begin
- if Assigned(Obj) then
- begin
- temp := TGLODEDynamic(Obj.Behaviours.GetByClass(TGLODEDynamic));
- if Assigned(temp) then
- temp.UnregisterJoint(Self);
- end;
- end;
- function TGLODEJointBase.IsODEInitialized: Boolean;
- begin
- Result := False;
- if not Assigned(Manager) then
- Exit;
- Result := Assigned(Manager.World);
- end;
- procedure TGLODEJointBase.Attach;
- var
- Body1, Body2: PdxBody;
- begin
- if (FJointID = nil) or not FInitialized then
- Exit;
- if Enabled then
- begin
- Body1 := GetBodyFromGLSceneObject(FObject1);
- Body2 := GetBodyFromGLSceneObject(FObject2);
- end
- else
- begin
- Body1 := nil;
- Body2 := nil;
- end;
- if (joBothObjectsMustBeAssigned in JointOptions) then
- if not(Assigned(Body1) and Assigned(Body2)) then
- Exit;
- dJointAttach(FJointID, Body1, Body2);
- if Assigned(Body1) or Assigned(Body2) then
- StructureChanged;
- end;
- procedure TGLODEJointBase.SetManager(const Value: TGLODEManager);
- begin
- if FManager <> Value then
- begin
- if Assigned(FManager) then
- if not(csDesigning in FManager.ComponentState) then
- Finalize;
- FManager := Value;
- if Assigned(FManager) then
- if not(csDesigning in FManager.ComponentState) then
- Initialize;
- end;
- end;
- procedure TGLODEJointBase.SetObject1(const Value: TGLBaseSceneObject);
- begin
- if FObject1 <> Value then
- begin
- if Assigned(FObject1) then
- UnregisterJointWithObject(FObject1);
- FObject1 := Value;
- if Assigned(FObject1) then
- if IsGLODEObject(FObject1) then
- RegisterJointWithObject(FObject1)
- else
- FObject1 := nil;
- Attach;
- end;
- end;
- procedure TGLODEJointBase.SetObject2(const Value: TGLBaseSceneObject);
- begin
- if FObject2 <> Value then
- begin
- if Assigned(FObject2) then
- UnregisterJointWithObject(FObject2);
- FObject2 := Value;
- if Assigned(FObject2) then
- if IsGLODEObject(FObject2) then
- RegisterJointWithObject(FObject2)
- else
- FObject2 := nil;
- Attach;
- end;
- end;
- procedure TGLODEJointBase.SetEnabled(const Value: Boolean);
- begin
- if FEnabled <> Value then
- begin
- FEnabled := Value;
- if IsODEInitialized then
- Attach;
- end;
- end;
- procedure TGLODEJointBase.StructureChanged;
- begin
- // nothing yet
- end;
- procedure TGLODEJointBase.DoLoaded;
- var
- mng: TComponent;
- Obj: TGLBaseSceneObject;
- begin
- inherited;
- if FManagerName <> '' then
- begin
- mng := FindManager(TGLODEManager, FManagerName);
- if Assigned(mng) then
- Manager := TGLODEManager(mng);
- FManagerName := '';
- end;
- if FObject1Name <> '' then
- begin
- Obj := GetGLSceneObject(FObject1Name);
- if Assigned(Obj) then
- Object1 := Obj;
- FObject1Name := '';
- end;
- if FObject2Name <> '' then
- begin
- Obj := GetGLSceneObject(FObject2Name);
- if Assigned(Obj) then
- Object2 := Obj;
- FObject2Name := '';
- end;
- Attach;
- end;
- function TGLODEJointBase.IsAttached: Boolean;
- var
- Body1, Body2: PdxBody;
- begin
- Result := False;
- if JointID <> nil then
- begin
- Body1 := dJointGetBody(JointID, 0);
- Body2 := dJointGetBody(JointID, 1);
- if joBothObjectsMustBeAssigned in JointOptions then
- Result := Assigned(Body1) and Assigned(Body2)
- else
- Result := Assigned(Body1) or Assigned(Body2);
- end;
- end;
- procedure TGLODEJointBase.SetJointOptions(const Value: TGLODEJointOptions);
- begin
- if Value <> FJointOptions then
- begin
- FJointOptions := Value;
- Attach;
- end;
- end;
- // ---------------
- // --------------- TGLODEJointParams ---------------
- // ---------------
- constructor TGLODEJointParams.Create(AOwner: TPersistent);
- begin
- inherited Create;
- FOwner := AOwner;
- end;
- function TGLODEJointParams.GetOwner: TPersistent;
- begin
- Result := FOwner;
- end;
- procedure TGLODEJointParams.Assign(Source: TPersistent);
- begin
- inherited;
- if not Assigned(Source) then
- Exit;
- if Source is TGLODEJointParams then
- begin
- LoStop := TGLODEJointParams(Source).LoStop;
- HiStop := TGLODEJointParams(Source).HiStop;
- Vel := TGLODEJointParams(Source).Vel;
- FMax := TGLODEJointParams(Source).FMax;
- FudgeFactor := TGLODEJointParams(Source).FudgeFactor;
- Bounce := TGLODEJointParams(Source).Bounce;
- CFM := TGLODEJointParams(Source).CFM;
- StopERP := TGLODEJointParams(Source).StopERP;
- StopCFM := TGLODEJointParams(Source).StopCFM;
- SuspensionERP := TGLODEJointParams(Source).SuspensionERP;
- SuspensionCFM := TGLODEJointParams(Source).SuspensionCFM;
- end;
- end;
- procedure TGLODEJointParams.WriteToFiler(writer: TWriter);
- begin
- with writer do
- begin
- WriteInteger(0); // Archive version
- WriteFloat(LoStop);
- WriteFloat(HiStop);
- WriteFloat(Vel);
- WriteFloat(FMax);
- WriteFloat(FudgeFactor);
- WriteFloat(Bounce);
- WriteFloat(CFM);
- WriteFloat(StopERP);
- WriteFloat(StopCFM);
- WriteFloat(SuspensionERP);
- WriteFloat(SuspensionCFM);
- end;
- end;
- procedure TGLODEJointParams.ReadFromFiler(reader: TReader);
- var
- archiveVersion: Integer;
- begin
- with reader do
- begin
- archiveVersion := ReadInteger;
- Assert(archiveVersion = 0);
- LoStop := ReadFloat;
- HiStop := ReadFloat;
- Vel := ReadFloat;
- FMax := ReadFloat;
- FudgeFactor := ReadFloat;
- Bounce := ReadFloat;
- CFM := ReadFloat;
- StopERP := ReadFloat;
- StopCFM := ReadFloat;
- SuspensionERP := ReadFloat;
- SuspensionCFM := ReadFloat;
- end;
- end;
- function TGLODEJointParams.GetLoStop: TdReal;
- begin
- if Assigned(GetCallback) then
- GetCallback(dParamLoStop1, FLoStop);
- Result := FLoStop;
- end;
- function TGLODEJointParams.GetHiStop: TdReal;
- begin
- if Assigned(GetCallback) then
- GetCallback(dParamHiStop1, FHiStop);
- Result := FHiStop;
- end;
- function TGLODEJointParams.GetVel: TdReal;
- begin
- if Assigned(GetCallback) then
- GetCallback(dParamVel1, FVel);
- Result := FVel;
- end;
- function TGLODEJointParams.GetFMax: TdReal;
- begin
- if Assigned(GetCallback) then
- GetCallback(dParamFMax1, FFMax);
- Result := FFMax;
- end;
- function TGLODEJointParams.GetFudgeFactor: TdReal;
- begin
- if Assigned(GetCallback) then
- GetCallback(dParamFudgeFactor1, FFudgeFactor);
- Result := FFudgeFactor;
- end;
- function TGLODEJointParams.GetBounce: TdReal;
- begin
- if Assigned(GetCallback) then
- GetCallback(dParamBounce1, FBounce);
- Result := FBounce;
- end;
- function TGLODEJointParams.GetCFM: TdReal;
- begin
- if Assigned(GetCallback) then
- GetCallback(dParamCFM1, FCFM);
- Result := FCFM;
- end;
- function TGLODEJointParams.GetStopERP: TdReal;
- begin
- if Assigned(GetCallback) then
- GetCallback(dParamStopERP1, FStopERP);
- Result := FStopERP;
- end;
- function TGLODEJointParams.GetStopCFM: TdReal;
- begin
- if Assigned(GetCallback) then
- GetCallback(dParamStopCFM1, FStopCFM);
- Result := FStopCFM;
- end;
- function TGLODEJointParams.GetSuspensionERP: TdReal;
- begin
- if Assigned(GetCallback) then
- GetCallback(dParamSuspensionERP, FSuspensionERP);
- Result := FSuspensionERP;
- end;
- function TGLODEJointParams.GetSuspensionCFM: TdReal;
- begin
- if Assigned(GetCallback) then
- GetCallback(dParamSuspensionCFM, FSuspensionCFM);
- Result := FSuspensionCFM;
- end;
- procedure TGLODEJointParams.SetLoStop(const Value: TdReal);
- begin
- if Value <> FLoStop then
- begin
- FLoStop := Value;
- if Assigned(SetCallback) then
- FFlagLoStop := not SetCallback(dParamLoStop1, FLoStop)
- else
- FFlagLoStop := True;
- end;
- end;
- procedure TGLODEJointParams.SetHiStop(const Value: TdReal);
- begin
- if Value <> FHiStop then
- begin
- FHiStop := Value;
- if Assigned(SetCallback) then
- FFlagHiStop := not SetCallback(dParamHiStop1, FHiStop)
- else
- FFlagHiStop := True;
- end;
- end;
- procedure TGLODEJointParams.SetVel(const Value: TdReal);
- begin
- if Value <> FVel then
- begin
- FVel := Value;
- if Assigned(SetCallback) then
- FFlagVel := not SetCallback(dParamVel1, FVel)
- else
- FFlagVel := True;
- end;
- end;
- procedure TGLODEJointParams.SetFMax(const Value: TdReal);
- begin
- if Value <> FFMax then
- begin
- FFMax := Value;
- if Assigned(SetCallback) then
- FFlagFMax := not SetCallback(dParamFMax1, FFMax)
- else
- FFlagFMax := True;
- end;
- end;
- procedure TGLODEJointParams.SetFudgeFactor(const Value: TdReal);
- begin
- if Value <> FFudgeFactor then
- begin
- FFudgeFactor := Value;
- if Assigned(SetCallback) then
- FFlagFudgeFactor := not SetCallback(dParamFudgeFactor1, FFudgeFactor)
- else
- FFlagFudgeFactor := True;
- end;
- end;
- procedure TGLODEJointParams.SetBounce(const Value: TdReal);
- begin
- if Value <> FBounce then
- begin
- FBounce := Value;
- if Assigned(SetCallback) then
- FFlagBounce := not SetCallback(dParamBounce1, FBounce)
- else
- FFlagBounce := True;
- end;
- end;
- procedure TGLODEJointParams.SetCFM(const Value: TdReal);
- begin
- if Value <> FCFM then
- begin
- FCFM := Value;
- if Assigned(SetCallback) then
- FFlagCFM := not SetCallback(dParamCFM1, FCFM)
- else
- FFlagCFM := True;
- end;
- end;
- procedure TGLODEJointParams.SetStopERP(const Value: TdReal);
- begin
- if Value <> FStopERP then
- begin
- FStopERP := Value;
- if Assigned(SetCallback) then
- FFlagStopERP := not SetCallback(dParamStopERP1, FStopERP)
- else
- FFlagStopERP := True;
- end;
- end;
- procedure TGLODEJointParams.SetStopCFM(const Value: TdReal);
- begin
- if Value <> FStopCFM then
- begin
- FStopCFM := Value;
- if Assigned(SetCallback) then
- FFlagStopCFM := not SetCallback(dParamStopCFM1, FStopCFM)
- else
- FFlagStopCFM := True;
- end;
- end;
- procedure TGLODEJointParams.SetSuspensionERP(const Value: TdReal);
- begin
- if Value <> FSuspensionERP then
- begin
- FSuspensionERP := Value;
- if Assigned(SetCallback) then
- FFlagSuspensionERP := not SetCallback(dParamSuspensionERP, FSuspensionERP)
- else
- FFlagSuspensionERP := True;
- end;
- end;
- procedure TGLODEJointParams.SetSuspensionCFM(const Value: TdReal);
- begin
- if Value <> FSuspensionCFM then
- begin
- FSuspensionCFM := Value;
- if Assigned(SetCallback) then
- FFlagSuspensionCFM := not SetCallback(dParamSuspensionCFM, FSuspensionCFM)
- else
- FFlagSuspensionCFM := True;
- end;
- end;
- procedure TGLODEJointParams.ApplyFlagged;
- begin
- if not Assigned(SetCallback) then
- Exit;
- if FFlagLoStop then
- SetCallback(dParamLoStop1, FLoStop);
- if FFlagHiStop then
- SetCallback(dParamHiStop1, FHiStop);
- if FFlagVel then
- SetCallback(dParamVel1, FVel);
- if FFlagFMax then
- SetCallback(dParamFMax1, FFMax);
- if FFlagFudgeFactor then
- SetCallback(dParamFudgeFactor1, FFudgeFactor);
- if FFlagBounce then
- SetCallback(dParamBounce1, FBounce);
- if FFlagCFM then
- SetCallback(dParamCFM1, FCFM);
- if FFlagStopERP then
- SetCallback(dParamStopERP1, FStopERP);
- if FFlagStopCFM then
- SetCallback(dParamStopCFM1, FStopCFM);
- if FFlagSuspensionERP then
- SetCallback(dParamSuspensionERP, FSuspensionERP);
- if FFlagSuspensionCFM then
- SetCallback(dParamSuspensionCFM, FSuspensionCFM);
- end;
- // ---------------
- // --------------- TGLODEJointHinge ---------------
- // ---------------
- constructor TGLODEJointHinge.Create(AOwner: TXCollection);
- begin
- inherited;
- FAnchor := TGLCoordinates.CreateInitialized(Self, NullHmgPoint, csPoint);
- FAnchor.OnNotifyChange := AnchorChange;
- FAxis := TGLCoordinates.CreateInitialized(Self, ZHmgVector, csVector);
- FAxis.OnNotifyChange := AxisChange;
- FAxisParams := TGLODEJointParams.Create(Self);
- FAxisParams.SetCallback := SetAxisParam;
- FAxisParams.GetCallback := GetAxisParam;
- end;
-
- destructor TGLODEJointHinge.Destroy;
- begin
- FAnchor.Free;
- FAxis.Free;
- FAxisParams.Free;
- inherited;
- end;
- procedure TGLODEJointHinge.Initialize;
- begin
- if (not IsODEInitialized) or (FInitialized) then
- Exit;
- FJointID := dJointCreateHinge(FManager.World, nil);
- inherited;
- end;
- procedure TGLODEJointHinge.WriteToFiler(writer: TWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(0); // Archive version
- FAnchor.WriteToFiler(writer);
- FAxis.WriteToFiler(writer);
- FAxisParams.WriteToFiler(writer);
- end;
- end;
- procedure TGLODEJointHinge.ReadFromFiler(reader: TReader);
- begin
- inherited;
- with reader do
- begin
- Assert(ReadInteger = 0); // Archive version
- FAnchor.ReadFromFiler(reader);
- FAxis.ReadFromFiler(reader);
- FAxisParams.ReadFromFiler(reader);
- end;
- end;
- procedure TGLODEJointHinge.StructureChanged;
- begin
- AnchorChange(nil);
- AxisChange(nil);
- FAxisParams.ApplyFlagged;
- end;
- procedure TGLODEJointHinge.AnchorChange(Sender: TObject);
- begin
- if IsAttached then
- dJointSetHingeAnchor(FJointID, FAnchor.X, FAnchor.Y, FAnchor.Z);
- end;
- procedure TGLODEJointHinge.AxisChange(Sender: TObject);
- var
- vec: TGLVector;
- begin
- vec := FAxis.DirectVector;
- NormalizeVector(vec);
- FAxis.DirectVector := vec;
- if IsAttached then
- dJointSetHingeAxis(FJointID, FAxis.X, FAxis.Y, FAxis.Z);
- end;
- class function TGLODEJointHinge.FriendlyName: String;
- begin
- Result := 'Hinge';
- end;
- class function TGLODEJointHinge.FriendlyDescription: String;
- begin
- Result := 'ODE Hinge joint';
- end;
- procedure TGLODEJointHinge.SetAnchor(const Value: TGLCoordinates);
- begin
- FAnchor.Assign(Value);
- end;
- procedure TGLODEJointHinge.SetAxis(const Value: TGLCoordinates);
- begin
- FAxis.Assign(Value);
- end;
- procedure TGLODEJointHinge.SetAxisParams(const Value: TGLODEJointParams);
- begin
- AxisParams.Assign(Value);
- end;
- function TGLODEJointHinge.SetAxisParam(Param: Integer; const Value: TdReal): Boolean;
- begin
- if IsAttached then
- begin
- dJointSetHingeParam(JointID, Param, Value);
- Result := True;
- end
- else
- Result := False;
- end;
- function TGLODEJointHinge.GetAxisParam(Param: Integer; var Value: TdReal): Boolean;
- begin
- if IsAttached then
- begin
- Value := dJointGetHingeParam(JointID, Param);
- Result := True;
- end
- else
- Result := False;
- end;
- // ---------------
- // --------------- TGLODEJointBall ---------------
- // ---------------
- constructor TGLODEJointBall.Create(AOwner: TXCollection);
- begin
- inherited;
- FAnchor := TGLCoordinates.CreateInitialized(Self, NullHmgPoint, csPoint);
- FAnchor.OnNotifyChange := AnchorChange;
- end;
- destructor TGLODEJointBall.Destroy;
- begin
- FAnchor.Free;
- inherited;
- end;
- procedure TGLODEJointBall.Initialize;
- begin
- if (not IsODEInitialized) or (FInitialized) then
- Exit;
- FJointID := dJointCreateBall(FManager.World, nil);
- inherited;
- end;
- procedure TGLODEJointBall.WriteToFiler(writer: TWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(0); // Archive version
- FAnchor.WriteToFiler(writer);
- end;
- end;
- procedure TGLODEJointBall.ReadFromFiler(reader: TReader);
- begin
- inherited;
- with reader do
- begin
- Assert(ReadInteger = 0); // Archive version
- FAnchor.ReadFromFiler(reader);
- end;
- end;
- procedure TGLODEJointBall.StructureChanged;
- begin
- AnchorChange(nil);
- end;
- procedure TGLODEJointBall.AnchorChange(Sender: TObject);
- begin
- if IsAttached then
- dJointSetBallAnchor(FJointID, FAnchor.X, FAnchor.Y, FAnchor.Z);
- end;
- class function TGLODEJointBall.FriendlyName: String;
- begin
- Result := 'Ball';
- end;
- class function TGLODEJointBall.FriendlyDescription: String;
- begin
- Result := 'ODE Ball joint implementation';
- end;
- procedure TGLODEJointBall.SetAnchor(const Value: TGLCoordinates);
- begin
- FAnchor.Assign(Value);
- end;
- // ---------------
- // --------------- TGLODEJointSlider ---------------
- // ---------------
- constructor TGLODEJointSlider.Create(AOwner: TXCollection);
- begin
- inherited;
- FAxis := TGLCoordinates.CreateInitialized(Self, ZHmgVector, csVector);
- FAxis.OnNotifyChange := AxisChange;
- FAxisParams := TGLODEJointParams.Create(Self);
- FAxisParams.SetCallback := SetAxisParam;
- FAxisParams.GetCallback := GetAxisParam;
- end;
-
- destructor TGLODEJointSlider.Destroy;
- begin
- FAxis.Free;
- FAxisParams.Free;
- inherited;
- end;
- procedure TGLODEJointSlider.Initialize;
- begin
- if (not IsODEInitialized) or (FInitialized) then
- Exit;
- FJointID := dJointCreateSlider(FManager.World, nil);
- inherited;
- end;
- procedure TGLODEJointSlider.WriteToFiler(writer: TWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(0); // Archive version
- FAxis.WriteToFiler(writer);
- FAxisParams.WriteToFiler(writer);
- end;
- end;
- procedure TGLODEJointSlider.ReadFromFiler(reader: TReader);
- begin
- inherited;
- with reader do
- begin
- Assert(ReadInteger = 0); // Archive version
- FAxis.ReadFromFiler(reader);
- FAxisParams.ReadFromFiler(reader);
- end;
- end;
- procedure TGLODEJointSlider.StructureChanged;
- begin
- AxisChange(nil);
- AxisParams.ApplyFlagged;
- end;
- procedure TGLODEJointSlider.AxisChange(Sender: TObject);
- var
- vec: TGLVector;
- begin
- vec := FAxis.DirectVector;
- NormalizeVector(vec);
- FAxis.DirectVector := vec;
- if IsAttached then
- dJointSetSliderAxis(FJointID, FAxis.X, FAxis.Y, FAxis.Z);
- end;
- class function TGLODEJointSlider.FriendlyName: String;
- begin
- Result := 'Slider';
- end;
- class function TGLODEJointSlider.FriendlyDescription: String;
- begin
- Result := 'ODE Slider joint implementation';
- end;
- procedure TGLODEJointSlider.SetAxis(const Value: TGLCoordinates);
- begin
- FAxis.Assign(Value);
- end;
- procedure TGLODEJointSlider.SetAxisParams(const Value: TGLODEJointParams);
- begin
- AxisParams.Assign(Value);
- end;
- function TGLODEJointSlider.SetAxisParam(Param: Integer;
- const Value: TdReal): Boolean;
- begin
- if IsAttached then
- begin
- dJointSetSliderParam(JointID, Param, Value);
- Result := True;
- end
- else
- Result := False;
- end;
- function TGLODEJointSlider.GetAxisParam(Param: Integer; var Value: TdReal): Boolean;
- begin
- if IsAttached then
- begin
- Value := dJointGetSliderParam(JointID, Param);
- Result := True;
- end
- else
- Result := False;
- end;
- // ---------------
- // --------------- TGLODEJointFixed ---------------
- // ---------------
- procedure TGLODEJointFixed.Initialize;
- begin
- if (not IsODEInitialized) or (FInitialized) then
- Exit;
- FJointID := dJointCreateFixed(FManager.World, nil);
- inherited;
- end;
- procedure TGLODEJointFixed.WriteToFiler(writer: TWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(0); // Archive version
- end;
- end;
- procedure TGLODEJointFixed.ReadFromFiler(reader: TReader);
- begin
- inherited;
- with reader do
- begin
- Assert(ReadInteger = 0); // Archive version
- end;
- end;
- class function TGLODEJointFixed.FriendlyName: String;
- begin
- Result := 'Fixed';
- end;
- class function TGLODEJointFixed.FriendlyDescription: String;
- begin
- Result := 'ODE Fixed joint implementation';
- end;
- // ---------------
- // --------------- TGLODEJointHinge2 ---------------
- // ---------------
- constructor TGLODEJointHinge2.Create(AOwner: TXCollection);
- begin
- inherited;
- FAnchor := TGLCoordinates.CreateInitialized(Self, NullHmgPoint, csPoint);
- FAnchor.OnNotifyChange := AnchorChange;
- FAxis1 := TGLCoordinates.CreateInitialized(Self, ZHmgVector, csVector);
- FAxis1.OnNotifyChange := Axis1Change;
- FAxis2 := TGLCoordinates.CreateInitialized(Self, ZHmgVector, csVector);
- FAxis2.OnNotifyChange := Axis2Change;
- FAxis1Params := TGLODEJointParams.Create(Self);
- FAxis1Params.SetCallback := SetAxis1Param;
- FAxis1Params.GetCallback := GetAxis1Param;
- FAxis2Params := TGLODEJointParams.Create(Self);
- FAxis2Params.SetCallback := SetAxis2Param;
- FAxis2Params.GetCallback := GetAxis2Param;
- JointOptions := [joBothObjectsMustBeAssigned];
- end;
- destructor TGLODEJointHinge2.Destroy;
- begin
- FAnchor.Free;
- FAxis1.Free;
- FAxis2.Free;
- FAxis1Params.Free;
- FAxis2Params.Free;
- inherited;
- end;
- procedure TGLODEJointHinge2.Initialize;
- begin
- if (not IsODEInitialized) or (FInitialized) then
- Exit;
- FJointID := dJointCreateHinge2(FManager.World, nil);
- inherited;
- end;
- procedure TGLODEJointHinge2.WriteToFiler(writer: TWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(0); // Archive version
- FAnchor.WriteToFiler(writer);
- FAxis1.WriteToFiler(writer);
- FAxis2.WriteToFiler(writer);
- FAxis1Params.WriteToFiler(writer);
- FAxis2Params.WriteToFiler(writer);
- end;
- end;
- procedure TGLODEJointHinge2.ReadFromFiler(reader: TReader);
- begin
- inherited;
- with reader do
- begin
- Assert(ReadInteger = 0); // Archive version
- FAnchor.ReadFromFiler(reader);
- FAxis1.ReadFromFiler(reader);
- FAxis2.ReadFromFiler(reader);
- FAxis1Params.ReadFromFiler(reader);
- FAxis2Params.ReadFromFiler(reader);
- end;
- end;
- procedure TGLODEJointHinge2.StructureChanged;
- begin
- AnchorChange(nil);
- Axis1Change(nil);
- Axis2Change(nil);
- Axis1Params.ApplyFlagged;
- Axis2Params.ApplyFlagged;
- end;
- procedure TGLODEJointHinge2.AnchorChange(Sender: TObject);
- begin
- if IsAttached then
- dJointSetHinge2Anchor(FJointID, FAnchor.X, FAnchor.Y, FAnchor.Z);
- end;
- procedure TGLODEJointHinge2.Axis1Change(Sender: TObject);
- var
- vec: TGLVector;
- begin
- vec := FAxis1.DirectVector;
- NormalizeVector(vec);
- FAxis1.DirectVector := vec;
- if IsAttached then
- dJointSetHinge2Axis1(FJointID, FAxis1.X, FAxis1.Y, FAxis1.Z);
- end;
- procedure TGLODEJointHinge2.Axis2Change(Sender: TObject);
- var
- vec: TGLVector;
- begin
- vec := FAxis2.DirectVector;
- NormalizeVector(vec);
- FAxis2.DirectVector := vec;
- if IsAttached then
- dJointSetHinge2Axis2(FJointID, FAxis2.X, FAxis2.Y, FAxis2.Z);
- end;
- class function TGLODEJointHinge2.FriendlyName: String;
- begin
- Result := 'Hinge2';
- end;
- class function TGLODEJointHinge2.FriendlyDescription: String;
- begin
- Result := 'ODE Double Axis Hinge joint implementation';
- end;
- procedure TGLODEJointHinge2.SetAnchor(const Value: TGLCoordinates);
- begin
- FAnchor.Assign(Value);
- end;
- procedure TGLODEJointHinge2.SetAxis1(const Value: TGLCoordinates);
- begin
- FAxis1.Assign(Value);
- end;
- procedure TGLODEJointHinge2.SetAxis2(const Value: TGLCoordinates);
- begin
- FAxis2.Assign(Value);
- end;
- procedure TGLODEJointHinge2.SetAxis1Params(const Value: TGLODEJointParams);
- begin
- Axis1Params.Assign(Value);
- end;
- procedure TGLODEJointHinge2.SetAxis2Params(const Value: TGLODEJointParams);
- begin
- Axis2Params.Assign(Value);
- end;
- function TGLODEJointHinge2.SetAxis1Param(Param: Integer; const Value: TdReal): Boolean;
- begin
- if IsAttached then
- begin
- dJointSetHinge2Param(JointID, Param, Value);
- Result := True;
- end
- else
- Result := False;
- end;
- function TGLODEJointHinge2.SetAxis2Param(Param: Integer; const Value: TdReal): Boolean;
- begin
- if IsAttached then
- begin
- dJointSetHinge2Param(JointID, dParamLoStop2 + Param, Value);
- Result := True;
- end
- else
- Result := False;
- end;
- function TGLODEJointHinge2.GetAxis1Param(Param: Integer; var Value: TdReal): Boolean;
- begin
- if IsAttached then
- begin
- Value := dJointGetHinge2Param(JointID, Param);
- Result := True;
- end
- else
- Result := False;
- end;
- function TGLODEJointHinge2.GetAxis2Param(Param: Integer; var Value: TdReal): Boolean;
- begin
- if IsAttached then
- begin
- Value := dJointGetHinge2Param(JointID, dParamLoStop2 + Param);
- Result := True;
- end
- else
- Result := False;
- end;
- // ---------------
- // --------------- TGLODEJointUniversal ---------------
- // ---------------
- constructor TGLODEJointUniversal.Create(AOwner: TXCollection);
- begin
- inherited;
- FAnchor := TGLCoordinates.CreateInitialized(Self, NullHmgPoint, csPoint);
- FAnchor.OnNotifyChange := AnchorChange;
- FAxis1 := TGLCoordinates.CreateInitialized(Self, ZHmgVector, csVector);
- FAxis1.OnNotifyChange := Axis1Change;
- FAxis2 := TGLCoordinates.CreateInitialized(Self, XHmgVector, csVector);
- FAxis2.OnNotifyChange := Axis2Change;
- FAxis1Params := TGLODEJointParams.Create(Self);
- FAxis1Params.SetCallback := SetAxis1Param;
- FAxis1Params.GetCallback := GetAxis1Param;
- FAxis2Params := TGLODEJointParams.Create(Self);
- FAxis2Params.SetCallback := SetAxis2Param;
- FAxis2Params.GetCallback := GetAxis2Param;
- JointOptions := [joBothObjectsMustBeAssigned];
- end;
- destructor TGLODEJointUniversal.Destroy;
- begin
- FAnchor.Free;
- FAxis1.Free;
- FAxis2.Free;
- FAxis1Params.Free;
- FAxis2Params.Free;
- inherited;
- end;
- procedure TGLODEJointUniversal.Initialize;
- begin
- if (not IsODEInitialized) or (FInitialized) then
- Exit;
- FJointID := dJointCreateUniversal(FManager.World, nil);
- inherited;
- end;
- procedure TGLODEJointUniversal.WriteToFiler(writer: TWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(0); // Archive version
- FAnchor.WriteToFiler(writer);
- FAxis1.WriteToFiler(writer);
- FAxis2.WriteToFiler(writer);
- FAxis1Params.WriteToFiler(writer);
- FAxis2Params.WriteToFiler(writer);
- end;
- end;
- procedure TGLODEJointUniversal.ReadFromFiler(reader: TReader);
- begin
- inherited;
- with reader do
- begin
- Assert(ReadInteger = 0); // Archive version
- FAnchor.ReadFromFiler(reader);
- FAxis1.ReadFromFiler(reader);
- FAxis2.ReadFromFiler(reader);
- FAxis1Params.ReadFromFiler(reader);
- FAxis2Params.ReadFromFiler(reader);
- end;
- end;
- procedure TGLODEJointUniversal.StructureChanged;
- begin
- AnchorChange(nil);
- Axis1Change(nil);
- Axis2Change(nil);
- Axis1Params.ApplyFlagged;
- Axis2Params.ApplyFlagged;
- end;
- procedure TGLODEJointUniversal.AnchorChange(Sender: TObject);
- begin
- if IsAttached then
- dJointSetUniversalAnchor(FJointID, FAnchor.X, FAnchor.Y, FAnchor.Z);
- end;
- procedure TGLODEJointUniversal.Axis1Change(Sender: TObject);
- var
- vec: TGLVector;
- begin
- vec := FAxis1.DirectVector;
- NormalizeVector(vec);
- FAxis1.DirectVector := vec;
- if IsAttached then
- dJointSetUniversalAxis1(FJointID, FAxis1.X, FAxis1.Y, FAxis1.Z);
- end;
- procedure TGLODEJointUniversal.Axis2Change(Sender: TObject);
- var
- vec: TGLVector;
- begin
- vec := FAxis2.DirectVector;
- NormalizeVector(vec);
- FAxis2.DirectVector := vec;
- if IsAttached then
- dJointSetUniversalAxis2(FJointID, FAxis2.X, FAxis2.Y, FAxis2.Z);
- end;
- class function TGLODEJointUniversal.FriendlyName: String;
- begin
- Result := 'Universal';
- end;
- class function TGLODEJointUniversal.FriendlyDescription: String;
- begin
- Result := 'ODE Universal joint implementation';
- end;
- procedure TGLODEJointUniversal.SetAnchor(const Value: TGLCoordinates);
- begin
- FAnchor.Assign(Value);
- end;
- procedure TGLODEJointUniversal.SetAxis1(const Value: TGLCoordinates);
- begin
- FAxis1.Assign(Value);
- end;
- procedure TGLODEJointUniversal.SetAxis2(const Value: TGLCoordinates);
- begin
- FAxis2.Assign(Value);
- end;
- procedure TGLODEJointUniversal.SetAxis1Params(const Value: TGLODEJointParams);
- begin
- Axis1Params.Assign(Value);
- end;
- procedure TGLODEJointUniversal.SetAxis2Params(const Value: TGLODEJointParams);
- begin
- Axis2Params.Assign(Value);
- end;
- function TGLODEJointUniversal.SetAxis1Param(Param: Integer; const Value: TdReal): Boolean;
- begin
- if IsAttached then
- begin
- dJointSetUniversalParam(JointID, Param, Value);
- Result := True;
- end
- else
- Result := False;
- end;
- function TGLODEJointUniversal.SetAxis2Param(Param: Integer; const Value: TdReal): Boolean;
- begin
- if IsAttached then
- begin
- dJointSetUniversalParam(JointID, dParamLoStop2 + Param, Value);
- Result := True;
- end
- else
- Result := False;
- end;
- function TGLODEJointUniversal.GetAxis1Param(Param: Integer; var Value: TdReal): Boolean;
- begin
- if IsAttached then
- begin
- Value := dJointGetUniversalParam(JointID, Param);
- Result := True;
- end
- else
- Result := False;
- end;
- function TGLODEJointUniversal.GetAxis2Param(Param: Integer; var Value: TdReal): Boolean;
- begin
- if IsAttached then
- begin
- Value := dJointGetUniversalParam(JointID, dParamLoStop2 + Param);
- Result := True;
- end
- else
- Result := False;
- end;
- // ---------------
- // --------------- TGLODECustomCollider --------------
- // ---------------
- constructor TGLODECustomCollider.Create(AOwner: TXCollection);
- begin
- inherited;
- FContactList := TList.Create;
- FContactCache := TList.Create;
- FContactResolution := 1;
- FRenderContacts := False;
- FContactRenderPoints := TGLAffineVectorList.Create;
- FContactColor := TGLColor.CreateInitialized(Self, clrRed, NotifyChange);
- FPointSize := 3;
- end;
- destructor TGLODECustomCollider.Destroy;
- var
- i: Integer;
- begin
- FContactList.Free;
- for i := 0 to FContactCache.Count - 1 do
- TGLODEContactPoint(FContactCache[i]).Free;
- FContactCache.Free;
- FContactRenderPoints.Free;
- FContactColor.Free;
- inherited;
- end;
- procedure TGLODECustomCollider.Initialize;
- begin
- if not Assigned(Manager) then
- exit;
- if not Assigned(Manager.Space) then
- exit;
- if vCustomColliderClassNum = 0 then
- begin
- with vCustomColliderClass do
- begin
- bytes := 0;
- Collider := GetCustomColliderFn;
- aabb := dInfiniteAABB;
- aabb_test := nil;
- dtor := nil;
- end;
- vCustomColliderClassNum := dCreateGeomClass(vCustomColliderClass);
- end;
- FGeom := dCreateGeom(vCustomColliderClassNum);
- dGeomSetData(FGeom, Self);
- dSpaceAdd(Manager.Space, FGeom);
- inherited;
- end;
- procedure TGLODECustomCollider.Finalize;
- begin
- if not Initialized then
- exit;
- if Assigned(FGeom) then
- begin
- dGeomDestroy(FGeom);
- FGeom := nil;
- end;
- inherited;
- end;
- procedure TGLODECustomCollider.WriteToFiler(writer: TWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(0); // Archive version
- WriteFloat(FContactResolution);
- WriteBoolean(FRenderContacts);
- WriteFloat(FPointSize);
- Write(PByte(FContactColor.AsAddress)^, 4);
- end;
- end;
- procedure TGLODECustomCollider.ReadFromFiler(reader: TReader);
- var
- archiveVersion: Integer;
- begin
- inherited;
- with reader do
- begin
- archiveVersion := ReadInteger;
- Assert(archiveVersion = 0); // Archive version
- FContactResolution := ReadFloat;
- FRenderContacts := ReadBoolean;
- FPointSize := ReadFloat;
- Read(PByte(FContactColor.AsAddress)^, 4);
- end;
- end;
- procedure TGLODECustomCollider.ClearContacts;
- begin
- FContactList.Clear;
- end;
- procedure TGLODECustomCollider.AddContact(x, y, z: TdReal);
- begin
- AddContact(AffineVectorMake(x, y, z));
- end;
- procedure TGLODECustomCollider.AddContact(pos: TAffineVector);
- var
- absPos, colPos, colNorm: TAffineVector;
- Depth: Single;
- ContactPoint: TGLODEContactPoint;
- begin
- absPos := AffineVectorMake(VectorTransform(PointMake(pos), FTransform));
- if Collide(absPos, Depth, colPos, colNorm) then
- begin
- if FContactList.Count < FContactCache.Count then
- ContactPoint := FContactCache[FContactList.Count]
- else
- begin
- ContactPoint := TGLODEContactPoint.Create;
- FContactCache.Add(ContactPoint);
- end;
- ContactPoint.Position := colPos;
- ContactPoint.Normal := colNorm;
- ContactPoint.Depth := Depth;
- FContactList.Add(ContactPoint);
- end;
- if FRenderContacts and Manager.Visible and Manager.VisibleAtRunTime then
- FContactRenderPoints.Add(absPos);
- end;
- function TGLODECustomCollider.ApplyContacts(o1, o2: PdxGeom; flags: Integer;
- contact: PdContactGeom; skip: Integer): Integer;
- var
- i, maxContacts: Integer;
- begin
- FContactList.Sort(ContactSort);
- Result := 0;
- maxContacts := flags and $FFFF;
- try
- for i := 0 to FContactList.Count - 1 do
- begin
- if Result >= maxContacts then
- Exit;
- with TGLODEContactPoint(FContactList[i]) do
- begin
- contact.Depth := Depth;
- contact.pos[0] := Position.x;
- contact.pos[1] := Position.y;
- contact.pos[2] := Position.z;
- contact.pos[3] := 1;
- contact.Normal[0] := -Normal.x;
- contact.Normal[1] := -Normal.y;
- contact.Normal[2] := -Normal.z;
- contact.Normal[3] := 0;
- end;
- contact.g1 := o1;
- contact.g2 := o2;
- contact := PdContactGeom(Integer(contact) + skip);
- Inc(Result);
- end;
- finally
- ClearContacts;
- end;
- end;
- procedure TGLODECustomCollider.SetTransform(ATransform: TGLMatrix);
- begin
- FTransform := ATransform;
- end;
- procedure TGLODECustomCollider.SetContactResolution(const Value: Single);
- begin
- FContactResolution := Value;
- if FContactResolution <= 0 then
- FContactResolution := 0.01;
- end;
- procedure TGLODECustomCollider.Render(var rci: TGLRenderContextInfo);
- var
- i: Integer;
- begin
- if FRenderContacts and (FContactRenderPoints.Count>0) then
- begin
- gl.PushAttrib(GL_CURRENT_BIT);
- gl.Color3fv(PGLfloat(FContactColor.AsAddress));
- gl.PointSize(FPointSize);
- gl.Begin_(GL_POINTS);
- for i := 0 to FContactRenderPoints.Count - 1 do
- gl.Vertex3fv(@FContactRenderPoints.List[i]);
- gl.End_;
- gl.PopAttrib;
- end;
- FContactRenderPoints.Clear;
- end;
- procedure TGLODECustomCollider.SetRenderContacts(const Value: Boolean);
- begin
- if Value <> FRenderContacts then
- begin
- FRenderContacts := Value;
- NotifyChange(Self);
- end;
- end;
- procedure TGLODECustomCollider.SetContactColor(const Value: TGLColor);
- begin
- FContactColor.Assign(Value);
- end;
- procedure TGLODECustomCollider.SetPointSize(const Value: Single);
- begin
- if Value <> FPointSize then
- begin
- FPointSize := Value;
- NotifyChange(Self);
- end;
- end;
- // ---------------
- // --------------- TGLODEHeightField --------------
- // ---------------
- constructor TGLODEHeightField.Create(AOwner: TXCollection);
- var
- Allow: Boolean;
- begin
- Allow := False;
- if Assigned(AOwner) then
- begin
- if Assigned(AOwner.Owner) then
- begin
- if ((AOwner.Owner) is TGLTerrainRenderer) or
- ((AOwner.Owner) is TGLHeightField) then
- Allow := True;
- end;
- end;
- if not Allow then
- raise Exception.Create
- ('This element must be a behaviour of a TGLTerrainRenderer or TGLHeightField');
- inherited Create(AOwner);
- end;
- procedure TGLODEHeightField.WriteToFiler(writer: TWriter);
- begin
- inherited;
- with writer do
- begin
- WriteInteger(0); // Archive version
- end;
- end;
- procedure TGLODEHeightField.ReadFromFiler(reader: TReader);
- var
- archiveVersion: Integer;
- begin
- inherited;
- with reader do
- begin
- archiveVersion := ReadInteger;
- Assert(archiveVersion = 0); // Archive version
- end;
- end;
- class function TGLODEHeightField.FriendlyName: string;
- begin
- Result := 'ODE HeightField Collider';
- end;
- class function TGLODEHeightField.FriendlyDescription: string;
- begin
- Result := 'A custom ODE collider powered by it''s parent TGLTerrainRenderer or TGLHeightField';
- end;
- class function TGLODEHeightField.UniqueItem: Boolean;
- begin
- Result := True;
- end;
- class function TGLODEHeightField.CanAddTo(collection: TXCollection): Boolean;
- begin
- Result := False;
- if collection is TGLBehaviours then
- if Assigned(TGLBehaviours(collection).Owner) then
- if (TGLBehaviours(collection).Owner is TGLHeightField)
- or (TGLBehaviours(collection).Owner is TGLTerrainRenderer) then
- Result := True;
- end;
- function TGLODEHeightField.Collide(aPos: TAffineVector; var Depth: Single;
- var cPos, cNorm: TAffineVector): Boolean;
- function AbsoluteToLocal(vec: TGLVector): TGLVector;
- var
- mat: TGLMatrix;
- begin
- if Owner.Owner is TGLHeightField then
- Result := TGLHeightField(Owner.Owner).AbsoluteToLocal(vec)
- else if Owner.Owner is TGLTerrainRenderer then
- begin
- mat := TGLTerrainRenderer(Owner.Owner).AbsoluteMatrix;
- NormalizeMatrix(mat);
- InvertMatrix(mat);
- Result := VectorTransform(vec, mat);
- end
- else
- Assert(False);
- end;
- function LocalToAbsolute(vec: TGLVector): TGLVector;
- var
- mat: TGLMatrix;
- begin
- if Owner.Owner is TGLHeightField then
- Result := TGLHeightField(Owner.Owner).LocalToAbsolute(vec)
- else if Owner.Owner is TGLTerrainRenderer then
- begin
- mat := TGLTerrainRenderer(Owner.Owner).AbsoluteMatrix;
- NormalizeMatrix(mat);
- Result := VectorTransform(vec, mat);
- end
- else
- Assert(False);
- end;
- function GetHeight(pos: TGLVector; var height: Single): Boolean;
- var
- dummy1: TGLVector;
- dummy2: TTexPoint;
- begin
- Result := False;
- if Owner.Owner is TGLTerrainRenderer then
- begin
- height := TGLTerrainRenderer(Owner.Owner).InterpolatedHeight(LocalToAbsolute(pos));
- Result := True;
- end
- else
- if Owner.Owner is TGLHeightField then
- begin
- if Assigned(TGLHeightField(Owner.Owner).OnGetHeight) then
- begin
- TGLHeightField(Owner.Owner).OnGetHeight(pos.x, pos.y, height, dummy1, dummy2);
- Result := True;
- end;
- end;
- end;
- const
- cDelta = 0.1;
- var
- localPos: TGLVector;
- height: Single;
- temp1, temp2: TAffineVector;
- begin
- localPos := AbsoluteToLocal(PointMake(aPos));
- if GetHeight(localPos, height) then
- begin
- Depth := height - localPos.z;
- Result := (Depth > 0);
- if Result then
- begin
- localPos.z := height;
- cPos := AffineVectorMake(LocalToAbsolute(localPos));
- temp1.x:= localPos.x + cDelta;
- temp1.y := localPos.y;
- temp1.z := localPos.z;
- GetHeight(PointMake(temp1), temp1.z);
- temp2.x := localPos.x;
- temp2.y := localPos.y + cDelta;
- temp2.z := localPos.z;
- GetHeight(PointMake(temp2), temp2.z);
- cNorm := CalcPlaneNormal(AffineVectorMake(localPos), temp1, temp2);
- cNorm := AffineVectorMake(LocalToAbsolute(VectorMake(cNorm)));
- end;
- end
- else
- Result := False;
- end;
- // ------------------------------------------------------------------
- initialization
- // ------------------------------------------------------------------
- vODEObjectRegister := TList.Create;
- RegisterXCollectionItemClass(TGLODEDynamic);
- RegisterXCollectionItemClass(TGLODEStatic);
- RegisterXCollectionItemClass(TGLODEElementBox);
- RegisterXCollectionItemClass(TGLODEElementSphere);
- RegisterXCollectionItemClass(TGLODEElementCapsule);
- RegisterXCollectionItemClass(TGLODEElementCylinder);
- RegisterXCollectionItemClass(TGLODEElementTriMesh);
- RegisterXCollectionItemClass(TGLODEElementPlane);
- RegisterXCollectionItemClass(TGLODEJointHinge);
- RegisterXCollectionItemClass(TGLODEJointBall);
- RegisterXCollectionItemClass(TGLODEJointSlider);
- RegisterXCollectionItemClass(TGLODEJointFixed);
- RegisterXCollectionItemClass(TGLODEJointHinge2);
- RegisterXCollectionItemClass(TGLODEJointUniversal);
- RegisterXCollectionItemClass(TGLODEHeightField);
- // ------------------------------------------------------------------
- finalization
- // ------------------------------------------------------------------
- vODEObjectRegister.Free;
- UnregisterXCollectionItemClass(TGLODEDynamic);
- UnregisterXCollectionItemClass(TGLODEStatic);
- UnregisterXCollectionItemClass(TGLODEElementBox);
- UnregisterXCollectionItemClass(TGLODEElementSphere);
- UnregisterXCollectionItemClass(TGLODEElementCapsule);
- UnregisterXCollectionItemClass(TGLODEElementCylinder);
- UnregisterXCollectionItemClass(TGLODEElementTriMesh);
- UnregisterXCollectionItemClass(TGLODEElementPlane);
- UnregisterXCollectionItemClass(TGLODEJointHinge);
- UnregisterXCollectionItemClass(TGLODEJointBall);
- UnregisterXCollectionItemClass(TGLODEJointSlider);
- UnregisterXCollectionItemClass(TGLODEJointFixed);
- UnregisterXCollectionItemClass(TGLODEJointHinge2);
- UnregisterXCollectionItemClass(TGLODEJointUniversal);
- UnregisterXCollectionItemClass(TGLODEHeightField);
- // CloseODE;
- end.
|