zengl/Zengl_SRC/demos/FreePascal/16 - Physics/demo16.pas

program demo16;

// RU: В этом файле конфигурации содержится "опция" USE_CHIPMUNK_STATIC для статической компиляции с Chipmunk
// EN: This file contains "option" USE_CHIPMUNK_STATIC for static compilation with Chipmunk
{$I zglCustomConfig.cfg}

{$I zgl_config.cfg}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  zglChipmunk,
  {$IFDEF USE_ZENGL_STATIC}
  zgl_screen,
  zgl_window,
  zgl_timers,
  zgl_keyboard,
  zgl_mouse,
  zgl_textures,
  zgl_textures_png,
  zgl_render_2d,
  zgl_font,
  zgl_text,
  zgl_primitives_2d,
  zgl_math_2d,
  zgl_types,
  zgl_utils
  {$ELSE}
  zglHeader
  {$ENDIF}
  ;

var
  dirRes  : UTF8String {$IFNDEF MACOSX} = '../data/' {$ENDIF};
  fntMain : Byte;
  space   : PcpSpace;
  bCount  : Integer;
  Bodies  : array of PcpBody;
  Shapes  : array of PcpShape;

  TimePhisics: Byte;

// RU: Добавить объект "шар"
//     x, y - координаты центра
//     mass - масса
//     r    - радиус
//     e    - коэффициент эластичности
//     u    - коэффициент трения
//
// EN: Add new object "ball"
//     x, y - coordinates
//     mass - mass
//     r    - radius
//     e    - coefficient of restitution. (elasticity)
//     u    - coefficient of friction
procedure cpAddBall(x, y, r, mass, e, u : cpFloat);
begin
  INC(bCount);
  SetLength(Bodies, bCount);
  SetLength(Shapes, bCount);

  Bodies[bCount - 1]   := cpBodyNew(mass, cpMomentForCircle(mass, 0, r, cpvzero));
  Bodies[bCount - 1]^.p := cpv(x, y);
  cpSpaceAddBody(space, Bodies[bCount - 1]);

  Shapes[bCount - 1]   := cpCircleShapeNew(Bodies[bCount - 1], r, cpvzero);
  Shapes[bCount - 1]^.e := e;
  Shapes[bCount - 1]^.u := u;
  cpSpaceAddShape( space, Shapes[ bCount - 1 ] );
end;

// RU: Добавить объект "коробка"
//     Схож с процедурой cpAddBall по аргументам
//     x, y - координаты центра
//     w, h - ширина и высота
//
// EN: Add bew object "box"
//     Arguments are similar to arguments of procedure cpAddBall
//     x, y - coordinates of center
//     w, h - width and height
procedure cpAddBox(x, y, w, h, mass, e, u : cpFloat);
  var
    points : array[0..3] of cpVect;
    f      : cpFloat;
begin
  INC(bCount);
  SetLength(Bodies, bCount);
  SetLength(Shapes, bCount);

  points[0].x := - w / 2;
  points[0].y := - h / 2;
  points[1].x := - w / 2;
  points[1].y := h / 2;
  points[2].x := w / 2;
  points[2].y := h / 2;
  points[3].x := w / 2;
  points[3].y := - h / 2;

  f := cpMomentForPoly(mass, 4, @points[0], cpvzero);
  Bodies[bCount - 1]   := cpBodyNew(mass, f);
  Bodies[bCount - 1]^.p := cpv(x + w / 2, y + h / 2);
  cpSpaceAddBody(space, Bodies[bCount - 1]);

  Shapes[bCount - 1] := cpPolyShapeNew(Bodies[bCount - 1], 4, @points[0], cpvzero);
  Shapes[bCount - 1]^.e := e;
  Shapes[bCount - 1]^.u := u;
  cpSpaceAddShape(space, Shapes[bCount - 1]);
end;

procedure Init;
  var
    staticBody : PcpBody;
    ground     : PcpShape;
    e, u       : cpFloat;
begin
  fntMain := font_LoadFromFile(dirRes + 'font.zfi');
  setFontTextScale(15, fntMain);

  cpInitChipmunk();

  // RU: Создаем новый "мир".
  // EN: Create new world.
  space            := cpSpaceNew();
  // RU: Задаем количество итераций обработки(рекомендуется 10).
  // EN: Set count of iterations of processing(recommended is 10).
  space^.iterations := 10;
  space^.elasticIterations := 10;
  // RU: Задаем силу гравитации.
  // EN: Set the gravity.
  space^.gravity    := cpv(1, 100);
  // RU: Задаем коэффициент "затухания" движения объектов.
  // EN: Set the damping for moving of objects.
  space^.damping    := 0.99;

  e := 1;
  u := 0.9;
  // RU: Создадим статичное "тело".
  // EN: Create a static "body".
  staticBody := cpBodyNew(INFINITY, INFINITY);
  // RU: Добавим три отрезка для ограничения мира. Первый параметр - указатель на созданное тело, два последующих - координаты точек отрезка, последний - толщина отрезка.
  // EN: Add three segments for restriction of world. First parameter - pointer of created body, next two - coordinates of segment points, the last one - width of segment.
  ground := cpSegmentShapeNew(staticBody, cpv(5, 0), cpv(5, 590), 1);
  ground^.e := e;
  ground^.u := u;
  cpSpaceAddStaticShape(space, ground );
  ground := cpSegmentShapeNew(staticBody, cpv(795, 0), cpv(795, 590), 1);
  ground^.e := e;
  ground^.u := u;
  cpSpaceAddStaticShape(space, ground);
  ground := cpSegmentShapeNew(staticBody, cpv(0, 590), cpv(800, 590), 1);
  ground^.e := e;
  ground^.u := u;
  cpSpaceAddStaticShape(space, ground);
  // RU: Добавим треугольник.
  // EN: Add the triangle.
  staticBody := cpBodyNew(INFINITY, INFINITY);
  ground := cpSegmentShapeNew(staticBody, cpv(400, 300), cpv(200, 350), 1);
  ground^.e := e;
  ground^.u := u;
  cpSpaceAddStaticShape(space, ground);
  ground := cpSegmentShapeNew(staticBody, cpv(200, 350), cpv(700, 350), 1);
  ground^.e := e;
  ground^.u := u;
  cpSpaceAddStaticShape(space, ground);
  ground := cpSegmentShapeNew(staticBody, cpv(700, 350), cpv(400, 300), 1);
  ground^.e := e;
  ground^.u := u;
  cpSpaceAddStaticShape(space, ground);
end;

procedure Draw;
begin
  batch2d_Begin();

  // RU: Рендерим объекты указанного "мира". Второй аргумент функции отвечает за показ точек соприкосновения.
  // EN: Render objects for specified "world". Second argument responsible for rendering of collision points.
  cpDrawSpace(space, TRUE);

  text_Draw(fntMain, 10, 5,  'FPS: ' + u_IntToStr(zgl_Get(RENDER_FPS)));
  text_Draw(fntMain, 10, 25, 'Use your mouse: Left Click - box, Right Click - ball');
  batch2d_End();
end;

procedure KeyMouseEvent;
begin
  // два варианта работы с мышью, статический и динамический
  if (mouseAction[M_BLEFT].state and is_down) > 0 Then
    cpAddBox(mouseX - 10, mouseY - 10, 48, 32, 1, 0.5, 0.5);

  if mouseBClick(M_BRIGHT) Then
    cpAddBall(mouseX, mouseY, 16, 2, 0.5, 0.1);
end;

procedure Phisics;
begin
  cpSpaceStep(space, 1 / zgl_Get(RENDER_FPS));
end;

procedure Quit;
begin
  // RU: Очистка объектов и "мира".
  // EN: Free objects and "world".
  cpSpaceFreeChildren(space);
  cpSpaceFree(space);
end;

Begin
  randomize();

  {$IFNDEF USE_ZENGL_STATIC}
  if not zglLoad( libZenGL ) Then exit;
  {$ENDIF}
  {$IFNDEF USE_CHIPMUNK_STATIC}
  if not cpLoad( libChipmunk ) Then exit;
  {$ENDIF}

  TimePhisics := timer_Add(@Phisics, 16, t_Start);

  zgl_Reg(SYS_EVENTS, @KeyMouseEvent);
  zgl_Reg(SYS_LOAD, @Init);
  zgl_Reg(SYS_DRAW, @Draw);
  zgl_Reg(SYS_EXIT, @Quit);

  wnd_SetCaption(utf8_Copy('16 - Physics Simple'));

  zgl_Init();
End.