Скриншот pre-alpha версии инди FPS шутера

unit UMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, AppEvnts, OpenGL, Math, race_physics, race_draw;


type
  TForm1 = class(TForm)
    ApplicationEvents1: TApplicationEvents;
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormPaint(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    glrc: HGLRC;
    Textures: array [0..2] of GLubyte;
    Track: TTrack;
    Auto: TAuto;
    Draw: TDrawer;
    Closed: Boolean;
  public
    procedure SetPixFmt(DC: HDC);
  end;


var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SetPixFmt(DC: HDC);
var
  pfd: TPixelFormatDescriptor;
  i: Integer;
begin
  FillChar(pfd, SizeOf(pfd), 0);
  pfd.dwFlags:=PFD_DOUBLEBUFFER or PFD_SUPPORT_OPENGL;
  i:=ChoosePixelFormat(DC, @pfd);
  SetPixelFormat(DC, i, @pfd);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Draw.Prepare(0, 0, ClientWidth, ClientHeight);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SetPixFmt(Canvas.Handle);
  glrc:=wglCreateContext(Canvas.Handle);
  wglMakeCurrent(Canvas.Handle, glrc);

  Track:=TTrack.Create;
  Track.LoadFromFile('Tracks\Track0');
  
  Auto:=TAuto.Create(
    ControlOptions(10.0, 3.0, 3.0, 50.0, 1.0, 0.1, 0.04, 0.3, 0.4, 0.15),
    Track, TrackPoint(0, 1.0, 0), TrackPoint(AutoLength, 1.0, 0)
  );

  Draw:=TDrawer.Create(Track, Auto);
end;

function MTimeToStr(ATime: Cardinal): string;
var
  h, m, s, ms: Cardinal;
begin
  ms:=ATime mod 1000;
  s:=(ATime mod 60000 - ms) div 60;
  m:=(ATime mod 3600000 - s*60000 - ms) div 3600;
  h:=ATime div 60;
  Result:=Format('%2.2d:%2.2d:%2.2d.%3.3d', [h, m, s, ms]);
end;

procedure TForm1.ApplicationEvents1Idle(Sender: TObject;  var Done: Boolean);
var
  i: Integer;
  frametime, oldframetime, laptime, besttime, curtime, oldlaptime: Cardinal;
  Laps, TotalTime: Cardinal;
begin
  Closed:=False;
  frametime:=GetTickCount;
  oldframetime:=frametime;
  laptime:=GetTickCount;
  besttime:=100000;
  curtime:=0;
  i:=0;
  Laps:=10;
  TotalTime:=0;
while True do begin
  Application.ProcessMessages;
  if Closed then begin
    Track.Free;
    Auto.Free;
    glDeleteLists(Textures[0], 2);
    Exit;
  end;
  Auto.DoTick;
  FormPaint(nil);
  Inc(i);
  if i=10 then begin
    oldframetime:=frametime;
    frametime:=GetTickCount;
    i:=0;
  end;
  Canvas.TextOut(10, 40, FloatToStrF(10000/(frametime-oldframetime), ffFixed, 3, 1));
  if ((Auto.FrontPoint.Y-1)<1) and ((Auto.FrontPoint.X)<0.001) then begin
    oldlaptime:=laptime;
    laptime:=GetTickCount;
    if (laptime-oldlaptime)>1000 then begin
      if (laptime-oldlaptime)<besttime then
        besttime:=laptime-oldlaptime;
      curtime:=laptime-oldlaptime;
      Dec(Laps);
      Inc(TotalTime, CurTime);
    end;
  end;
  Canvas.TextOut(300, 40, FloatToStr((curtime)/1000));
  Canvas.TextOut(300, 60, FloatToStr(besttime/1000));
  Canvas.TextOut(200, 80, 'Laps '+IntToStr(Laps));
  Canvas.TextOut(400, 80, 'Time: '+MTimeToStr(TotalTime));
end end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Closed:=True;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  wglMakeCurrent(0, 0);
  wglDeleteContext(glrc);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Draw.Draw;
  SwapBuffers(Canvas.Handle);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_LEFT: Auto.DoTurn(tsLeft);
    VK_RIGHT: Auto.DoTurn(tsRight);
    VK_UP: Auto.DoAccelerate;
    VK_DOWN: Auto.DoBrake;
  end;
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_LEFT: Auto.StopTurning;
    VK_RIGHT: Auto.StopTurning;
    VK_UP: Auto.StopAccelerate;
    VK_DOWN: Auto.StopBrake;
  end;
end;

end.

unit race_physics;

interface
uses SysUtils, OpenGL, Math, UniIO, ExtObjs, Windows;

type
  TTrackPoint = record
    X, Y, Z: GLfloat;
  end;

  TTrackLine = record
    X1, Y1, Z1: GLfloat;
    X2, Y2, Z2: GLfloat;
  end;

  TTrack = class (TObject)
  private
    FTrack: array of TTrackLIne;
    FLB: array of TTrackLine;
    FRB: array of TTrackLine;
    FTrackCount: Integer;
    FLBCount: Integer;
    FRBCount: Integer;
    function GetLB(Index: Integer): TTrackLine;
    function GetRB(Index: Integer): TTrackLine;
    function GetTrack(Index: Integer): TTrackLine;
  public
    constructor Create;

    procedure LoadFromFile(const FileName: string);
    property Track[Index: Integer]: TTrackLine read GetTrack;
    property LeftBorder[Index: Integer]: TTrackLine read GetLB;
    property RightBorder[Index: Integer]: TTrackLine read GetRB;
    property TrackLinesCount: Integer read FTrackCount;
    property LeftBorderLinesCount: Integer read FLBCount;
    property RightBorderLinesCount: Integer read FRBCount;
  end;

  TControlOptions = record
    MaxSpeed: GLfloat;
    Acceleration: GLfloat;
    Brake: GLfloat;
    Ac: GLfloat;
    dAc: GLfloat;
    DecSpeed: GLfloat;
    DecSpeedMin: GLfloat;
    MaxTurn: GLfloat;
    DecTurn: GLfloat;
    AddTurn: GLfloat;
  end;
  TTurnSide = (tsLeft, tsRight);

  TAuto = class (TObject)
  private
    FTrack: TTrack;
    FOptions: TControlOptions;
    FSpeed: GLfloat;
    FAngle: GLfloat;
    FTurnAngle: GLfloat;
    FTurning: Boolean;
    FTurnSide: TTurnSide;
    FAccelerating: Boolean;
    FBraking: Boolean;
    FRearPos: TTrackPoint;
    FFrontPos: TTrackPoint;
    FLastTick: Cardinal;
    //optimization
    l: GLfloat;
    procedure SetTrack(const Value: TTrack);
  public
    constructor Create(Options: TControlOptions; ATrack: TTrack; RearPos, FrontPos: TTrackPoint);

    procedure DoTick;
    procedure DoTurn(TurnSide: TTurnSide);
    procedure DoAccelerate;
    procedure DoBrake;
    procedure StopTurning;
    procedure StopAccelerate;
    procedure StopBrake;

    property Speed: GLfloat read FSpeed;
    property IsBraking: Boolean read FBraking;
    property IsAccelerating: Boolean read FAccelerating;
    property IsTurning: Boolean read FTurning;
    property RearPoint: TTrackPoint read FRearPos;
    property FrontPoint: TTrackPoint read FFrontPos;
    property Track: TTrack read FTrack write SetTrack;
  end;

function TrackPoint(const X,Y,Z: GLfloat): TTrackPoint;
function ControlOptions(const MaxSpeed, Acceleration, Brake, Ac, dAc, DecSpeed, DecSpeedMin, MaxTurn, DecTurn, AddTurn: GLfloat): TControlOptions;

implementation

{ TTrack }

constructor TTrack.Create;
begin
  inherited;

  FLBCount:=0;
  FRBCount:=0;
  FTrackCount:=0;
end;

function TTrack.GetLB(Index: Integer): TTrackLine;
begin
  Result:=FLB[Index mod FLBCount];
end;

function TTrack.GetRB(Index: Integer): TTrackLine;
begin
  Result:=FRB[Index mod FRBCount];
end;

function TTrack.GetTrack(Index: Integer): TTrackLine;
begin
  Result:=FTrack[Index mod FTrackCount];
end;

procedure TTrack.LoadFromFile(const FileName: string);
var
  inf: TStreamIniFile;
  inf_ios, sub_ios: TIOStream;
  sub_trk, sub_lb, sub_rb: string;
  i: Integer;
begin
  inf_ios:=TIOStream.Create(FileName+'\track.info', fmOpenRead);
  inf:=TStreamIniFile.Create(inf_ios);

  FTrackCount:=inf.ReadInteger('Layout', 'TrackLinesCount', 0);
  FLBCount:=inf.ReadInteger('Layout', 'LeftBorderLinesCount', 0);
  FRBCount:=inf.ReadInteger('Layout', 'RightBorderLinesCount', 0);
  sub_trk:=inf.ReadString('Layout', 'TrackLayoutFile', '');
  sub_lb:=inf.ReadString('Layout', 'LeftBorderLayoutFile', '');
  sub_rb:=inf.ReadString('Layout', 'RightBorderLayoutFile', '');

  sub_ios:=TIOStream.Create(FileName+'\'+sub_trk, fmOpenRead);
    SetLength(FTrack, FTrackCount);
    for i:=0 to FTrackCount-1 do
      sub_ios.Read(FTrack[i], SizeOf(TTrackLine));
  sub_ios.Free;
  sub_ios:=TIOStream.Create(FileName+'\'+sub_lb, fmOpenRead);
    SetLength(FLB, FLBCount);
    for i:=0 to FLBCount-1 do
      sub_ios.Read(FLB[i], SizeOf(TTrackLine));
  sub_ios.Free;
  sub_ios:=TIOStream.Create(FileName+'\'+sub_rb, fmOpenRead);
    SetLength(FRB, FRBCount);
    for i:=0 to FRBCount-1 do
      sub_ios.Read(FRB[i], SizeOf(TTrackLine));
  sub_ios.Free;

  inf.Free;
  inf_ios.Free;
end;

{ TAuto }

constructor TAuto.Create(Options: TControlOptions; ATrack: TTrack; RearPos, FrontPos: TTrackPoint);
begin
  FOptions:=Options;
  FTrack:=ATrack;
  FSpeed:=0;
  FAngle:=0;
  FTurnAngle:=0;
  FTurning:=False;
  FAccelerating:=False;
  FBraking:=False;
  FRearPos:=RearPos;
  FFrontPos:=FrontPos;
  FLastTick:=0;
end;

procedure TAuto.DoAccelerate;
begin
  FAccelerating:=True;
end;

procedure TAuto.DoBrake;
begin
  FBraking:=True;
end;

procedure TAuto.DoTick;
var
  dt: GLfloat;
  dl, dx, dy, decsp: GLfloat;
  fi: GLfloat;
  AMaxTurn: GLfloat;
begin
  if FLastTick=0 then begin
    l:=Sqrt(Sqr(FRearPos.X-FFrontPos.X)+Sqr(FRearPos.Y-FFrontPos.Y));
    FLastTick:=GetTickCount;
    Exit;
  end;
  dt:=(GetTickCount-FLastTick)/1000;
  if dt<0.001 then
    Exit;

  dl:=FSpeed*dt;

  dx:=(FFrontPos.X-FRearPos.X)*dl/l;
  dy:=(FFrontPos.Y-FRearPos.Y)*dl/l;
  with FRearPos do begin
    X:=X+dx;
    Y:=Y+dy;
  end;
  with FFrontPos do begin
    X:=X+dx;
    Y:=Y+dy;
  end;
  if FTurnAngle<>0 then with FFrontPos do begin
    fi:=FTurnAngle-ArcSin((l-dl)/l*sin(FTurnAngle));
    dy:=(X-FRearPos.X)*sin(fi)+(Y-FRearPos.Y)*cos(fi);
    dx:=(X-FRearPos.X)*cos(fi)-(Y-FRearPos.Y)*sin(fi);
    X:=FRearPos.X+dx;
    Y:=FRearPos.Y+dy;
  end;

  AMaxTurn:=Min(FOptions.MaxTurn, dt*(FOptions.Ac+FOptions.dAc*FSpeed)/FSpeed);

  decsp:=Max(FOptions.DecSpeed*FSpeed*dt, FOptions.DecSpeedMin*dt);
  if FAccelerating then
    FSpeed:=FSpeed+FOptions.Acceleration*dt
  else if FBraking then
    FSpeed:=FSpeed-FOptions.Brake*dt
  else if FSpeed>decsp then
    FSpeed:=FSpeed-decsp
  else
    FSpeed:=0;
  if FSpeed<0 then
    FSpeed:=0;
  if FSpeed>FOptions.MaxSpeed then
    FSpeed:=FOptions.MaxSpeed;

  if FTurning then
    if FTurnSide=tsLeft then
      if FTurnAngle>-AMaxTurn then
        FTurnAngle:=FTurnAngle-FOptions.AddTurn*dt
      else
        FTurnAngle:=-AMaxTurn
    else
      if FTurnAngle<AMaxTurn then
        FTurnAngle:=FTurnAngle+FOptions.AddTurn*dt
      else
        FTurnAngle:=AMaxTurn
  else
    if FTurnAngle>FOptions.DecTurn*dt then
      FTurnAngle:=FTurnAngle-FOptions.DecTurn*dt
    else if FTurnAngle<(-FOptions.DecTurn*dt) then
      FTurnAngle:=FTurnAngle+FOptions.DecTurn*dt
    else
      FTurnAngle:=0;
  FLastTick:=GetTickCount;
end;

procedure TAuto.DoTurn(TurnSide: TTurnSide);
begin
  FTurning:=True;
  FTurnSide:=TurnSide;
end;

procedure TAuto.SetTrack(const Value: TTrack);
begin
  FTrack := Value;
end;

function TrackPoint(const X,Y,Z: GLfloat): TTrackPoint;
begin
  Result.X:=X;
  Result.Y:=Y;
  Result.Z:=Z;
end;

function ControlOptions(const MaxSpeed, Acceleration, Brake, Ac, dAc, DecSpeed, DecSpeedMin, MaxTurn, DecTurn, AddTurn: GLfloat): TControlOptions;
begin
  Result.MaxSpeed:=MaxSpeed;
  Result.Acceleration:=Acceleration;
  Result.Brake:=Brake;
  Result.Ac:=Ac;
  Result.dAc:=dAc;
  Result.DecSpeed:=DecSpeed;
  Result.DecSpeedMin:=DecSpeedMin;
  Result.MaxTurn:=MaxTurn;
  Result.DecTurn:=DecTurn;
  Result.AddTurn:=AddTurn;
end;

procedure TAuto.StopAccelerate;
begin
  FAccelerating:=False;
end;

procedure TAuto.StopBrake;
begin
  FBraking:=False;
end;

procedure TAuto.StopTurning;
begin
  FTurning:=False;
end;

end.