Apus.Engine.WindowsPlatform.pas

// Windows-specific functions used by Game object
//
// Copyright (C) 2020 Ivan Polyacov, Apus Software (ivan@apus-software.com)
// This file is licensed under the terms of BSD-3 license (see license.txt)
// This file is a part of the Apus Game Engine (http://apus-software.com/engine/)
{$I defines.inc}
unit Apus.Engine.WindowsPlatform;
interface
uses Windows, Apus.Core, Apus.Engine.API, Apus.Engine.Keys, Apus.Engine.OpenGL;

type
 { TWinGLWindow - Windows + WGL window implementation }

 TWinGLWindow=class(TWindow)
   constructor Create(hwnd:HWND;const windowName:String8);
   destructor Destroy; override;
   // TWindow overrides
   procedure Close; override;
   procedure Terminate; override;
   procedure Configure(params:TGameSettings); override;
   procedure Show(show:boolean); override;
   function GetHandle:THandle; override;
   procedure GetSize(out width,height:integer); override;
   procedure MoveTo(x,y:integer;width:integer=0;height:integer=0); override;
   procedure SetCaption(text:string); override;
   procedure Minimize; override;
   procedure Maximize; override;
   procedure Restore; override;
   procedure FlashWindow(count:integer); override;
   procedure ProcessMessages; override;
   function IsTerminated:boolean; override;
   procedure ScreenToClient(var p:TPoint); override;
   procedure ClientToScreen(var p:TPoint); override;
   procedure SampleOSPointer; override;
    // Graphics lifecycle (implemented via WGL)
  procedure InitGraph; override;
  procedure InitGraphShared(primary:TWindow;mainContextReleased:boolean=false); override;
  procedure DoneGraph; override;
  procedure ReleaseGraphContext; override;
  procedure ActivateGraphContext; override;
  procedure PresentFrame; override;
  function SetVSync(divider:integer):boolean; override;
 private
  window:HWND;
  context:UIntPtr;
  contextVAO:cardinal; // per-context VAO for shared secondary window
  terminated:boolean;
  graphInfo:TOpenGLContextDesc;
  wasMaximized:boolean; // maximize on the next switch to the window mode (start or return from fullscreen)
  configured:boolean;   // Configure was called: the startup state is applied
  function CustomFrameActive:boolean;
  function FrameHitTestAt(const p:TPoint;const client:TRect):integer;
  procedure ApplySizeLimits(var info:TMinMaxInfo);
  function CreateOpenGLContext(var graph:TOpenGLContextDesc;shareWith:UIntPtr=0):UIntPtr;
 end;

 { TWindowsPlatform - system services + window factory }

 TWindowsPlatform=class(TInterfacedObject,ISystemPlatform)
  constructor Create;
  // System information
  function GetPlatformName:string;
  function CanChangeSettings:boolean;
  procedure GetScreenSize(out width,height:integer);
  procedure GetRealScreenSize(out width,height:integer);
  function GetScreenDPI:integer;
  // System functions
  function GetMousePos:TPoint;
  procedure SetMousePos(scrX,scrY:integer);
  function GetSystemCursor(cursorId:integer):THandle;
  function LoadCursor(filename:string):THandle;
  procedure SetCursor(cur:THandle);
  procedure FreeCursor(cur:THandle);
  function GetShiftKeysState:cardinal;
  // Window factory
 function CreateWindow(const name:String8;title:string):TWindow;
 end;

implementation
uses Messages, MultiMon, Types, SysUtils, Apus.Lib,
  Apus.EventMan, Apus.Strings, Apus.Engine.Types, Apus.Engine.Window
  {$IFDEF MSWINDOWS},dglOpenGL{$ENDIF};

{$IFOPT R+} {$DEFINE RANGECHECK_ON} {$ENDIF}
type
 TwglCreateContextAttribsFn=function(hDC:HDC;hShareContext:HGLRC;const attribList:PInteger):HGLRC; stdcall;
const
  glcsReady=0;
  glcsReleaseRequested=1;
  glcsReleased=2;
  {$IF not Declared(XBUTTON1)}
  XBUTTON1 = $0001;
  XBUTTON2 = $0002;
  {$ENDIF}
  {$IF not Declared(VK_XBUTTON1)}
  VK_XBUTTON1 = $05;
  VK_XBUTTON2 = $06;
  {$ENDIF}
  {$IF not Declared(WM_DPICHANGED)}
  WM_DPICHANGED = $02E0;
  {$ENDIF}

// Drag and drop of files (declared here: ShellAPI signatures differ between FPC and Delphi)
procedure DragAcceptFiles(wnd:HWND;accept:BOOL); stdcall; external 'shell32.dll';
function DragQueryFileW(drop:THandle;index:cardinal;fileName:PWideChar;size:cardinal):cardinal; stdcall; external 'shell32.dll';
function DragQueryPoint(drop:THandle;var pt:TPoint):BOOL; stdcall; external 'shell32.dll';
procedure DragFinish(drop:THandle); stdcall; external 'shell32.dll';
var
 noPenAPI:boolean=false;
 classRegistered:boolean=false;
 // Last cursor handle applied via TWindowsPlatform.SetCursor. The window class has
 // no cursor (hCursor=0), so we re-assert this one on WM_SETCURSOR/HTCLIENT to undo
 // the sizing cursor that DefWindowProc sets while hovering a resize border.
 currentCursor:THandle=0;
 // WGL entry-point cache obtained on primary context and reused by secondary
 // windows when creating shared modern contexts in other threads.
 cachedWglCreateContextAttribs:TwglCreateContextAttribsFn=nil;
 // GL context handoff state for AddWindow startup.
 // Win32/WGL requires shareWith context to be non-current in all threads.
 glShareState:integer=glcsReady;

{$IF Declared(FlashWindowEx)} {$ELSE}
const
  FLASHW_STOP = $0;
  FLASHW_CAPTION = $1;
  FLASHW_TRAY = $2;
  FLASHW_ALL = FLASHW_CAPTION or FLASHW_TRAY;
  FLASHW_TIMER = $4;
  FLASHW_TIMERNOFG = $C;
type
 TFlashWInfo = packed record
  cbSize: DWORD;
  hwnd: HWND;
  dwFlags: DWORD;
  uCount: DWORD;
  dwTimeout: DWORD;
 end;
function FlashWindowEx(var pfwi: TFlashWInfo): LongBool; stdcall; external 'user32' Name 'FlashWindowEx';
{$IFEND}

function AsciiCodeFromUnicode(unicode:integer):integer;
var
 wst:WideString;
 ast:AnsiString;
begin
 wst:=WideChar(unicode);
 ast:=AnsiString(wst); // conversion
 result:=byte(ast[1]);
end;

procedure ProcessPointerMessage(Message:cardinal;WParam:UIntPtr;LParam:IntPtr);
var
 id:cardinal;
 {$IFDEF DELPHI}
 pType:POINTER_INPUT_TYPE;
 penInfo:POINTER_PEN_INFO;
 {$ENDIF}
begin
 if noPenAPI then exit;
 {$IFDEF DELPHI}
 try
  id:=Word(wParam);
  GetPointerType(id,@pType);
  if pType=Word(tagPOINTER_INPUT_TYPE.PT_PEN) then begin
    GetPointerPenInfo(id,@penInfo);
    if Bits.HasAll(penInfo.penMask,PEN_MASK_PRESSURE) then
      Signal('PEN\PRESSURE',penInfo.pressure);
    if Bits.HasAll(penInfo.penMask,PEN_MASK_ROTATION) then
      Signal('PEN\ROTATION',penInfo.rotation);
  end;
 except
  noPenAPI:=true;
 end;
 {$ENDIF}
end;

// Work area of the monitor nearest to the rect (screen coordinates)
function MonitorWorkArea(const r:TRect):TRect;
 var
  mi:TMonitorInfo;
 begin
  mi.cbSize:=sizeof(mi);
  if GetMonitorInfo(MonitorFromRect(@r,MONITOR_DEFAULTTONEAREST),@mi) then
   result:=mi.rcWork
  else
   SystemParametersInfo(SPI_GETWORKAREA,0,@result,0);
 end;

type
 TGetDpiForWindow=function(wnd:HWND):cardinal; stdcall;
 TGetSystemMetricsForDpi=function(index:integer;dpi:cardinal):integer; stdcall;
var
 dpiFuncsLoaded:boolean;
 pGetDpiForWindow:TGetDpiForWindow;
 pGetSystemMetricsForDpi:TGetSystemMetricsForDpi;

// Width of the resize edges of an app-drawn frame: as the OS frame, for the DPI of the window
function ResizeBorderWidth(wnd:HWND):integer;
 const
  SM_CXPADDEDBORDER=92;
 var
  lib:HMODULE;
  dpi:cardinal;
 begin
  if not dpiFuncsLoaded then begin // Windows 10 1607+
   lib:=GetModuleHandle(user32);
   @pGetDpiForWindow:=GetProcAddress(lib,'GetDpiForWindow');
   @pGetSystemMetricsForDpi:=GetProcAddress(lib,'GetSystemMetricsForDpi');
   dpiFuncsLoaded:=true;
  end;
  if Assigned(pGetDpiForWindow) and Assigned(pGetSystemMetricsForDpi) then begin
   dpi:=pGetDpiForWindow(wnd);
   result:=pGetSystemMetricsForDpi(SM_CXSIZEFRAME,dpi)+pGetSystemMetricsForDpi(SM_CXPADDEDBORDER,dpi);
  end else
   result:=GetSystemMetrics(SM_CXSIZEFRAME)+GetSystemMetrics(SM_CXPADDEDBORDER);
 end;

// The native capture is taken on a button press and kept while any button is held:
// released after the release event is delivered, once no button is left down
procedure ReleaseIdleCapture;
 var
  wnd:TWindow;
 begin
  wnd:=Apus.Engine.API.window;
  if (wnd=nil) or wnd.virtualInput.IsActive or (wnd.mouseButtons=0) then ReleaseCapture;
 end;

// The pointer is lost for this window: a physical gesture in progress ends without a click
procedure CancelGesture;
 begin
  if Apus.Engine.API.window<>nil then Apus.Engine.API.window.PlatformCancelGesture;
 end;

// The physical keyboard reaches the window: not while its virtual input is active
function PhysicalKeyboard:boolean;
 begin
  result:=(Apus.Engine.API.window=nil) or not Apus.Engine.API.window.virtualInput.IsActive;
 end;

// Windows scan code (set 1, $80 - an extended key) -> USB HID usage id (Scan.XXX), 0 if unknown
function HIDScanCode(code:integer):integer;
 begin
  case code of
   $01:result:=Scan.Escape;
   $02..$0A:result:=Scan.D1+code-$02;
   $0B:result:=Scan.D0;
   $0C:result:=Scan.Minus;
   $0D:result:=Scan.Equal;
   $0E:result:=Scan.Backspace;
   $0F:result:=Scan.Tab;
   $10:result:=Scan.Q;
   $11:result:=Scan.W;
   $12:result:=Scan.E;
   $13:result:=Scan.R;
   $14:result:=Scan.T;
   $15:result:=Scan.Y;
   $16:result:=Scan.U;
   $17:result:=Scan.I;
   $18:result:=Scan.O;
   $19:result:=Scan.P;
   $1A:result:=Scan.BracketL;
   $1B:result:=Scan.BracketR;
   $1C:result:=Scan.Enter;
   $1D:result:=Scan.LCtrl;
   $1E:result:=Scan.A;
   $1F:result:=Scan.S;
   $20:result:=Scan.D;
   $21:result:=Scan.F;
   $22:result:=Scan.G;
   $23:result:=Scan.H;
   $24:result:=Scan.J;
   $25:result:=Scan.K;
   $26:result:=Scan.L;
   $27:result:=Scan.Semicolon;
   $28:result:=Scan.Quote;
   $29:result:=Scan.Tilde;
   $2A:result:=Scan.LShift;
   $2B:result:=Scan.Backslash;
   $2C:result:=Scan.Z;
   $2D:result:=Scan.X;
   $2E:result:=Scan.C;
   $2F:result:=Scan.V;
   $30:result:=Scan.B;
   $31:result:=Scan.N;
   $32:result:=Scan.M;
   $33:result:=Scan.Comma;
   $34:result:=Scan.Period;
   $35:result:=Scan.Slash;
   $36:result:=Scan.RShift;
   $37:result:=Scan.NumMul;
   $38:result:=Scan.LAlt;
   $39:result:=Scan.Space;
   $3A:result:=Scan.CapsLock;
   $3B..$44:result:=Scan.F1+code-$3B;
   $45:result:=Scan.Pause;
   $46:result:=Scan.ScrollLock;
   $47:result:=Scan.Num7;
   $48:result:=Scan.Num8;
   $49:result:=Scan.Num9;
   $4A:result:=Scan.NumSub;
   $4B:result:=Scan.Num4;
   $4C:result:=Scan.Num5;
   $4D:result:=Scan.Num6;
   $4E:result:=Scan.NumAdd;
   $4F:result:=Scan.Num1;
   $50:result:=Scan.Num2;
   $51:result:=Scan.Num3;
   $52:result:=Scan.Num0;
   $53:result:=Scan.NumDot;
   $54:result:=154; // SysRq (Alt+PrintScreen)
   $56:result:=Scan.NonUSBackslash;
   $57:result:=Scan.F11;
   $58:result:=Scan.F12;
   $59:result:=103; // keypad =
   $64..$6E:result:=104+code-$64; // F13..F23
   $70:result:=136; // international keys (Japanese, Brazilian)
   $73:result:=135;
   $76:result:=115; // F24
   $79:result:=138;
   $7B:result:=139;
   $7D:result:=137;
   $7E:result:=133; // keypad comma
   // extended keys
   $90:result:=Scan.MediaPrev;
   $99:result:=Scan.MediaNext;
   $9C:result:=Scan.NumEnter;
   $9D:result:=Scan.RCtrl;
   $A0:result:=Scan.VolumeMute;
   $A1:result:=266; // calculator
   $A2:result:=Scan.MediaPlayPause;
   $A4:result:=Scan.MediaStop;
   $AE:result:=Scan.VolumeDown;
   $B0:result:=Scan.VolumeUp;
   $B2:result:=269; // browser home
   $B5:result:=Scan.NumDiv;
   $B7:result:=Scan.PrintScreen;
   $B8:result:=Scan.RAlt;
   $C5:result:=Scan.NumLock;
   $C6:result:=Scan.Pause; // Ctrl+Break
   $C7:result:=Scan.Home;
   $C8:result:=Scan.Up;
   $C9:result:=Scan.PageUp;
   $CB:result:=Scan.Left;
   $CD:result:=Scan.Right;
   $CF:result:=Scan.EndKey;
   $D0:result:=Scan.Down;
   $D1:result:=Scan.PageDown;
   $D2:result:=Scan.Insert;
   $D3:result:=Scan.Delete;
   $DB:result:=Scan.LWin;
   $DC:result:=Scan.RWin;
   $DD:result:=Scan.Menu;
   $DE:result:=102; // power
   $DF:result:=282; // sleep
   $E5:result:=268; // browser search
   $E6:result:=274; // browser favorites
   $E7:result:=273; // browser refresh
   $E8:result:=272; // browser stop
   $E9:result:=Scan.BrowserForward;
   $EA:result:=Scan.BrowserBack;
   $EB:result:=267; // my computer
   $EC:result:=265; // mail
   $ED:result:=263; // media select
  else
   result:=0;
  end;
 end;

// Codes of a key message: TKey (a modifier names its side) and the HID scancode
procedure KeyMessageCodes(wParam:UIntPtr;lParam:IntPtr;out keyCode,scanCode:integer);
 var
  code:integer;
  isExtended:boolean;
  vkCode:cardinal;
 begin
  // wParam = virtual code; lParam[23..16] = scan code; lParam[24] = extended key flag
  code:=(lParam shr 16) and $FF;
  isExtended:=Bits.HasAll(cardinal(lParam shr 24),1);
  vkCode:=wParam and $FFFF;
  case vkCode of
   VK_SHIFT:vkCode:=MapVirtualKey(code,MAPVK_VSC_TO_VK_EX);
   VK_CONTROL:begin
    if isExtended then vkCode:=VK_RCONTROL else vkCode:=VK_LCONTROL;
   end;
   VK_MENU:begin
    if isExtended then vkCode:=VK_RMENU else vkCode:=VK_LMENU;
   end;
  end;
  keyCode:=TKey.FromWindowsVK(vkCode).Code;
  if isExtended then code:=code or $80;
  case vkCode of // Pause and NumLock may come with the same scan code
   VK_PAUSE:scanCode:=Scan.Pause;
   VK_NUMLOCK:scanCode:=Scan.NumLock;
  else
   scanCode:=HIDScanCode(code);
  end;
  // no scan code (input injected with a virtual code only): the position on the US layout
  if scanCode=0 then scanCode:=Scan.FromKey(TKey(keyCode));
 end;

function WindowProc(Window:HWnd;Message:cardinal;WParam:UIntPtr;LParam:IntPtr):LongInt; stdcall;
var
 i,charCode,scanCode,keyCode:integer;
 inClient:boolean;
 rc:TRect;
 pt:TPoint;
 ps:TPaintStruct;
 wnd:TWindow;
 files:Strings8;
 wst:WideString;
begin
 try
 result:=0;

 case Message of
  wm_Destroy:begin
   Log.Msg('WM_Destroy hwnd=%d',[Window]);
   if (mainWindow<>nil) and (mainWindow.GetHandle=THandle(Window)) then begin
    (mainWindow as TWinGLWindow).terminated:=true;
    Signal('Engine\Cmd\Exit',0);
   end else begin
    // extra window closed — mark as terminated, don't exit app
    if (Apus.Engine.API.window<>nil) and (Apus.Engine.API.window.GetHandle=THandle(Window)) then
     (Apus.Engine.API.window as TWinGLWindow).terminated:=true;
   end;
  end;
  {$IFDEF DELPHI} // FPC currently has no declaration of MS Pointer Input API
  WM_POINTERUPDATE,WM_POINTERENTER,WM_POINTERLEAVE:ProcessPointerMessage(Message,WParam,LParam);
  {$ENDIF}

  // WM_MOUSEMOVE / WM_MOUSELEAVE intentionally not handled here:
  // mouse position is sampled once per frame via TWindow.SamplePointer,
  // which avoids OS-rate event flood on high-polling-rate mice.

  WM_UNICHAR:begin
//   Log.Msg('WM_UNICHAR wParam=%d lParam=%d',[wParam,lParam]);
  end;

  WM_CHAR:if PhysicalKeyboard then begin
    charCode:=wParam and $FFFF;
    scanCode:=(lParam shr 16) and $FF;
    if Bits.HasAll(cardinal(lParam shr 24),1) then scanCode:=scanCode or $80;
    scanCode:=HIDScanCode(scanCode);
    Signal('KBD\CHAR',AsciiCodeFromUnicode(charCode)+scanCode shl 16);
    Signal('KBD\UNICHAR',charCode+scanCode shl 16);
  end;

  WM_KEYDOWN,WM_SYSKEYDOWN:if PhysicalKeyboard then begin
    KeyMessageCodes(wParam,lParam,keyCode,scanCode);
    Signal('KBD\KEYDOWN',keyCode+scanCode shl 16);
  end;

  WM_KEYUP,WM_SYSKEYUP:begin
    if PhysicalKeyboard then begin
     KeyMessageCodes(wParam,lParam,keyCode,scanCode);
     Signal('KBD\KEYUP',keyCode+scanCode shl 16);
    end;
    if message=WM_SYSKEYUP then exit(0);
  end;

{  WM_SYSCHAR:begin
    result:=0; exit;
    scancode:=(lParam shr 16) and $FF;
//    Signal('KBD\KeyDown',wParam and $FFFF+game.shiftState shl 16+scancode shl 24);
  end;}

  WM_LBUTTONDOWN,WM_RBUTTONDOWN,WM_MBUTTONDOWN:begin
    SetCapture(window);
    i:=0;
    if message=wm_LButtonDown then i:=1 else
    if message=wm_RButtonDown then i:=2 else
    if message=wm_MButtonDown then i:=3;
    // signals MOUSE\BTNDOWN, samples the pointer and dispatches (not in the virtual mouse mode)
    if Apus.Engine.API.window<>nil then Apus.Engine.API.window.PlatformMouseButton(i,true)
     else Signal('MOUSE\BTNDOWN',i); // for external subscribers
  end;
  WM_XBUTTONDOWN:begin
    SetCapture(window);
    i:=0;
    if HiWord(wParam)=XBUTTON1 then i:=4 else
    if HiWord(wParam)=XBUTTON2 then i:=5;
    if i>0 then
     if Apus.Engine.API.window<>nil then Apus.Engine.API.window.PlatformMouseButton(i,true)
      else Signal('MOUSE\BTNDOWN',i);
    exit(0);
  end;

  WM_LBUTTONUP,WM_RBUTTONUP,WM_MBUTTONUP:begin
    i:=0;
    if message=wm_LButtonUp then i:=1 else
    if message=wm_RButtonUp then i:=2 else
    if message=wm_MButtonUp then i:=3;
    if Apus.Engine.API.window<>nil then Apus.Engine.API.window.PlatformMouseButton(i,false)
     else Signal('MOUSE\BTNUP',i); // for external subscribers
    ReleaseIdleCapture;
  end;
  WM_XBUTTONUP:begin
    i:=0;
    if HiWord(wParam)=XBUTTON1 then i:=4 else
    if HiWord(wParam)=XBUTTON2 then i:=5;
    if i>0 then
     if Apus.Engine.API.window<>nil then Apus.Engine.API.window.PlatformMouseButton(i,false)
      else Signal('MOUSE\BTNUP',i);
    ReleaseIdleCapture;
    exit(0);
  end;

  WM_MOUSEWHEEL:begin
   if Apus.Engine.API.window<>nil then Apus.Engine.API.window.PlatformMouseWheel(smallint(wParam shr 16))
    else Signal('MOUSE\SCROLL',smallint(wParam shr 16)); // for external subscribers
  end;

  // close button, Alt+F4: the app may ask the user first, so DefWindowProc must not destroy
  // the window here (it is destroyed by Close when the window loop ends)
  WM_CLOSE:begin
   wnd:=FindWindowByHandle(THandle(Window));
   if wnd<>nil then begin
    wnd.RequestClose;
    exit(0);
   end;
  end;

  WM_SIZE:begin
   wnd:=FindWindowByHandle(THandle(Window));
   if wnd<>nil then begin
    i:=ord(wnd.state);
    case wParam of
     SIZE_RESTORED:wnd.PlatformStateChanged(TWindowState.Normal);
     SIZE_MINIMIZED:wnd.PlatformStateChanged(TWindowState.Minimized);
     SIZE_MAXIMIZED:wnd.PlatformStateChanged(TWindowState.Maximized);
    end;
    // the frame depends on the state: make sure it is recalculated
    if (i<>ord(wnd.state)) and (wnd.frame=TWindowFrame.CustomWhenMaximized) then
     SetWindowPos(Window,0,0,0,0,0,SWP_FRAMECHANGED or SWP_NOMOVE or SWP_NOSIZE or
      SWP_NOZORDER or SWP_NOACTIVATE);
    // the window's own thread applies the request at the start of its next frame
    if lParam<>0 then wnd.RequestResize(loword(cardinal(lParam)),hiword(cardinal(lParam)));
   end;
  end;

  WM_NCCALCSIZE:if wParam<>0 then begin
   wnd:=FindWindowByHandle(THandle(Window));
   if (wnd<>nil) and TWinGLWindow(wnd).CustomFrameActive then begin
    // App-drawn frame: the client takes the whole window. A maximized window lies beyond
    // its monitor by the frame thickness - its client is cut to the monitor work area
    if IsZoomed(Window) then
     with PNCCalcSizeParams(lParam)^ do
      rgrc[0]:=MonitorWorkArea(rgrc[0]);
    exit(0);
   end;
  end;

  WM_NCACTIVATE:begin
   // no OS caption to repaint on (de)activation: lParam=-1 keeps DefWindowProc from drawing it
   wnd:=FindWindowByHandle(THandle(Window));
   if (wnd<>nil) and TWinGLWindow(wnd).CustomFrameActive then
    exit(Longint(DefWindowProcW(Window,Message,WParam,-1)));
  end;

  WM_GETMINMAXINFO:begin
   wnd:=FindWindowByHandle(THandle(Window));
   if (wnd<>nil) and Assigned(wnd.sizeLimits) then
    TWinGLWindow(wnd).ApplySizeLimits(PMinMaxInfo(lParam)^);
  end;

  WM_DROPFILES:begin
   wnd:=FindWindowByHandle(THandle(Window));
   if wnd<>nil then begin
    SetLength(files,DragQueryFileW(wParam,$FFFFFFFF,nil,0));
    for i:=0 to high(files) do begin
     SetLength(wst,DragQueryFileW(wParam,i,nil,0)); // length without #0
     if wst<>'' then DragQueryFileW(wParam,i,PWideChar(wst),length(wst)+1);
     files[i]:=UTF8.FromWide(wst);
    end;
    inClient:=DragQueryPoint(wParam,pt); // false outside the client area
    wnd.PlatformDropFiles(files,pt,inClient);
   end;
   DragFinish(wParam);
   exit(0);
  end;

  WM_DPICHANGED:begin
   // apply the suggested rect from Windows
   with PRect(lParam)^ do
    SetWindowPos(Window,0,Left,Top,Right-Left,Bottom-Top,
     SWP_NOZORDER or SWP_NOACTIVATE);
   wnd:=FindWindowByHandle(THandle(Window));
   if wnd<>nil then wnd.RequestDPI(loword(wParam));
  end;

  WM_NCHITTEST: begin
    // The OS sends WM_NCHITTEST at mouse-poll rate. Fast-path the common case —
    // cursor inside the client area — straight to HTCLIENT, skipping DefWindowProc's
    // non-client hit-test (this was the original FPS optimization). Only when the
    // cursor is over a border or the caption do we fall through to DefWindowProc, so
    // native resizing (WS_SIZEBOX) and window dragging still work there.
    pt.x:=smallint(loword(cardinal(lParam))); // screen coords, may be negative on multi-monitor
    pt.y:=smallint(hiword(cardinal(lParam)));
    ScreenToClient(Window,pt);
    GetClientRect(Window,rc);
    if (pt.x>=0) and (pt.y>=0) and (pt.x<rc.right) and (pt.y<rc.bottom) then begin
      // app-drawn frame: edges, caption and client are all inside the client area
      wnd:=FindWindowByHandle(THandle(Window));
      if (wnd<>nil) and TWinGLWindow(wnd).CustomFrameActive then
       exit(TWinGLWindow(wnd).FrameHitTestAt(pt,rc));
      result:=HTCLIENT;
      exit;
    end;
    // else fall through to DefWindowProc -> HTLEFT/HTCAPTION/HTBOTTOMRIGHT/...
  end;

  WM_SETCURSOR: begin
    // Class cursor is 0, so re-assert the engine's current cursor over the client
    // area (game cursor system: arrow/custom/hidden=0). This undoes the sizing
    // cursor DefWindowProc set on the resize border. Non-client (borders/caption)
    // falls through so native sizing cursors keep working.
    if word(lParam)=HTCLIENT then begin
      windows.SetCursor(currentCursor);
      exit(1);
    end;
  end;

  WM_PAINT:begin
    // Validate the update region BEFORE rendering: a frame is drawn synchronously via
    // ENGINE\REDRAW to keep the window live during the OS modal move/resize loop (the
    // engine main loop is stalled meanwhile). That loop may pump messages re-entrantly,
    // so the region must be clean first, and we must not nest RenderAndPresentFrame.
    BeginPaint(Window,ps);
    EndPaint(Window,ps);
    if (game<>nil) and not game.renderingFrame then
      Signal('ENGINE\REDRAW');
    exit(0);
  end;

  WM_ACTIVATE:begin
   //Log.Msg('WM_ACTIVATE: %x %x',[wparam,lparam]);
   if loword(wparam)<>wa_inactive then i:=1
    else i:=0;
   // a drag does not survive switching to another window, held keys are released: their
   // releases go to the other window
   if (i=0) and (Apus.Engine.API.window<>nil) then begin
    Apus.Engine.API.window.PlatformCancelGesture;
    Apus.Engine.API.window.PlatformReleaseKeys;
   end;
   Signal('ENGINE\SETACTIVE',i);
  end;
  // the system cancels modes (a dialog pops up, ...): DefWindowProc releases the capture
  WM_CANCELMODE:CancelGesture;
  // the capture went to another window (our own ReleaseCapture comes with no button held)
  WM_CAPTURECHANGED:
   if HWND(LParam)<>Window then CancelGesture;
 end;
 {$R-}
 result:=Longint(DefWindowProcW(Window,Message,WParam,LParam));
 {$IFDEF RANGECHECK_ON} {$R+} {$ENDIF}
 except
  on e:Exception do begin
   result:=0;
   Log.Force('WindowProc error: '+ExceptionMsg(e));
  end;
 end;
end;

{ TWinGLWindow }

constructor TWinGLWindow.Create(hwnd:HWND;const windowName:String8);
begin
  inherited Create(windowName);
  window:=hwnd;
  contextVAO:=0;
end;

destructor TWinGLWindow.Destroy;
begin
  inherited;
end;

{ TWindowsPlatform }

constructor TWindowsPlatform.Create;
 var
  ver:DWord;
 begin
  ver:=GetVersion;
  Log.Msg('Windows platform: %d.%d',[ver and $FF,(ver shr 8) and $FF]);
 end;

function TWindowsPlatform.CanChangeSettings: boolean;
 begin
  result:=true;
 end;

procedure TWinGLWindow.ClientToScreen(var p: TPoint);
 begin
  windows.ClientToScreen(window,p);
 end;

procedure TWinGLWindow.Close;
 begin
  windows.ShowWindow(window,SW_HIDE);
  windows.DestroyWindow(window);
 end;

procedure TWinGLWindow.Terminate;
 begin
  terminated:=true;
  if self=mainWindow then Signal('Engine\Cmd\Exit',0);
 end;

procedure TWinGLWindow.FlashWindow(count: integer);
 var
  fi:TFlashWInfo;
 begin
  Mem.Fill(fi,sizeof(fi),0);
  fi.cbSize:=sizeof(fi);
  fi.hwnd:=window;
  fi.dwTimeout:=400;
  if count=-1 then
   fi.dwFlags:=FLASHW_STOP
  else
   fi.dwFlags:=FLASHW_ALL+FLASHW_TIMERNOFG*byte(count=0);
  if count<=0 then count:=100;
  fi.uCount:=count;
  {$IFDEF FPC}
  FlashWindowEx(@fi);
  {$ELSE}
  FlashWindowEx(fi);
  {$ENDIF}
 end;

procedure TWinGLWindow.ScreenToClient(var p: TPoint);
 begin
  windows.ScreenToClient(window,p);
 end;

procedure TWinGLWindow.SampleOSPointer;
 var
  pnt:TPoint;
  captured:boolean;
 begin
  Windows.GetCursorPos(pnt);
  // a held button keeps the OS pointer capture (SetCapture on btn-down), so a drag must
  // report raw continuous coords even outside our window — otherwise the sentinel below
  // injects a one-frame jump that throws camera-drag demos to an extreme.
  captured:=GetCapture=self.window;
  // not dragging: cursor over another (overlapping/topmost) window → not ours, use sentinel.
  // GetCursorPos polls the global pointer, so without this guard motion leaks through
  // whatever window sits on top of ours. GA_ROOT collapses a child GL canvas to its top-level.
  if not captured then
   if GetAncestor(WindowFromPoint(pnt),GA_ROOT)<>self.window then begin
    SetPointerOutside;
    exit;
   end;
  Windows.ScreenToClient(self.window,pnt);
  // not dragging: pointer outside client area → use off-screen sentinel
  if not captured then
   if (pnt.x<0) or (pnt.y<0) or
      (pnt.x>=clientWidth) or (pnt.y>=clientHeight) then begin
    SetPointerOutside;
    exit;
   end;
  SetPointer(pnt);
 end;

function TWindowsPlatform.GetMousePos: TPoint;
 begin
  GetCursorPos(result);
 end;

procedure TWindowsPlatform.SetMousePos(scrX,scrY:integer);
 begin
  SetCursorPos(scrX,scrY);
 end;

function TWindowsPlatform.GetPlatformName: string;
 begin
  result:='spWindows';
 end;

function TWindowsPlatform.GetScreenDPI:integer;
 var
  dc:HDC;
 begin
  dc:=GetDC(0);
  ASSERT(dc<>0);
  result:=(GetDeviceCaps(dc,LOGPIXELSX)+GetDeviceCaps(dc,LOGPIXELSY)) div 2;
  ReleaseDC(0,dc);
 end;

procedure TWindowsPlatform.GetScreenSize(out width,height:integer);
 begin
  width:=GetSystemMetrics(SM_CXSCREEN);
  height:=GetSystemMetrics(SM_CYSCREEN);
 end;

procedure TWindowsPlatform.GetRealScreenSize(out width,height:integer);
 const
  ENUM_CURRENT_SETTINGS = DWORD(-1);
 var
  devMode:TDeviceModeA;
 begin
  EnumDisplaySettingsA(nil,ENUM_CURRENT_SETTINGS,devMode);
  width:=devMode.dmPelsWidth;
  height:=devMode.dmPelsHeight;
 end;

function TWindowsPlatform.GetShiftKeysState: cardinal;
 begin
  result:=0;
  if (GetAsyncKeyState(VK_LSHIFT)<0) or (GetAsyncKeyState(VK_RSHIFT)<0) then result:=result or sscShift;
  if (GetAsyncKeyState(VK_LCONTROL)<0) or (GetAsyncKeyState(VK_RCONTROL)<0) then result:=result or sscCtrl;
  if (GetAsyncKeyState(VK_LMENU)<0) or (GetAsyncKeyState(VK_RMENU)<0) then result:=result or sscAlt;
  if (GetAsyncKeyState(VK_LWIN)<0) or (GetAsyncKeyState(VK_RWIN)<0) then result:=result or sscWin;

  if GetAsyncKeyState(VK_RSHIFT)<0 then result:=result or sscRShift;
  if GetAsyncKeyState(VK_RCONTROL)<0 then result:=result or sscRCtrl;
  if GetAsyncKeyState(VK_RMENU)<0 then result:=result or sscRAlt;
  if GetAsyncKeyState(VK_RWIN)<0 then result:=result or sscRWin;
 end;

function TWindowsPlatform.GetSystemCursor(cursorId: integer): THandle;
 var
  name:PChar;
 begin
  case cursorID of
   Apus.Engine.API.CursorID.Default:name:=IDC_ARROW;
   Apus.Engine.API.CursorID.Link:name:=IDC_HAND;
   Apus.Engine.API.CursorID.Wait:name:=IDC_WAIT;
   Apus.Engine.API.CursorID.Input:name:=IDC_IBEAM;
   Apus.Engine.API.CursorID.Help:name:=IDC_HELP;
   Apus.Engine.API.CursorID.ResizeH:name:=IDC_SIZENS;
   Apus.Engine.API.CursorID.ResizeW:name:=IDC_SIZEWE;
   Apus.Engine.API.CursorID.ResizeHW:name:=IDC_SIZEALL;
   Apus.Engine.API.CursorID.ResizeNWSE:name:=IDC_SIZENWSE;
   Apus.Engine.API.CursorID.ResizeNESW:name:=IDC_SIZENESW;
   Apus.Engine.API.CursorID.Cross:name:=IDC_CROSS;
  end;
  result:=Windows.LoadCursor(0,name);
 end;

function TWindowsPlatform.LoadCursor(filename:string):THandle;
 var
  data,bits:ByteArray;
  offset,size:cardinal;
 begin
  // Read through the provider chain, including additional data roots and packs.
  data:=Files.LoadAsBytes(Files.FixName(ChangeFileExt(filename,'.cur')));
  if length(data)<22 then raise EWarning.Create('Invalid cursor: '+filename);
  if (PWord(@data[0])^<>0) or (PWord(@data[2])^<>2) or
     (PWord(@data[4])^=0) then raise EWarning.Create('Invalid cursor: '+filename);
  if length(data)<6+16*integer(PWord(@data[4])^) then
   raise EWarning.Create('Incomplete cursor directory: '+filename);
  // Like the SDL loader, use the first CUR image. Native cursor resources
  // prefix the image bytes with the two hotspot words from its directory entry.
  size:=PCardinal(@data[14])^;
  offset:=PCardinal(@data[18])^;
  if (size=0) or (offset>cardinal(length(data))) or
     (size>cardinal(length(data))-offset) or (size>MaxInt-4) then
   raise EWarning.Create('Incomplete cursor image: '+filename);
  SetLength(bits,integer(size)+4);
  Move(data[10],bits[0],4);
  Move(data[integer(offset)],bits[4],size);
  result:=CreateIconFromResourceEx(@bits[0],length(bits),false,$30000,0,0,0);
  if result=0 then raise EWarning.Create('Failed to create cursor: '+filename);
 end;

procedure TWindowsPlatform.SetCursor(cur:THandle);
 begin
  currentCursor:=cur; // remembered so WM_SETCURSOR can re-assert the engine's choice
  windows.SetCursor(cur);
 end;

procedure TWindowsPlatform.FreeCursor(cur:THandle);
 begin
  Windows.DestroyCursor(cur);
 end;

function TWinGLWindow.GetHandle:THandle;
 begin
  result:=window;
 end;

procedure TWinGLWindow.GetSize(out width,height:integer);
 var
  r:TRect;
 begin
  GetClientRect(window,r);
  width:=r.Width; height:=r.Height;
 end;

function TWindowsPlatform.CreateWindow(const name:String8;title:string):TWindow;
 var
  WindowClass:TWndClassW;
  style:cardinal;
  wndHandle:HWND;
  e:cardinal;
 begin
   Log.Msg('CreateWindow: %s (%s)',[name,title]);
   if not classRegistered then begin
    with WindowClass do begin
     // OpenGL windows should use own DC to keep stable WGL behavior across threads/windows.
     Style:=cs_HRedraw or cs_VRedraw or CS_OWNDC;
     lpfnWndProc:=@WindowProc;
     cbClsExtra:=0;
     cbWndExtra:=0;
     hInstance:=0;
     hIcon:=LoadIcon(MainInstance,'MAINICON');
     hCursor:=0;
     hbrBackground:=GetStockObject(Black_Brush);
     lpszMenuName:='';
     lpszClassName:='GameWindowClass';
    end;
    if windows.RegisterClassW(WindowClass)=0 then begin
     e:=GetLastError;
     if e<>ERROR_CLASS_ALREADY_EXISTS then
      raise EFatalError.Create('Cannot register window class');
    end;
    classRegistered:=true;
   end;

   style:=0;
   wndHandle:=windows.CreateWindowW('GameWindowClass', PWideChar(WideString(title)),
    style, 0, 0, 100, 100, 0, 0, HInstance, nil);
   DragAcceptFiles(wndHandle,true); // WM_DROPFILES from a file manager
   result:=TWinGLWindow.Create(wndHandle,name);
  end;

procedure TWinGLWindow.ProcessMessages;
 var
  mes:TagMSG;
 begin
  while PeekMessageW(mes,0,0,0,PM_REMOVE) do begin
    if mes.message=WM_QUIT then begin
      if self=mainWindow then
        Signal('Engine\Cmd\Exit',0)
      else
        terminated:=true;
      break;
    end;
    TranslateMessage(mes);
    DispatchMessageW(mes);
  end;
 end;

function TWinGLWindow.IsTerminated:boolean;
 begin
  result:=terminated;
 end;

procedure TWinGLWindow.Minimize;
 begin
  windows.ShowWindow(window,SW_MINIMIZE);
 end;

procedure TWinGLWindow.Maximize;
 begin
  windows.ShowWindow(window,SW_MAXIMIZE);
 end;

procedure TWinGLWindow.Restore;
 begin
  windows.ShowWindow(window,SW_RESTORE);
 end;

function TWinGLWindow.CustomFrameActive:boolean;
 begin
  // not CustomFrameShown: while the state changes, IsZoomed is ahead of TWindow.state
  result:=(frame=TWindowFrame.Custom) or
   ((frame=TWindowFrame.CustomWhenMaximized) and IsZoomed(window));
 end;

// Hit test of an app-drawn frame, p - client point: OS resize edges first, then frameHitTest
function TWinGLWindow.FrameHitTestAt(const p:TPoint;const client:TRect):integer;
 const
  codes:array[TWindowArea] of integer=(HTCLIENT,HTCAPTION,HTLEFT,HTRIGHT,HTTOP,HTBOTTOM,
   HTTOPLEFT,HTTOPRIGHT,HTBOTTOMLEFT,HTBOTTOMRIGHT);
 var
  sizeable,left,right,top,bottom:boolean;
  border:integer;
  area:TWindowArea;
  cp:TPoint;
  hitTest:TWindowHitTest;
 begin
  sizeable:=(GetWindowLong(window,GWL_STYLE) and WS_THICKFRAME<>0) and not IsZoomed(window);
  if sizeable then begin
   border:=ResizeBorderWidth(window);
   left:=p.x<border;
   right:=p.x>=client.right-border;
   top:=p.y<border;
   bottom:=p.y>=client.bottom-border;
   if top and left then exit(HTTOPLEFT);
   if top and right then exit(HTTOPRIGHT);
   if bottom and left then exit(HTBOTTOMLEFT);
   if bottom and right then exit(HTBOTTOMRIGHT);
   if left then exit(HTLEFT);
   if right then exit(HTRIGHT);
   if top then exit(HTTOP);
   if bottom then exit(HTBOTTOM);
  end;
  area:=TWindowArea.Client;
  LockState;
  hitTest:=frameHitTest;
  UnlockState;
  if Assigned(hitTest) and TryClientToCanvas(p,cp) then area:=hitTest(cp.x,cp.y);
  if not sizeable and (area>TWindowArea.Caption) then area:=TWindowArea.Client;
  result:=codes[area];
 end;

// sizeLimits are canvas units of the client: converted to the window size with the OS frame
procedure TWinGLWindow.ApplySizeLimits(var info:TMinMaxInfo);
 var
  minSize,maxSize:TSize;
  r:TRect;
  k:single;
  limits:TWindowSizeLimits;
 begin
  if GetWindowLong(window,GWL_STYLE) and WS_CAPTION<>WS_CAPTION then exit; // fullscreen
  LockState;
  limits:=sizeLimits;
  UnlockState;
  if not Assigned(limits) then exit;
  minSize.cx:=0; minSize.cy:=0;
  maxSize.cx:=0; maxSize.cy:=0;
  limits(minSize,maxSize);
  k:=1; // client pixels per canvas unit
  if (surface.canvasSize.cx>0) and (surface.displayRect.Width>0) then
   k:=surface.displayRect.Width/surface.canvasSize.cx;
  r:=Rect(0,0,0,0);
  if not CustomFrameActive then
   AdjustWindowRectEx(r,GetWindowLong(window,GWL_STYLE),false,GetWindowLong(window,GWL_EXSTYLE));
  if minSize.cx>0 then info.ptMinTrackSize.x:=round(minSize.cx*k)+r.Width;
  if minSize.cy>0 then info.ptMinTrackSize.y:=round(minSize.cy*k)+r.Height;
  if maxSize.cx>0 then info.ptMaxTrackSize.x:=round(maxSize.cx*k)+r.Width;
  if maxSize.cy>0 then info.ptMaxTrackSize.y:=round(maxSize.cy*k)+r.Height;
 end;

procedure TWinGLWindow.MoveTo(x,y:integer;width:integer;
  height: integer);
 var
  r:TRect;
  dx,dy:integer;
 begin
  getWindowRect(window,r);
  dx:=x-r.left; dy:=y-r.top;
  inc(r.left,dx); inc(r.right,dx);
  inc(r.top,dy); inc(r.Bottom,dy);
  if (width>0) and (height>0) then begin
   r.Right:=r.left+width;
   r.Bottom:=r.top+height;
  end;
  if not MoveWindow(window,r.left,r.top,r.right-r.left,r.Bottom-r.top,true) then
   Log.Force('MoveWindow error: %d',[GetLastError]);
 end;

function TWinGLWindow.CreateOpenGLContext(var graph:TOpenGLContextDesc;shareWith:UIntPtr=0):UIntPtr;
 type
  TglGetStringFn=function(name:cardinal):PAnsiChar; stdcall;
  TwglGetProcAddressFn=function(procName:PAnsiChar):Pointer; stdcall;
 var
  DC:HDC;
  RC,legacyRC:HGLRC;
  PFD:TPixelFormatDescriptor;
  pf:integer;
  requestedMajor,requestedMinor:integer;
  availMajor,availMinor:integer;
  attribs:array[0..15] of integer;
  n,flags,profileMask:integer;
  modernCreated:boolean;
  effectiveDebug:boolean;
  errCode:cardinal;
  requestedProfile,actualProfile:TOpenGLContextProfile;
  requestedDebug,requestedForward:boolean;
  glVer:string;
  glVerRaw:PAnsiChar;
  openglLib:HMODULE;
  glGetStringFn:TglGetStringFn;
  wglGetProcAddressFn:TwglGetProcAddressFn;
  wglCreateContextAttribsARB:TwglCreateContextAttribsFn;
 function ParseGLVersion(const st:string;out major,minor:integer):boolean;
  var
   i,start:integer;
   s:string;
  begin
   result:=false;
   major:=0; minor:=0;
   s:=st;
   start:=0;
   for i:=1 to length(s)-2 do
    if (s[i] in ['0'..'9']) and (s[i+1] in ['0'..'9','.']) then begin
     start:=i; break;
    end;
   if start=0 then exit;
    i:=start;
   while (i<=length(s)) and (s[i] in ['0'..'9']) do inc(i);
   if (i>length(s)) or (s[i]<>'.') then exit;
   major:=strtointdef(copy(s,start,i-start),0);
   inc(i); start:=i;
   while (i<=length(s)) and (s[i] in ['0'..'9']) do inc(i);
    if start=i then exit;
   minor:=strtointdef(copy(s,start,i-start),0);
   result:=major>0;
  end;
 procedure BuildAttribs(major,minor,profile:integer;debug,fwd:boolean);
  begin
   // WGL attributes are passed as key/value pairs terminated by 0.
   n:=0;
   attribs[n]:=WGL_CONTEXT_MAJOR_VERSION_ARB; inc(n);
   attribs[n]:=major; inc(n);
   attribs[n]:=WGL_CONTEXT_MINOR_VERSION_ARB; inc(n);
   attribs[n]:=minor; inc(n);
   if profile<>0 then begin
    attribs[n]:=WGL_CONTEXT_PROFILE_MASK_ARB; inc(n);
    attribs[n]:=profile; inc(n);
   end;
   flags:=0;
   if debug then flags:=flags or WGL_CONTEXT_DEBUG_BIT_ARB;
   if fwd then flags:=flags or WGL_CONTEXT_FORWARD_COMPATIBLE_BIT_ARB;
   if flags<>0 then begin
    attribs[n]:=WGL_CONTEXT_FLAGS_ARB; inc(n);
    attribs[n]:=flags; inc(n);
   end;
   attribs[n]:=0;
  end;
 procedure SetupPixelFormat;
  begin
   Log.Msg('Prepare GL context (shareWith=%d)',[shareWith]);
   // Pixel format is immutable per-window DC, so we set it once before any RC creation.
   Mem.Clear(pfd,sizeof(PFD));
   with PFD do begin
    nSize:=sizeof(PFD);
    nVersion:=1;
    dwFlags:=PFD_SUPPORT_OPENGL+PFD_DRAW_TO_WINDOW+PFD_DOUBLEBUFFER;
    iPixelType:=PFD_TYPE_RGBA;
    cDepthBits:=24;
   end;
   DC:=GetDC(window);
   pf:=ChoosePixelFormat(DC,@PFD);
   Log.Msg('Pixel format: %d',[pf]);
   if not SetPixelFormat(DC,pf,@PFD) then
    Log.Error('Failed to set pixel format!');
  end;
 procedure ProbePrimaryContext;
  begin
   // Primary window path:
   // create temporary legacy context to probe available version and load WGL entry points.
   Log.Msg('Create GL context');
   legacyRC:=wglCreateContext(DC);
   if legacyRC=0 then
    raise EError.Create('Can''t create RC!');
   wglMakeCurrent(DC,legacyRC);

   glVerRaw:=nil;
   openglLib:=GetModuleHandle('opengl32.dll');
   if openglLib<>0 then begin
    glGetStringFn:=TglGetStringFn(GetProcAddress(openglLib,'glGetString'));
    if assigned(glGetStringFn) then
     glVerRaw:=glGetStringFn($1F02); // GL_VERSION
   end;
   if glVerRaw<>nil then
    glVer:=glVerRaw
   else
    glVer:='unknown';
   if not ParseGLVersion(glVer,availMajor,availMinor) then begin
    availMajor:=2;
    availMinor:=1;
   end;
   Log.Msg('Available GL version on temporary context: %d.%d (%s)',[availMajor,availMinor,glVer]);

   // Resolve wglCreateContextAttribsARB via opengl32->wglGetProcAddress.
   wglCreateContextAttribsARB:=nil;
   openglLib:=GetModuleHandle('opengl32.dll');
   if openglLib<>0 then begin
    wglGetProcAddressFn:=TwglGetProcAddressFn(GetProcAddress(openglLib,'wglGetProcAddress'));
    if assigned(wglGetProcAddressFn) then
     wglCreateContextAttribsARB:=TwglCreateContextAttribsFn(wglGetProcAddressFn('wglCreateContextAttribsARB'));
   end;
   // Cache proc address for future shared-context creation in secondary threads.
   if assigned(wglCreateContextAttribsARB) and (shareWith=0) then
    cachedWglCreateContextAttribs:=wglCreateContextAttribsARB;
   // Legacy context is no longer needed for probing.
   // Release current binding before attempting modern context creation.
   wglMakeCurrent(0,0);

   requestedMajor:=graph.minMajor;
   requestedMinor:=graph.minMinor;
   if graph.preferHighest then begin
    requestedMajor:=availMajor;
    requestedMinor:=availMinor;
   end;
  end;
 procedure PrepareContextCreationPath;
  begin
   // Shared secondary window:
   // use function pointer cached on primary context and request same baseline version.
   if (shareWith<>0) and assigned(cachedWglCreateContextAttribs) then begin
    legacyRC:=0;
    wglCreateContextAttribsARB:=cachedWglCreateContextAttribs;
    availMajor:=graph.minMajor;
    availMinor:=graph.minMinor;
    requestedMajor:=graph.minMajor;
    requestedMinor:=graph.minMinor;
    if graph.preferHighest then begin
     // use values from graphInfo inherited from primary
     requestedMajor:=graph.minMajor;
     requestedMinor:=graph.minMinor;
    end;
    Log.Msg('Creating shared context via cached wglCreateContextAttribsARB');
   end else
    ProbePrimaryContext;
  end;
 procedure TryCreateModernContext;
  begin
   RC:=0;
   profileMask:=0;
   case requestedProfile of
    oglpCore:profileMask:=WGL_CONTEXT_CORE_PROFILE_BIT_ARB;
    oglpCompatibility:profileMask:=WGL_CONTEXT_COMPATIBILITY_PROFILE_BIT_ARB;
   end;
   // If special features are requested, try modern context path first.
   if (requestedProfile<>oglpCompatibility) or requestedDebug or requestedForward then begin
    if assigned(wglCreateContextAttribsARB) then begin
     BuildAttribs(requestedMajor,requestedMinor,profileMask,effectiveDebug,requestedForward);
     Log.Msg('wglCreateContextAttribsARB: DC=%d share=%d ver=%d.%d profile=%d flags=%d',
       [DC,shareWith,requestedMajor,requestedMinor,profileMask,flags]);
     RC:=wglCreateContextAttribsARB(DC,shareWith,@attribs[0]);
     if RC=0 then begin
      errCode:=GetLastError;
      Log.Warn('Failed to create modern GL context (err=%d / 0x%.8x)',[errCode,errCode]);
      // Some drivers reject debug+shared combination; retry without debug flag.
      if effectiveDebug and (shareWith<>0) then begin
       Log.Warn('Retry shared modern context without debug flag');
       effectiveDebug:=false;
       BuildAttribs(requestedMajor,requestedMinor,profileMask,false,requestedForward);
       RC:=wglCreateContextAttribsARB(DC,shareWith,@attribs[0]);
       if RC<>0 then
        Log.Warn('Shared modern context created without debug flag')
       else begin
        errCode:=GetLastError;
        Log.Warn('Retry failed (err=%d)',[errCode]);
       end;
      end;
     end;
    end else
     Log.Warn('wglCreateContextAttribsARB not available');
   end;
  end;
 procedure FinalizeContextSelection;
  begin
   // Finalize legacy/modern selection:
   // - modern created: drop legacy
   // - modern failed and non-core requested: fallback to legacy
   if legacyRC<>0 then begin
    if RC<>0 then
     wglDeleteContext(legacyRC)
    else if requestedProfile<>oglpCore then
     RC:=legacyRC; // fall back to legacy for non-core requests
   end;

   modernCreated:=(RC<>0) and (RC<>legacyRC);
   // Make resulting context current so caller can immediately initialize GL state.
   if RC<>0 then
    wglMakeCurrent(DC,RC)
   else
    wglMakeCurrent(0,0);
  end;
 procedure ApplyActualGraphInfo;
  begin
   graph.actualMajor:=0;
   graph.actualMinor:=0;
   if modernCreated then begin
    if requestedProfile=oglpCore then
     actualProfile:=oglpCore
    else
    if requestedProfile=oglpCompatibility then
     actualProfile:=oglpCompatibility
    else
     actualProfile:=oglpAny;
    graph.debugContext:=effectiveDebug;
    graph.forwardCompatible:=requestedForward;
   end else begin
    actualProfile:=oglpCompatibility;
    graph.debugContext:=false;
    graph.forwardCompatible:=false;
   end;
   graph.profile:=actualProfile;
   graph.requestAccepted:=RC<>0;
   if requestedProfile=oglpCore then
    graph.requestAccepted:=graph.requestAccepted and (graph.profile=oglpCore);
   if requestedDebug then
    graph.requestAccepted:=graph.requestAccepted and graph.debugContext;
   if requestedForward then
    graph.requestAccepted:=graph.requestAccepted and graph.forwardCompatible;
  end;
 begin
   result:=0;
   requestedProfile:=graph.profile;
   requestedDebug:=graph.debugContext;
   effectiveDebug:=requestedDebug;
   requestedForward:=graph.forwardCompatible;
   SetupPixelFormat;
   PrepareContextCreationPath;
   TryCreateModernContext;
   FinalizeContextSelection;
   ApplyActualGraphInfo;
   // Keep graph flags consistent with actual created context.
   if RC=0 then
    raise EError.Create('Can''t create OpenGL context (shared=%d, min=%d.%d, profile=%d, debug=%d, forward=%d)',
      [integer(shareWith<>0),graph.minMajor,graph.minMinor,integer(requestedProfile),ord(requestedDebug),ord(requestedForward)]);
   context:=RC;
   result:=context;
  end;

procedure TWinGLWindow.InitGraph;
begin
  with graphInfo do begin
    minMajor:=oglContextTemplate.minMajor;
    minMinor:=oglContextTemplate.minMinor;
    profile:=oglContextTemplate.profile;
    debugContext:=oglContextTemplate.debugContext;
    forwardCompatible:=oglContextTemplate.forwardCompatible;
    preferHighest:=oglContextTemplate.preferHighest;
    actualMajor:=0;
    actualMinor:=0;
    requestAccepted:=false;
  end;
  CreateOpenGLContext(graphInfo);
  oglContextInfo:=graphInfo;
end;

procedure TWinGLWindow.InitGraphShared(primary:TWindow;mainContextReleased:boolean=false);
 var
  src:TWinGLWindow;
  vao:cardinal;
 begin
  ASSERT(primary<>nil);
  ASSERT(primary is TWinGLWindow,'Primary must be TWinGLWindow');
  src:=TWinGLWindow(primary);
  ASSERT(src.context<>0,'Primary window has no GL context');
  graphInfo:=src.graphInfo; // inherit context description
  graphInfo.actualMajor:=0;
  graphInfo.actualMinor:=0;
  graphInfo.requestAccepted:=false;
  if not mainContextReleased then begin
   Atomic.Exchange(glShareState,glcsReleaseRequested);
   Log.Msg('AddWindow: requesting GL context release from main thread');
   while glShareState<>glcsReleased do
    CoreTime.Sleep(1);
   Log.Msg('AddWindow: main thread released GL context');
  end else
   Log.Msg('AddWindow: main thread context already released by caller');
  try
   CreateOpenGLContext(graphInfo,src.context);
   oglContextInfo:=graphInfo;
   SetupGLDebugOutputForCurrentContext(graphInfo,'secondary:'+name);
   // core profile requires a bound VAO before any draw call
   if graphInfo.profile=oglpCore then begin
    vao:=0;
    glGenVertexArrays(1,@vao);
    glBindVertexArray(vao);
    contextVAO:=vao;
    Log.Msg('Extra window VAO created: %d',[vao]);
   end;
  finally
   if not mainContextReleased then
    Atomic.Exchange(glShareState,glcsReady); // signal main thread to reacquire
  end;
 end;

procedure TWinGLWindow.PresentFrame;
 var
  DC:HDC;
 begin
   // Service deferred handoff request on the main window thread.
   if self=mainWindow then
    if Atomic.CmpExchange(glShareState,glcsReleased,glcsReleaseRequested)=glcsReleaseRequested then begin
     ReleaseGraphContext;
     Log.Msg('Main thread released GL context for AddWindow');
     while glShareState<>glcsReady do
      CoreTime.Sleep(1);
     ActivateGraphContext;
     Log.Msg('Main thread reacquired GL context');
    end;
   DC:=getDC(window);
   if not SwapBuffers(DC) then
    Log.Msg('Swap error: %d',[GetLastError]);
   ReleaseDC(window,DC);
 end;

function TWinGLWindow.SetVSync(divider: integer): boolean;
 begin
  result:=WGL_EXT_swap_control;
  if result then wglSwapIntervalEXT(divider);
  if result then
   Log.Msg('VSync (window): swap interval=%d',[divider]);
 end;

procedure TWinGLWindow.DoneGraph;
 begin
  if contextVAO<>0 then begin
   glDeleteVertexArrays(1,@contextVAO);
   Log.Msg('Extra window VAO deleted: %d',[contextVAO]);
   contextVAO:=0;
  end;
  if context<>0 then begin
   wglMakeCurrent(0,0);
   wglDeleteContext(context);
  end;
  context:=0;
 end;

procedure TWinGLWindow.ReleaseGraphContext;
 begin
  wglMakeCurrent(0,0);
 end;

procedure TWinGLWindow.ActivateGraphContext;
 var
  dc:HDC;
 begin
  if context=0 then exit;
  dc:=GetDC(window);
  if not wglMakeCurrent(dc,context) then
   Log.Warn('Failed to activate GL context: %d',[GetLastError]);
  ReleaseDC(window,dc);
 end;

procedure TWinGLWindow.Configure(params:TGameSettings);
 const
  SWP_APPLY=SWP_NOZORDER or SWP_NOACTIVATE or SWP_FRAMECHANGED;
 var
  r,work:TRect;
  style:cardinal;
  w,h:integer;
  windowed,zoomed:boolean;
 begin
   Log.Msg('Configure window %s: %s, frame %d',[name,params.mode.ToString,ord(params.frame)]);
   // The window modes keep the standard style whatever the frame is: maximizing to the work
   // area, Win+arrows, snap and the system menu depend on it. An app-drawn frame only removes
   // the non-client area (WM_NCCALCSIZE)
   windowed:=params.mode in [dmWindow,dmFixedWindow];
   if not configured then begin // startup state: only the resizable window is maximized
    configured:=true;
    wasMaximized:=params.maximized and (dmWindow in [params.mode,params.altMode]);
   end;
   if windowed then frame:=params.frame
    else frame:=TWindowFrame.System;
   if windowed then begin
    style:=WS_OVERLAPPED or WS_CAPTION or WS_SYSMENU or WS_MINIMIZEBOX;
    if params.mode=dmWindow then style:=style or WS_THICKFRAME or WS_MAXIMIZEBOX;
   end else
    style:=WS_POPUP;

   zoomed:=IsZoomed(window);
   if zoomed and not windowed then begin // fullscreen from the maximized state
    wasMaximized:=true;
    windows.ShowWindow(window,SW_RESTORE);
    zoomed:=false;
   end;
   SetWindowLong(window,GWL_STYLE,longint(style));

   w:=params.width;
   h:=params.height;
   if windowed and zoomed then // a maximized window keeps its place, only the frame is updated
    SetWindowPos(window,0,0,0,0,0,SWP_APPLY or SWP_NOMOVE or SWP_NOSIZE)
   else
   if windowed then begin
    GetWindowRect(window,r);
    work:=MonitorWorkArea(r);
    r:=Rect(0,0,w,h);
    if params.frame<>TWindowFrame.Custom then AdjustWindowRect(r,style,false);
    r.Offset(-r.left,-r.top);
    // If window is too large
    r.Right:=Clamp(r.Right,0,work.Width);
    r.Bottom:=Clamp(r.Bottom,0,work.Height);
    // Center on the work area of its monitor
    r.Offset(work.left+(work.Width-r.Width) div 2,work.top+(work.Height-r.Height) div 2);
    SetWindowPos(window,0,r.left,r.top,r.Width,r.Height,SWP_APPLY);
   end else
    SetWindowPos(window,0,0,0,game.screenWidth,game.screenHeight,SWP_APPLY);

   // The normal size is set above, so Restore returns to it. Shown maximized at once: no flash
   if windowed and wasMaximized then begin
    wasMaximized:=false;
    windows.ShowWindow(window,SW_SHOWMAXIMIZED);
   end else
    windows.ShowWindow(window,SW_SHOW);
   UpdateWindow(Window);

   GetWindowRect(window,r);
   Log.Msg('WindowRect: %d:%d',[r.Right-r.Left,r.Bottom-r.top]);
   GetClientRect(window,r);
   Log.Msg('ClientRect: %d:%d',[r.Right-r.Left,r.Bottom-r.top]);
   RequestResize(r.Width,r.Height);
 end;

procedure TWinGLWindow.SetCaption(text:string);
 var
  wst:String16;
  t:PWideChar;
 begin
  wst:=Str16(text);
  t:=@wst[1];
  SetWindowTextW(window,t);
 end;

procedure TWinGLWindow.Show(show:boolean);
 begin
  //LoadCursor(0,IDC_ARROW);
  if show then begin
   if IsZoomed(window) then windows.ShowWindow(window,SW_SHOW) // SW_SHOWNORMAL would restore it
    else windows.ShowWindow(window,SW_SHOWNORMAL);
  end else
   windows.ShowWindow(window,SW_HIDE);
 end;


end.