Графика
October 20, 2022

3D-бродилка на PascalABC.NET

Как написать простую 3D-бродилку в лабиринте от первого лица на PascalABC.NET? И потратить на это менее 100 строк кода?

Только код:

uses Graph3D;

var 
  w := 20;
  h := 2;
  wallthickness := 0.4;
  m := Materials.Image('brick-texture.jpg',0.1,2);
  mground := Materials.Image('ground.jpg',0.05,0.1);

procedure HorizWall(x,y,len: real) := 
  Box(x-len/2,y,h/2,len,wallthickness,h,m);

procedure VertWall(x,y,len: real) := 
  Box(x,y-len/2,h/2,wallthickness,len,h,m);

procedure Ground(x,y,xsz,ysz: real) := 
  Box(x-xsz/2,y-ysz/2,0.05,xsz,ysz,0.1,mground);

procedure InitLabyrinth;
begin
  HorizWall(24,16,48);
  HorizWall(24,-16,48);
  VertWall(24,16,32);
  VertWall(-24,16,32);

  VertWall(16,16,24);
  VertWall(8,8,24);
  VertWall(0,16,24);
  VertWall(-8,8,24);
  VertWall(-16,16,24);
  
  Ground(24,16,48,32);
end;

begin
  Window.Title := 'Бродилка в лабиринте';
  View3D.ShowCoordinateSystem := False;
  InitLabyrinth;
  
  GridLines.Length := 48;
  GridLines.Width := 32;
  Camera.Position := P3D(20,12,1.5);
  Camera.LookDirection := V3D(0,-1,0);
  //Camera.Position := Camera.Position * 2.6;
  
  Invoke (()->begin
    hvp.ShowCameraInfo := True;
    hvp.Camera.NearPlaneDistance := 0.01;
    hvp.CameraController.IsZoomEnabled := False;
  end);
  
  var v,rv: real;
  
  OnDrawFrame := dt -> begin
    if (v=0) and (rv = 0) then
      exit;
    
    var dv := Camera.LookDirection * v * dt;

    if v>0 then
    begin
      var p := FindNearestObjectPoint(400,300);
      if p = BadPoint then
        exit;
      var p1 := Camera.Position;
      var DistanceToWall := p.DistanceTo(p1); 
        // расстояние до ближайшей стены. 
        // Должно быть больше |v * dt|
      if (dv.Length + 0.3 >= DistanceToWall) and (v>0) then
        exit;
    end;

    dv.Z := 0;
    if v <> 0 then  
      Camera.MoveBy(dv); 
    if rv <> 0 then   
      Camera.Rotate(OrtZ,rv*dt*50);
  end;
  
  OnKeyDown := k -> begin
    case k of
  Key.W,Key.Up: v := 10;
  Key.S,Key.Down: v := -10;
  Key.D,Key.Right: rv := 1;
  Key.A,Key.Left: rv := -1;
    end;
  end; 
  
  OnKeyUp := k -> begin
    v := 0; rv := 0;
  end;
end.

И результат:

Управление - только клавиатурой.

92 строки - неплохо!

Отдельно - текстуры:

ground.jpg
brick-texture.jpg

Недостатки:

  • Нет комментариев
  • Нельзя управлять мышью - надо дорабатывать проект
  • При движении назад игрок проходит через стены