unit fdWalkCarry; interface uses Winapi.Windows, System.SysUtils, System.Variants, System.Classes, System.Math, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Imaging.Jpeg, Stage.VectorGeometry, Stage.Keyboard, Stage.VectorTypes, Stage.Utils, GLS.Scene, GLS.PersistentClasses, GLS.Material, GLS.Cadencer, GLS.SceneViewer, GLS.VectorFileObjects, GLS.Octree, GLS.GeomObjects, GLS.BaseClasses, GLS.BitmapFont, GLS.WindowsFont, GLS.Objects, GLS.Coordinates, GLS.File3DS, GLS.Navigator, GLS.XCollection, GLS.Color, GLS.HUDObjects, GLS.Texture, GLS.NGDManager; type TMap = record mdl: TGLFreeForm; dyn: boolean; end; TFormNewtonWalkCarry = class(TForm) GLScene1: TGLScene; GLSceneViewer1: TGLSceneViewer; GLNGDManager1: TGLNGDManager; GLCadencer1: TGLCadencer; GLMaterialLibrary1: TGLMaterialLibrary; Player_Cam: TGLCamera; Cam_Cube: TGLDummyCube; Player_Cube: TGLDummyCube; Scene_Objects: TGLDummyCube; Game_Menu: TGLDummyCube; OpenDialog1: TOpenDialog; GLWindowsBitmapFont1: TGLWindowsBitmapFont; Player_Capsule: TGLCapsule; GLLightSource1: TGLLightSource; GLCube2: TGLCube; GLNavigator1: TGLNavigator; GLUserInterface1: TGLUserInterface; GLNavigator2: TGLNavigator; TIPickTimer: TTimer; GLHUDSprite1: TGLHUDSprite; GLSphere1: TGLSphere; Memo1: TMemo; GLCube3: TGLCube; Jump_Timer: TTimer; GLHUDText1: TGLHUDText; Timer_OnVelocity: TTimer; On_Drop: TTimer; GLLines1: TGLLines; procedure FormCreate(Sender: TObject); procedure GLCadencer1Progress(Sender: TObject; const deltaTime, newTime: Double); procedure TIPickTimerTimer(Sender: TObject); procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Jump_TimerTimer(Sender: TObject); procedure Timer_OnVelocityTimer(Sender: TObject); procedure On_DropTimer(Sender: TObject); private public procedure Menu_Load; procedure Game_Load; end; var FormNewtonWalkCarry: TFormNewtonWalkCarry; maps: array of TMap; currentPick: TGLCustomSceneObject; FPickedSceneObject: TGLBaseSceneObject; NGDDynamicBehav: TGLNGDDynamic; point3d, FPaneNormal: TGLVector; M_X, M_Y: Integer; Maps_Count: Integer; OnAir, OnGround: boolean; OnMouse_Click, OnDrop, OnPick: boolean; pickjoint: TGLNGDJoint; implementation {$R *.dfm} procedure TFormNewtonWalkCarry.FormCreate(Sender: TObject); begin // Switch to English keyboard layout LoadKeyboardLayout('00000409', KLF_ACTIVATE); Menu_Load; GLHUDText1.Text := 'Walk - WASD'+#13+ 'Jump - Space'+#13+ 'Pick/Drop - Left mouse'+#13+ 'Push - Right mouse'; end; procedure TFormNewtonWalkCarry.GLCadencer1Progress(Sender: TObject; const deltaTime, newTime: Double); var I, D: TVector4f; F: TVector4f; peak_Up, peak_Down: boolean; ray, GP3D, result_GP3D: TVector4f; j: Integer; point2d, GotoPoint3d: TGLVector; key_space: boolean; cp: TPoint; visible_cursor: boolean; ScObj, FScObj: TGLBaseSceneObject; targetColor: TGLColorVector; picked: TGLCustomSceneObject; mm: TMatrix4f; begin GetCursorPos(cp); cp := GLSceneViewer1.ScreenToClient(cp); for j := 0 to Scene_Objects.Count - 1 do begin with Scene_Objects[j] as TGLCustomSceneObject do begin if Tag = 1 then Material.FrontProperties.Emission.Color := clrBlack; end; end; if Assigned(currentPick) then if currentPick.Tag = 1 then begin with currentPick do begin if currentPick.DistanceTo(Player_Capsule) <= 3.5 then begin targetColor := clrRed; end; // Set new color at 66% between current and target color with Material.FrontProperties.Emission do Color := targetColor; // VectorLerp(targetColor, Color, 0.66) end; end; GLUserInterface1.MouseLook; GLUserInterface1.MouseUpdate; TIPickTimer.Enabled := True; Player_Cube.Position := Player_Capsule.Position; if Assigned(FPickedSceneObject) and Assigned(GetNGDDynamic(FPickedSceneObject)) and OnMouse_Click then begin GP3D.X := Player_Cube.AbsolutePosition.X + Player_Cube.AbsoluteDirection.X * -2; GP3D.Y := Player_Capsule.AbsolutePosition.Y + 1.6 + Player_Cam.AbsoluteDirection.Y; GP3D.Z := Player_Cube.AbsolutePosition.Z + Player_Cube.AbsoluteDirection.Z * -2; if (roundto((point3d.X), -3) <> roundto((GP3D.X), -3)) or (roundto((point3d.Y), -3) <> roundto((GP3D.Y), -3)) or (roundto((point3d.Z), -3) <> roundto(GP3D.Z, -3)) then begin GP3D.X := point3d.X - GP3D.X; GP3D.Y := point3d.Y - GP3D.Y; GP3D.Z := point3d.Z - GP3D.Z; NormalizeVector(GP3D); GotoPoint3d.X := point3d.X + GP3D.X * -6 * deltaTime; GotoPoint3d.Y := point3d.Y + GP3D.Y * -6 * deltaTime; GotoPoint3d.Z := point3d.Z + GP3D.Z * -6 * deltaTime; point3d := GotoPoint3d; end else begin GotoPoint3d.X := Player_Cube.AbsolutePosition.X + Player_Cube.AbsoluteDirection.X * -2; GotoPoint3d.Y := Player_Capsule.AbsolutePosition.Y + 1.6 + Player_Cam.AbsoluteDirection.Y; GotoPoint3d.Z := Player_Cube.AbsolutePosition.Z + Player_Cube.AbsoluteDirection.Z * -2; end; pickjoint.KinematicControllerPick(point3d, paMove); end; if IsKeyDown(VK_LBUTTON) then begin point3d := VectorMake(GLSceneViewer1.Buffer.PixelRayToWorld(cp.X, cp.Y)); if not(OnMouse_Click) and OnPick then begin FPickedSceneObject := GLSceneViewer1.Buffer.GetPickedObject(cp.X, cp.Y); if Assigned(FPickedSceneObject) then if FPickedSceneObject.DistanceTo(Player_Capsule) <= 3.5 then begin if Assigned(FPickedSceneObject) and Assigned(GetNGDDynamic(FPickedSceneObject)) and (FPickedSceneObject.Tag=1) then // If the user click on a glSceneObject begin // point3d is the global space point of the body to attach pickjoint.ParentObject := FPickedSceneObject; pickjoint.KinematicControllerPick(point3d, paAttach); OnMouse_Click := True; GotoPoint3d := point3d; On_Drop.Tag := 1; On_Drop.Enabled := True; end else FPickedSceneObject := nil; // We save the normal to create a plane parallel to camera in mouseMove Event. FPaneNormal := Player_Cam.AbsoluteDirection; end; end else begin if Assigned(FPickedSceneObject) and Assigned(GetNGDDynamic(FPickedSceneObject)) and OnDrop then begin pickjoint.KinematicControllerPick(point3d, paDetach); NGDDynamicBehav := nil; FPickedSceneObject := nil; OnMouse_Click := False; On_Drop.Tag := 0; On_Drop.Enabled := True; end; end; end; if Assigned(FPickedSceneObject) then begin ScObj := FPickedSceneObject; end; if not(OnMouse_Click) then begin // Detach the body if Assigned(NGDDynamicBehav) then begin Timer_OnVelocity.Enabled := True; end; end; if Assigned(FPickedSceneObject) and Assigned(GetNGDDynamic(FPickedSceneObject)) and IsKeyDown(VK_RBUTTON) then begin I:=Player_Cam.AbsoluteDirection; i.X:=I.X*20; i.Y:=I.Y*20; i.Z:=I.Z*20; with TGLNGDDynamic(FPickedSceneObject.Behaviours.GetByClass(TGLNGDDynamic)) do SetVelocity(I); pickjoint.KinematicControllerPick(point3d, paDetach); NGDDynamicBehav := nil; FPickedSceneObject := nil; OnMouse_Click:=false; On_Drop.Tag:=0; On_Drop.Enabled:=true; end; for j := 0 to Maps_Count - 1 do begin OnGround := maps[j].mdl.OctreeAABBIntersect (GLCube3.AxisAlignedBoundingBox(), GLCube3.AbsoluteMatrix, GLCube3.InvAbsoluteMatrix); if OnGround then break; end; if IsKeyDown(VK_SPACE) and OnGround and not(OnAir) then begin with TGLNGDDynamic(Player_Capsule.Behaviours.GetByClass(TGLNGDDynamic)) do begin I := Player_Cube.AbsoluteDirection; if IsKeyDown('w') then begin i.X:=-i.X*6; i.X:=10; i.X:=-i.Z*6; SetVelocity(i); end else SetVelocity(VectorMake(0,10,0)); OnGround := False; end; OnAir := True; Jump_Timer.Enabled := True; end; if Assigned(currentPick) then if currentPick.Material.FrontProperties.Emission.Color.X = 1 then begin GLHUDSprite1.Visible := True; end else begin GLHUDSprite1.Visible := False; end; if IsKeyDown('w') and OnGround and not(IsKeyDown(VK_SPACE)) then begin with TGLNGDDynamic(Player_Capsule.Behaviours.GetByClass(TGLNGDDynamic)) do begin I := Player_Cube.AbsoluteDirection; i.X:=-I.X*4; i.Y:=AppliedVelocity.y; i.Z:=-I.Z*4; SetVelocity(i); end; end; if IsKeyDown('s') and OnGround then begin with TGLNGDDynamic(Player_Capsule.Behaviours.GetByClass(TGLNGDDynamic)) do begin I := Player_Cube.AbsoluteDirection; i.X:=I.X*4; i.Y:=AppliedVelocity.y; i.Z:=I.Z*4; SetVelocity(i); end; end; if IsKeyDown('a') and OnGround then begin with TGLNGDDynamic(Player_Capsule.Behaviours.GetByClass(TGLNGDDynamic)) do begin I := Player_Cam.AbsoluteRight; i.X:=I.X*4; i.Y:=AppliedVelocity.y; i.Z:=I.Z*4; SetVelocity(i); end; end; if IsKeyDown('d') and OnGround then begin with TGLNGDDynamic(Player_Capsule.Behaviours.GetByClass(TGLNGDDynamic)) do begin I := Player_Cam.AbsoluteLeft; i.X:=I.X*4; i.Y:=AppliedVelocity.y; i.Z:=I.Z*4; SetVelocity(i); end; end; if IsKeyDown('d') and IsKeyDown('w') and OnGround then begin with TGLNGDDynamic(Player_Capsule.Behaviours.GetByClass(TGLNGDDynamic)) do begin I := VectorAdd(Player_Cube.AbsoluteLeft, Player_Cube.AbsoluteDirection); i.X:=-I.X*4; i.Y:=AppliedVelocity.y; i.Z:=-I.Z*4; SetVelocity(i); end; end; if IsKeyDown('a') and IsKeyDown('w') and OnGround then begin with TGLNGDDynamic(Player_Capsule.Behaviours.GetByClass(TGLNGDDynamic)) do begin I := VectorAdd(Player_Cube.AbsoluteRight, Player_Cube.AbsoluteDirection); i.X:=-I.X*4; i.Y:=AppliedVelocity.y; i.Z:=-I.Z*4; SetVelocity(i); end; end; if IsKeyDown('a') and IsKeyDown('s') and OnGround then begin with TGLNGDDynamic(Player_Capsule.Behaviours.GetByClass(TGLNGDDynamic)) do begin I := VectorAdd(Player_Cube.AbsoluteLeft, Player_Cube.AbsoluteDirection); i.X:=I.X*4; i.Y:=AppliedVelocity.y; i.Z:=I.Z*4; SetVelocity(i); end; end; if IsKeyDown('d') and IsKeyDown('s') and OnGround then begin with TGLNGDDynamic(Player_Capsule.Behaviours.GetByClass(TGLNGDDynamic)) do begin I := VectorAdd(Player_Cube.AbsoluteRight, Player_Cube.AbsoluteDirection); i.X:=I.X*4; i.Y:=AppliedVelocity.y; i.Z:=I.Z*4; SetVelocity(i); end; end; GLSceneViewer1.Invalidate; GLNGDManager1.Step(deltaTime); if Player_Capsule.Position.Y < -10 then begin with TGLNGDDynamic(Player_Capsule.Behaviours.GetByClass(TGLNGDDynamic)) do begin mm := NewtonBodyMatrix; mm.W := VectorMake(0, 0, 0, 1); NewtonBodyMatrix := mm; end; end; if IsKeyDown(VK_ESCAPE) then close; end; procedure TFormNewtonWalkCarry.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin M_X := X; M_Y := Y; end; procedure TFormNewtonWalkCarry.Menu_Load; begin FormNewtonWalkCarry.Width := 1280; FormNewtonWalkCarry.Height := 1024; GLHUDSprite1.Position.X := 640; GLHUDSprite1.Position.Y := 512; GLSceneViewer1.Height := 1024; GLSceneViewer1.Width := 1280; (* GLMaterialLibrary1.AddTextureMaterial('brick_b','brick_b.jpg'); with GLMaterialLibrary1.Materials.GetLibMaterialByName('brick_b') do begin Material.Texture.Disabled:=false; end; GLMaterialLibrary1.AddTextureMaterial('mat1','Finishes.jpg'); with GLMaterialLibrary1.Materials.GetLibMaterialByName('mat1') do begin Material.Texture.Disabled:=false; end; *) pickjoint := TGLNGDJoint(GLNGDManager1.NewtonJoint.Items[1]); OnPick := True; GLUserInterface1.MouseLookActivate; Game_Load; end; procedure TFormNewtonWalkCarry.Game_Load; var X, j, dyns: Integer; Models: string; PX, PY, PZ: Integer; RX, RY, RZ: Integer; DX, DY, DZ: Integer; Nam, end1, end2: Integer; b_ti1, b_ti2, b_ti3, ML_col: Integer; begin var Path: TFileName := GetCurrentAssetPath(); // Memo1.Lines.Clear; // memo1.Lines.LoadFromFile('level.txt'); SetLength(maps, Memo1.Lines.Count); For X := 0 to Memo1.Lines.Count - 1 do begin if copy(Memo1.Lines.Strings[X], 0, 8) = '[Model]=' then begin Models := Memo1.Lines.Strings[X]; for j := 0 to Length(Models) do begin if copy(Models, j, 3) = 'PX_' then PX := j + 3; if copy(Models, j, 3) = 'PY_' then PY := j + 3; if copy(Models, j, 3) = 'PZ_' then PZ := j + 3; if copy(Models, j, 3) = 'RX_' then RX := j + 3; if copy(Models, j, 3) = 'RY_' then RY := j + 3; if copy(Models, j, 3) = 'RZ_' then RZ := j + 3; if copy(Models, j, 3) = 'DX_' then DX := j + 3; if copy(Models, j, 3) = 'DY_' then DY := j + 3; if copy(Models, j, 3) = 'DZ_' then DZ := j + 3; if copy(Models, j, 7) = '[Name]=' then Nam := j + 7; if copy(Models, j, 10) = '[Dynamic]=' then dyns := j + 10; if copy(Models, j, 1) = ':' then end1 := j - 1; if copy(Models, j, 3) = 'DM=' then b_ti1 := j + 3; if copy(Models, j, 3) = 'NM=' then b_ti2 := j + 3; if copy(Models, j, 3) = 'LM=' then b_ti3 := j + 3; if copy(Models, j, 1) = ';' then end2 := j - 1; end; if StrToBool(copy(Models, dyns, b_ti1 - dyns - 4 { end1-dyns+1 } )) = False then begin with maps[X] do begin mdl := TGLFreeForm.CreateAsChild(Scene_Objects); mdl.MaterialLibrary := GLMaterialLibrary1; mdl.LoadFromFile(copy(Models, Nam, dyns - Nam - 10)); mdl.Position.X := StrToFloat(copy(Models, PX, PY - PX - 3)); mdl.Position.Y := StrToFloat(copy(Models, PY, PZ - PY - 3)); mdl.Position.Z := StrToFloat(copy(Models, PZ, RX - PZ - 3)); mdl.RollAngle := StrToFloat(copy(Models, RX, RY - RX - 3)); mdl.TurnAngle := StrToFloat(copy(Models, RY, RZ - RY - 3)); mdl.PitchAngle := StrToFloat(copy(Models, RZ, DX - RZ - 3)); mdl.Direction.X := StrToFloat(copy(Models, DX, DY - DX - 3)); mdl.Direction.Y := StrToFloat(copy(Models, DY, DZ - DY - 3)); mdl.Direction.Z := StrToFloat(copy(Models, DZ, Nam - DZ - 7)); mdl.BuildOctree(); mdl.Behaviours.GetOrCreate(TGLNGDStatic); Maps_Count := Maps_Count + 1; with TGLNGDStatic(mdl.Behaviours.GetByClass(TGLNGDStatic)) do begin Manager:=GLNGDManager1; NGDNewtonCollisions:=nc_Tree; end; end; end else begin with maps[X] do begin mdl := TGLFreeForm.CreateAsChild(Scene_Objects); mdl.LoadFromFile(copy(Models, Nam, dyns - Nam - 10)); mdl.Position.X := StrToFloat(copy(Models, PX, PY - PX - 3)); mdl.Position.Y := StrToFloat(copy(Models, PY, PZ - PY - 3)); mdl.Position.Z := StrToFloat(copy(Models, PZ, RX - PZ - 3)); mdl.RollAngle := StrToFloat(copy(Models, RX, RY - RX - 3)); mdl.TurnAngle := StrToFloat(copy(Models, RY, RZ - RY - 3)); mdl.PitchAngle := StrToFloat(copy(Models, RZ, DX - RZ - 3)); mdl.Direction.X := StrToFloat(copy(Models, DX, DY - DX - 3)); mdl.Direction.Y := StrToFloat(copy(Models, DY, DZ - DY - 3)); mdl.Direction.Z := StrToFloat(copy(Models, DZ, Nam - DZ - 7)); Maps_Count := Maps_Count + 1; mdl.Behaviours.GetOrCreate(TGLNGDDynamic); with TGLNGDDynamic(mdl.Behaviours.GetByClass(TGLNGDDynamic)) do begin Manager:=GLNGDManager1; NGDNewtonCollisions:=nc_Mesh; Density:=1; //NGDSurfaceItem:=GLNGDManager1.NewtonSurfaceItem.Items[3] as TNGDSurfaceItem; end; mdl.Tag := 1; mdl.OnProgress := GLCube2.OnProgress; mdl.BuildOctree(); end; end; end; end; end; procedure TFormNewtonWalkCarry.Jump_TimerTimer(Sender: TObject); begin OnAir := False; Jump_Timer.Enabled := False; end; procedure TFormNewtonWalkCarry.On_DropTimer(Sender: TObject); begin if On_Drop.Tag = 1 then begin OnDrop := True; OnPick := False; On_Drop.Enabled := False; end else begin OnDrop := False; OnPick := True; On_Drop.Enabled := False; end; end; procedure TFormNewtonWalkCarry.Timer_OnVelocityTimer(Sender: TObject); begin pickjoint.KinematicControllerPick(point3d,paDetach); NGDDynamicBehav := nil; FPickedSceneObject := nil; Timer_OnVelocity.Enabled := False; On_Drop.Tag := 0; On_Drop.Enabled := True; end; procedure TFormNewtonWalkCarry.TIPickTimerTimer(Sender: TObject); var cp: TPoint; begin GetCursorPos(cp); cp := GLSceneViewer1.ScreenToClient(cp); currentPick := (GLSceneViewer1.Buffer.GetPickedObject(cp.X, cp.Y) as TGLCustomSceneObject); TIPickTimer.Enabled := False; end; end.