LINUX.ORG.RU

История изменений

Исправление redgremlin, (текущая версия) :

даже если текстуры не рисовать

Их никто и не рисовал.

давай архив

Нихачу, там быдлокод :) Типа такого (для справки - race_draw - 306 строк, race_physics - 285): 

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.

Исправление redgremlin, :

даже если текстуры не рисовать

Их никто и не рисовал.

давай архив

Нихачу, там быдлокод :) Типа такого (для справки - race_draw - 306 строк, race_physics - 285): 

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;
  m:=ATime mod 3600000;
  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.

Исходная версия redgremlin, :

даже если текстуры не рисовать

Их никто и не рисовал.

давай архив

Нихачу, там быдлокод :) Типа такого (race_draw - 206 строк, race_physics - 285): 

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;
  m:=ATime mod 3600000;
  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.