bin/Lib/OpenGLABC.pas - master - n-dimens/pascalabcnet

bin/Lib/OpenGLABC.pas
110 строк4 KB
Sun Serega
POCGL update
25 мар 2022, 14:27
25 мар 2022, 14:27d2fdeb8
//*****************************************************************************************************\\
// Copyright (©) Sergey Latchenko ( github.com/SunSerega | forum.mmcs.sfedu.ru/u/sun_serega )
// This code is distributed under the Unlicense
// For details see LICENSE file or this:
// https://github.com/SunSerega/POCGL/blob/master/LICENSE
//*****************************************************************************************************\\
// Copyright (©) Сергей Латченко ( github.com/SunSerega | forum.mmcs.sfedu.ru/u/sun_serega )
// Данный код распространяется с лицензией Unlicense
// Подробнее в файле LICENSE или тут:
// https://github.com/SunSerega/POCGL/blob/master/LICENSE
//*****************************************************************************************************\\

///
///Модуль, зарезервированный для высокоуровневой оболочки модуля OpenGL
///Все текущие элементы модуля являются временными
///
unit OpenGLABC;

uses System;
uses OpenGL;

type
  
  ///Методы для интеграции с gdi
  gl_gdi = static class
    {$reference System.Windows.Forms.dll}
    
    ///Создаёт новый контекст устройства GDI для дескриптора элемента управления
    public static function GetControlDC(hwnd: IntPtr): gdi_device_context;
    external 'user32.dll' name 'GetDC';
    
    ///Создаёт и настраивает контекст устройства GDI элемента управления WF
    ///hwnd - дескриптор элемента управления
    public static function InitControl(hwnd: IntPtr): gdi_device_context;
    begin
      Result := gl_gdi.GetControlDC(hwnd);
      
      var pfd: gdi_pixel_format_descriptor;
      pfd.nVersion := 1;
      
      pfd.dwFlags :=
        GDI_PixelFormatFlags.DRAW_TO_WINDOW or
        GDI_PixelFormatFlags.SUPPORT_OPENGL or
        GDI_PixelFormatFlags.DOUBLEBUFFER
      ;
      pfd.cColorBits := 24;
      pfd.cDepthBits := 16;
      
      if not gdi.SetPixelFormat(
        Result,
        gdi.ChoosePixelFormat(Result, pfd),
        pfd
      ) then raise new InvalidOperationException;
      
    end;
    
    ///Создаёт и настраивает контекст устройства GDI элемента управления WF
    public static function InitControl(c: System.Windows.Forms.Control) := InitControl(c.Handle);
    
  end;
  
  RedrawThreadProc = procedure(pl: PlatformLoader; EndFrame: ()->());
  RedrawHelper = static class
    
    ///Создаёт новый поток выполнения, который:
    ///1. Создаёт контекст OpenGL из контекста устройства GDI (hdc)
    ///2. Запускает перерисовку (RedrawThreadProc)
    public static procedure SetupRedrawThread(hdc: gdi_device_context; RedrawThreadProc: OpenGLABC.RedrawThreadProc; vsync_fps: integer := 65);
    begin
      
      System.Threading.Thread.Create(()->
      begin
        
        var pl := new PlWin;
        
        var context := wgl.CreateContext(hdc);
        if not wgl.MakeCurrent(hdc, context) then raise new InvalidOperationException('Не удалось применить контекст');
        
        var EndFrame: ()->();
        if vsync_fps<=0 then
          EndFrame := ()->gdi.SwapBuffers(hdc) else
        begin
          var LastRedr := DateTime.UtcNow;
          var FrameDuration := new TimeSpan(Trunc(TimeSpan.TicksPerSecond/vsync_fps));
          var MaxSlowDown := FrameDuration.Ticks*3;
          
          EndFrame := ()->
          begin
            gdi.SwapBuffers(hdc);
            
            LastRedr := LastRedr+FrameDuration;
            var time_left := LastRedr-DateTime.UtcNow;
            
            if time_left.Ticks>0 then
              System.Threading.Thread.Sleep(time_left) else
            if -time_left.Ticks > MaxSlowDown then
              LastRedr := LastRedr.AddTicks(-time_left.Ticks - MaxSlowDown);
            
          end;
          
        end;
        
        RedrawThreadProc(pl, EndFrame);
      end).Start;
      
    end;
    
  end;
  
end.