unit fDceDemoD; interface uses Winapi.Windows, Winapi.OpenGL, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.Imaging.Jpeg, GLS.Scene, GLS.Objects, GLS.PersistentClasses, GLS.Cadencer, GLS.SceneViewer, GLS.DCE, GLS.Material, GLS.Texture, GLS.HeightData, GLS.TerrainRenderer, GLS.VectorFileObjects, GLS.BitmapFont, GLS.WindowsFont, GLS.HUDObjects, GLS.Coordinates, GLScene.VectorGeometry, GLS.FileMD2, GLS.File3DS, GLS.Context, GLS.EllipseCollision, GLS.RenderContextInfo, GLS.Keyboard, GLS.ProxyObjects, GLS.State, GLScene.Utils, GLS.BaseClasses, GLScene.VectorTypes; type TFormDCE = class(TForm) GLScene1: TGLScene; GLSceneViewer1: TGLSceneViewer; GLCadencer1: TGLCadencer; GLCamera1: TGLCamera; Player: TGLDummyCube; GLDCEManager1: TGLDCEManager; Terrain: TGLTerrainRenderer; GLBitmapHDS1: TGLBitmapHDS; GLMatLib: TGLMaterialLibrary; GLLightSource1: TGLLightSource; GLActor1: TGLActor; GLSphere1: TGLSphere; GLLightSource2: TGLLightSource; Balls: TGLDummyCube; GLWindowsBitmapFont1: TGLWindowsBitmapFont; Timer1: TTimer; GLHUDText1: TGLHUDText; Mushrooms: TGLDummyCube; moMushroom: TGLFreeForm; GLDirectOpenGL1: TGLDirectOpenGL; GLCube1: TGLCube; Help: TGLHUDText; HelpShadow: TGLHUDText; Ground: TGLPlane; HUDTextCoords: TGLHUDText; procedure FormShow(Sender: TObject); procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure GLCadencer1Progress(Sender: TObject; const deltaTime, newTime: Double); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure PlayerBehaviours0Collision(Sender: TObject; ObjectCollided: TGLBaseSceneObject; CollisionInfo: TDCECollision); procedure Timer1Timer(Sender: TObject); procedure GLDirectOpenGL1Render(Sender: TObject; var rci: TGLRenderContextInfo); public mx, my: Integer; Jumped: boolean; procedure Load; procedure HandleKeys; procedure HandleAnimation; procedure AddBall; procedure AddMushrooms; end; var FormDCE: TFormDCE; const cForce: Single = 250; cSpread: Integer = 200; cNbMushrooms = 20; implementation {$R *.dfm} //----------------------------------------------------------------- procedure TFormDCE.Load; begin var Path: TFileName := GetCurrentAssetPath(); // Load texture material for terrain SetCurrentDir(Path + '\texture'); GLMatLib.AddTextureMaterial('Terrain', 'snow512.jpg'); // Load Terrain GLBitmapHDS1.MaxPoolSize := 8 * 1024 * 1024; GLBitmapHDS1.Picture.LoadFromFile('terrain.bmp'); Terrain.Direction.SetVector(0, 1, 0); Terrain.Material.LibMaterialName := 'Terrain'; Terrain.TilesPerTexture := 256 / Terrain.TileSize; Terrain.Scale.SetVector(1, 1, 0.02); Ground.Material.LibMaterialName := 'Terrain'; // Load static mushroom mesh SetCurrentDir(Path + '\model'); // Always use AutoScaling property or you may get some problems moMushroom.AutoScaling.SetPoint(0.1, 0.1, 0.1); moMushroom.LoadFromFile('Mushroom.3ds'); moMushroom.Direction.SetVector(0, 1, 0); moMushroom.BuildOctree(); // Load player Player.Position.SetPoint(0.0, 3.0, 0.0); // Load dyn modelexts with textures and animations SetCurrentDir(Path + '\modelext'); GLMatLib.AddTextureMaterial('Actor', 'waste.jpg'); GLActor1.LoadFromFile('Waste.md2'); GLActor1.Direction.SetVector(0, 1, 0); GLActor1.Up.SetVector(1, 0, 0); GLActor1.Scale.SetVector(0.05, 0.05, 0.05); GLActor1.Material.LibMaterialName := 'Actor'; GLActor1.Animations.LoadFromFile('Quake2Animations.aaf'); // Define animation properties GLActor1.AnimationMode := aamLoop; GLActor1.SwitchToAnimation('stand'); GLActor1.FrameInterpolation := afpLinear; // DCE Behaviour GLSphere1.Scale.Assign(GetOrCreateDCEDynamic(Player).Size); GetOrCreateDCEDynamic(Player).OnCollision := PlayerBehaviours0Collision; end; //----------------------------------------------------------------- procedure TFormDCE.FormShow(Sender: TObject); begin Load; GLCadencer1.Enabled := true; Help.Text := 'Mouse Drag - Look' + #13 + 'A,W,S,D - movement' + #13 + 'SPACE - Jump' + #13 + 'F1 - Add one ball' + #13 + 'F2 - Add 10 balls' + #13 + 'F3 - Add 20 mushrooms' + #13 + 'F4 - Change ground to box' + #13 + 'F5 - Toggle step mode' + #13 + 'RETURN - Reset'; end; //----------------------------------------------------------------- procedure TFormDCE.AddBall; var Ball: TGLSphere; S: Single; begin Ball := TGLSphere(Balls.AddNewChild(TGLSphere)); Ball.Tag := 1; // set the identifier of a ball Ball.Radius := 1; S := (100 + Random(900)) / 500; Ball.Scale.SetVector(S, S, S); Ball.Position.SetPoint(Random(40) - Random(40), 4 + Random(10), Random(40) - Random(40)); Ball.Material.FrontProperties.Diffuse.SetColor((100 + Random(900)) / 1000, (100 + Random(900)) / 1000, (100 + Random(900)) / 1000); GetOrCreateDCEDynamic(Ball).Manager := GLDCEManager1; GetOrCreateDCEDynamic(Ball).BounceFactor := 0.75; GetOrCreateDCEDynamic(Ball).Friction := 0.1; GetOrCreateDCEDynamic(Ball).SlideOrBounce := csbBounce; GetOrCreateDCEDynamic(Ball).Size.Assign(Ball.Scale); end; //----------------------------------------------------------------- procedure TFormDCE.AddMushrooms; var i: Integer; proxy: TGLFreeFormProxy; S: TGLVector; f: Single; begin // spawn some more mushrooms using proxy objects for i := 0 to cNbMushrooms - 1 do begin // create a new proxy and set its MasterObject property proxy := TGLFreeFormProxy(Mushrooms.AddNewChild(TGLFreeFormProxy)); proxy.ProxyOptions := [pooObjects]; proxy.MasterObject := moMushroom; // retrieve reference attitude proxy.Direction := moMushroom.Direction; proxy.Up := moMushroom.Up; // randomize scale S := moMushroom.Scale.AsVector; f := (2 * Random + 1); ScaleVector(S, f); proxy.Scale.AsVector := S; // randomize position proxy.Position.SetPoint(Random(cSpread) - (cSpread / 2), moMushroom.Position.Z + 1.5 * f, Random(cSpread) - (cSpread / 2)); // randomize orientation proxy.RollAngle := Random(360); proxy.TransformationChanged; GetOrCreateDCEStatic(proxy).Manager := GLDCEManager1; GetOrCreateDCEStatic(proxy).BounceFactor := 0.75; GetOrCreateDCEStatic(proxy).Friction := 10; GetOrCreateDCEStatic(proxy).Shape := csFreeform; end; end; //----------------------------------------------------------------- procedure TFormDCE.HandleKeys; var Force: TAffineVector; begin Force := NullVector; if IsKeyDown('w') or IsKeyDown('z') then Force.Z := cForce; if IsKeyDown('s') then Force.Z := -cForce; if IsKeyDown('a') or IsKeyDown('q') then Force.X := cForce; if IsKeyDown('d') or IsKeyDown('e') then Force.X := -cForce; GetOrCreateDCEDynamic(Player).ApplyAccel(Force); end; //----------------------------------------------------------------- procedure TFormDCE.HandleAnimation; var anim: string; begin if VectorNorm(GetOrCreateDCEDynamic(Player).Speed) > 0.1 then anim := 'run' else anim := 'stand'; if Jumped then begin if (not GetOrCreateDCEDynamic(Player).InGround) then anim := 'jump' else Jumped := False; end; if anim = 'jump' then GLActor1.Interval := 500 else GLActor1.Interval := 100; if GLActor1.CurrentAnimation <> anim then GLActor1.SwitchToAnimation(anim); end; //----------------------------------------------------------------- procedure TFormDCE.GLCadencer1Progress(Sender: TObject; const deltaTime, newTime: Double); begin HandleKeys; HandleAnimation; // This shows the manual progress, don't need this if you use the automatic mode if GLDCEManager1.ManualStep then GLDCEManager1.Step(deltaTime); Help.ModulateColor.Alpha := Help.ModulateColor.Alpha - (deltaTime * 0.05); if Help.ModulateColor.Alpha < 0.25 then Help.ModulateColor.Alpha := 0.25; HelpShadow.ModulateColor.Alpha := Help.ModulateColor.Alpha; HelpShadow.Text := Help.Text; HUDTextCoords.Text := 'X: ' + FloatToStrF(Player.Position.X, ffFixed, 7, 2) + ' ' + 'Y: ' + FloatToStrF(Player.Position.Y, ffFixed, 7, 2) + ' ' + 'Z: ' + FloatToStrF(Player.Position.Z, ffFixed, 7, 2); end; //----------------------------------------------------------------- procedure TFormDCE.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin // Mouse look if ssLeft in Shift then begin GLCamera1.MoveAroundTarget((my - Y), 0); Player.Turn(-(mx - X)); end; mx := X; my := Y; end; //----------------------------------------------------------------- procedure TFormDCE.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var i: Integer; begin if Key = VK_F1 then AddBall; if Key = VK_F2 then for i := 1 to 10 do AddBall; if Key = VK_F3 then AddMushrooms; if (Key = VK_Space) then begin GetOrCreateDCEDynamic(Player).Jump(1, 20); Jumped := true; end; if Key = VK_F4 then begin Terrain.Visible := False; Ground.Visible := true; GetOrCreateDCEStatic(Terrain).Active := False; GetOrCreateDCEStatic(Ground).Active := true; end; if Key = VK_F5 then GLDCEManager1.ManualStep := not GLDCEManager1.ManualStep; if (Key = VK_RETURN) then begin Player.Position.SetPoint(0, 3, 0); Balls.DeleteChildren; Mushrooms.DeleteChildren; Help.ModulateColor.Alpha := 1; Terrain.Visible := true; Ground.Visible := False; GetOrCreateDCEStatic(Terrain).Active := true; GetOrCreateDCEStatic(Ground).Active := False; end; if Key = VK_ESCAPE then Halt; end; //----------------------------------------------------------------- procedure TFormDCE.PlayerBehaviours0Collision(Sender: TObject; ObjectCollided: TGLBaseSceneObject; CollisionInfo: TDCECollision); var v: TAffineVector; begin // Use some kind of identifier to know what object you are colliding // You can use the Tag, TagFloat, Name, Class if ObjectCollided.Tag = 1 then begin v := AffineVectorMake(VectorSubtract(ObjectCollided.AbsolutePosition, Player.AbsolutePosition)); NormalizeVector(v); ScaleVector(v, 400); GetOrCreateDCEDynamic(ObjectCollided).StopAbsAccel; GetOrCreateDCEDynamic(ObjectCollided).ApplyAbsAccel(v); end; end; //----------------------------------------------------------------- procedure TFormDCE.GLDirectOpenGL1Render(Sender: TObject; var rci: TGLRenderContextInfo); var i: Integer; p, n: TAffineVector; begin // To use this you will need to enable the debug define in the // GLEllipseCollision.pas, if you do, don't forget to clear the // triangle list! -> SetLength(debug_tri,0); rci.GLStates.PointSize := 5.0; glColor3f(0, 1, 0); for i := 0 to High(debug_tri) do with debug_tri[i] do begin glColor3f(0, 0, 0); glBegin(GL_LINE_STRIP); glVertex3f(p1.X, p1.Y, p1.Z); glVertex3f(p2.X, p2.Y, p2.Z); glVertex3f(p3.X, p3.Y, p3.Z); glEnd; CalcPlaneNormal(p1, p2, p3, n); ScaleVector(n, 0.25); p.X := (p1.X + p2.X + p3.X) / 3; p.Y := (p1.Y + p2.Y + p3.Y) / 3; p.Z := (p1.Z + p2.Z + p3.Z) / 3; glColor3f(0, 0, 1); glBegin(GL_LINE_STRIP); glVertex3f(p.X, p.Y, p.Z); glVertex3f(p.X + n.X, p.Y + n.Y, p.Z + n.Z); glEnd; glBegin(GL_POINTS); glVertex3f(p.X + n.X, p.Y + n.Y, p.Z + n.Z); glEnd; end; // } SetLength(debug_tri, 0); end; //----------------------------------------------------------------- procedure TFormDCE.Timer1Timer(Sender: TObject); var S: string; begin if GLDCEManager1.ManualStep then S := 'Manual' else S := 'Automatic'; GLHUDText1.Text := Format('FPS: %.1f - Dynamics: %d - Statics: %d - Step mode: %s', [GLSceneViewer1.FramesPerSecond, GLDCEManager1.DynamicCount, GLDCEManager1.StaticCount, S]); GLSceneViewer1.ResetPerformanceMonitor; end; end.