// Авторы файла: aim.
// Содержимое: Объект окна приложения DirectX - Window. Окно создается в соответствии
// с заданными в объекте Options параметрами.
// Потокобезопасность: 

unit u_window;
{$mode objfpc}

interface

uses
	u_log, u_options,
	windows, Direct3D9, D3DX9;

type
	// Описывает графический режим.
	TGraphicMode = record
		Mode: string;      // Название режима.
		BitPerPixel: Byte; // Бит на пиксель.
		Width: Integer;    // Горизонтальное разрешение экрана.
		Height: Integer;   // Вертикальное разрешение экрана.
	end;

const
	// Набор доступных графических режимов.
	GraphicModes: array[0..5] of TGraphicMode = (
		(Mode: '800x600x16';   BitPerPixel: 16; Width: 800;  Height: 600 ),
		(Mode: '800x600x32';   BitPerPixel: 32; Width: 800;  Height: 600 ),
		(Mode: '1024x768x16';  BitPerPixel: 16; Width: 1024; Height: 768 ),
		(Mode: '1024x768x32';  BitPerPixel: 32; Width: 1024; Height: 768 ),
		(Mode: '1280x1024x16'; BitPerPixel: 16; Width: 1280; Height: 1024),
		(Mode: '1280x1024x32'; BitPerPixel: 32; Width: 1280; Height: 1024)
	);

type
	TD3DWindow = class
	private
		WinHandle: HWND;
		D3DDevice: IDirect3DDevice9;
		D3DSprite: ID3DXSprite;
		D3DObject: IDirect3D9;
		D3DPP: D3DPRESENT_PARAMETERS;
		FActive: Boolean;
		Mode: TGraphicMode;
		function MessageProc(Msg: UINT; WParam: WPARAM; LParam: LPARAM): LResult;
		function TestDeviceLost: Boolean;
		function FindMode(const NewMode: string): TGraphicMode;
		function GetFullscreenMode: Boolean;
		procedure InitWindow(const WinClassName, WinCaption: AnsiString);
		procedure InitDirect3D;
		procedure SetFullscreenMode(Enable: Boolean);
		procedure SetMode(const NewMode: String);
	public
		constructor Create(const WinClassName, WinCaption: AnsiString);
		destructor Destroy; override;
		// Обработчик окна.
		procedure Update;
		// Вызывается, когда происходит потеря устройства.
		procedure OnLostDevice; virtual;
		// Вызывается, когда происходит сброс устройства.
		procedure OnResetDevice; virtual;
		// Проверка и переключение полноэкранного/оконного режимов.
		property Fullscreen: Boolean read GetFullscreenMode write SetFullscreenMode;
		// Получение и установка разрешения экрана.
		property ScreenMode: String read Mode.Mode write SetMode;
		// Дескриптор окна.
		property Handle: HWND read WinHandle;
		// Интерфейс устройства Direct3D.
		property Device: IDirect3DDevice9 read D3DDevice;
		// Интерфейс спрайтов Direct3D.
		property Sprite: ID3DXSprite read D3DSprite;
		// True, если устройство потеряно.
		property DeviceLost: Boolean read TestDeviceLost;
		// Пока окно не закрыто - true.
		property Active: Boolean read FActive;
	end;

const
	Window: TD3DWindow = nil;

implementation

const
	WindowStyle = WS_CAPTION or WS_SYSMENU;

// Оконная функция.
function WndProc(Wnd: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM): LongInt; stdcall;
const
	Minimized: Boolean = false;
begin
	if Window = nil then
		Result := DefWindowProc(Wnd, Msg, WParam, LParam)
	else
		Result := Window.MessageProc(Msg, WParam, LParam);
end;

// TWindow -----

// private

function TD3DWindow.MessageProc(Msg: UINT; WParam: WPARAM; LParam: LPARAM): LResult;
begin
	case Msg of
		WM_DESTROY: begin
			PostQuitMessage(0);
		end;
		WM_SYSCOMMAND: begin
			if (WParam = SC_SCREENSAVE) or (WParam = SC_MONITORPOWER) then
				Result := 0
			else
				Result := DefWindowProc(WinHandle, Msg, WParam, LParam);
		end;
		WM_SYSKEYUP: begin
			if WParam = VK_RETURN then SetFullscreenMode(D3DPP.Windowed)
			else if Char(WParam) = '1' then SetMode('800x600x32')
			else if Char(WParam) = '2' then SetMode('1024x768x32')
			else if Char(WParam) = '3' then SetMode('1280x1024x32');
		end;
		else
			Result := DefWindowProc(WinHandle, Msg, WParam, LParam);
  end;
end;

function TD3DWindow.TestDeviceLost: Boolean;
var
	hr: HResult;
begin
	// Получение состояния графического устройства.
	hr := D3DDevice.TestCooperativeLevel;
	
	if hr = D3DERR_DEVICELOST then begin
		// If the device is lost and cannot be reset yet then
		// sleep for a bit and we'll try again on the next 
		// message loop cycle.
		Sleep(20);
		Result := true;
	end else if hr = D3DERR_DRIVERINTERNALERROR then begin
		// Ошибка драйвера, выход.
		Log.Fatal('Window', 'Internal Driver Error.');
	end else if hr = D3DERR_DEVICENOTRESET then begin
		// The device is lost but we can reset and restore it.
		OnLostDevice;
		D3DDevice.Reset(D3DPP);
		OnResetDevice;
		Result := false;
	end else
		Result := false;
end;

function TD3DWindow.FindMode(const NewMode: string): TGraphicMode;
var
	i, ModeNum: Integer;
begin
	ModeNum := Low(GraphicModes);
	for i := Low(GraphicModes) to High(GraphicModes) do
		if GraphicModes[i].Mode = NewMode then begin
			ModeNum := i;
			Break;
		end;
	result := GraphicModes[ModeNum];
end;

function TD3DWindow.GetFullscreenMode: Boolean;
begin
	Result := not D3DPP.Windowed;
end;

procedure TD3DWindow.InitWindow(const WinClassName, WinCaption: AnsiString);
var
	wcex: TWndClassEx;
	hCur: HCURSOR;
	Rec: TRect;
begin
	// Регистрируем класс окна.
	wcex.cbSize := SizeOf(WNDCLASSEX);
	wcex.style := CS_HREDRAW or CS_VREDRAW;
	wcex.lpfnWndProc := @WndProc;
	wcex.cbClsExtra := 0;
	wcex.cbWndExtra := 0;
	wcex.hInstance := hInstance;
	wcex.hIcon := 0;
	hCur := LoadCursorFromFile(PChar(Options.Paths.Cursor));
	if hCur = 0 then begin
		Log.Error('Window', 'Can not load cursor from a file.');
		wcex.hCursor := 0;
	end else
		wcex.hCursor := hCur;
	wcex.hbrBackground := HBRUSH(GetStockObject(BLACK_BRUSH));
	wcex.lpszMenuName := nil;
	wcex.lpszClassName := PChar(WinClassName);
	wcex.hIconSm := 0;
	if RegisterClassEx(wcex) = 0 then
		Log.Fatal('Window', 'Registering window class error.');

	// Вычисляем необходимый размер окна.
	with Rec do begin
		Left := 0;
		Top := 0;
		Right := Mode.Width;
		Bottom := Mode.Height;
	end;
	AdjustWindowRectEx(Rec, WindowStyle, false, WS_EX_APPWINDOW);
	// Создаем окно приложения.
	WinHandle := CreateWindowEx(
		WS_EX_APPWINDOW,
		PChar(WinClassName),
		PChar(WinCaption),
		WindowStyle,
		CW_USEDEFAULT, CW_USEDEFAULT,
		Rec.Right - Rec.Left, Rec.Bottom - Rec.Top,
		0,
		0,
		hInstance,
		nil
	);
	if WinHandle = 0 then
		Log.Fatal('Window', 'Can not create main window.');

	FActive := true;
	ShowWindow(WinHandle, SW_SHOW);
	UpdateWindow(WinHandle);
	SetForegroundWindow(WinHandle);
	Log.Write('Window', 'Main window was succesfuly created.');
end;

procedure TD3DWindow.InitDirect3D;
var
	DisplayMode: D3DDISPLAYMODE;
	Caps: D3DCAPS9;
	DevBehaviorFlags: DWORD;
begin
	// Создание объекта Direct3D.
	D3DObject := Direct3DCreate9(D3D_SDK_VERSION);
	if D3DObject = nil then
		Log.Fatal('Window', 'Creating Direct3D object failed.');

	// Verify hardware support for specified formats in windowed and full screen modes.
	D3DObject.GetAdapterDisplayMode(D3DADAPTER_DEFAULT, DisplayMode);
	D3DObject.CheckDeviceType(D3DADAPTER_DEFAULT, Options.Graphic.DeviceType, DisplayMode.Format, DisplayMode.Format, true);
	D3DObject.CheckDeviceType(D3DADAPTER_DEFAULT, Options.Graphic.DeviceType, D3DFMT_X8R8G8B8, D3DFMT_X8R8G8B8, false);

	// Check for requested vertex Updateing and pure device.
	D3DObject.GetDeviceCaps(D3DADAPTER_DEFAULT, Options.Graphic.DeviceType, Caps);
	
	DevBehaviorFlags := 0;
	if Caps.DevCaps and D3DDEVCAPS_HWTRANSFORMANDLIGHT <> 0 then
		DevBehaviorFlags := DevBehaviorFlags or Options.Graphic.RequestedVP
	else
		DevBehaviorFlags := DevBehaviorFlags or D3DCREATE_SOFTWARE_VERTEXPROCESSING;

	// If pure device and HW T&L supported.
	if (Caps.DevCaps and D3DDEVCAPS_PUREDEVICE <> 0) and (DevBehaviorFlags and D3DCREATE_HARDWARE_VERTEXPROCESSING <> 0) then
		DevBehaviorFlags := DevBehaviorFlags or D3DCREATE_PUREDEVICE;

	// Fill out the D3DPRESENT_PARAMETERS structure.
	with D3DPP do begin
		BackBufferWidth            := 0; 
		BackBufferHeight           := 0;
		BackBufferFormat           := D3DFMT_UNKNOWN;
		BackBufferCount            := 1;
		MultiSampleType            := D3DMULTISAMPLE_NONE;
		MultiSampleQuality         := 0;
		SwapEffect                 := D3DSWAPEFFECT_DISCARD; 
		hDeviceWindow              := WinHandle;
		Windowed                   := true;
		EnableAutoDepthStencil     := true; 
		AutoDepthStencilFormat     := D3DFMT_D24S8;
		Flags                      := 0;
		FullScreen_RefreshRateInHz := D3DPRESENT_RATE_DEFAULT;
		PresentationInterval       := D3DPRESENT_INTERVAL_IMMEDIATE;
	end;

	// Создание устройства.
	D3DObject.CreateDevice(D3DADAPTER_DEFAULT, Options.Graphic.DeviceType, WinHandle, DevBehaviorFlags, @D3DPP, D3DDevice);
	
	// Создание интерфейса спрайтов.
	D3DXCreateSprite(D3DDevice, D3DSprite);
	
	Log.Write('Window', 'Direct3D device was successfuly created.');
end;

procedure TD3DWindow.SetFullscreenMode(Enable: Boolean);
var
	Rec: TRect;
begin
	// Если уже в нужном режиме, выход.
	if Enable = GetFullscreenMode then exit;
	
	if Enable then begin
		with D3DPP do begin
			BackBufferFormat := D3DFMT_X8R8G8B8;
			BackBufferWidth  := Mode.Width;
			BackBufferHeight := Mode.Height;
			Windowed         := false;
		end;
		// Изменение стиля и параметров окна.
		SetWindowLong(WinHandle, GWL_STYLE, WS_POPUP);
		SetWindowPos(WinHandle, HWND_TOP, 0, 0, Mode.Width, Mode.Height, SWP_NOZORDER or SWP_SHOWWINDOW);	
		Log.Write('Window', 'Fullscreen mode was enabled.');
	end else begin
		with Rec do begin
			Left := 0;
			Top := 0;
			Right := Mode.Width;
			Bottom := Mode.Height;
		end;
		AdjustWindowRectEx(Rec, WindowStyle, false, WS_EX_APPWINDOW);
		with D3DPP do begin
			BackBufferFormat := D3DFMT_UNKNOWN;
			BackBufferWidth  := Rec.Right - Rec.Left;
			BackBufferHeight := Rec.Bottom - Rec.Top;
			Windowed         := true;
		end;
		// Изменение стиля и параметров окна.
		SetWindowLong(WinHandle, GWL_STYLE, WindowStyle);
		SetWindowPos(WinHandle, HWND_NOTOPMOST, 100, 100, Rec.Right, Rec.Bottom, SWP_SHOWWINDOW);
		Log.Write('Window', 'Fullscreen mode was disabled.');
	end;
	OnLostDevice;
	D3DDevice.Reset(D3DPP);
	OnResetDevice;
end;

procedure TD3DWindow.SetMode(const NewMode: string);
var
	Rec: TRect;
begin
	Mode := FindMode(NewMode);
	
	if GetFullscreenMode then begin
		with D3DPP do begin
			BackBufferFormat := D3DFMT_X8R8G8B8;
			BackBufferWidth  := Mode.Width;
			BackBufferHeight := Mode.Height;
			Windowed         := false;
		end;
		// Изменение параметров окна.
		SetWindowPos(WinHandle, HWND_TOP, 0, 0, Mode.Width, Mode.Height, SWP_NOZORDER or SWP_SHOWWINDOW);	
	end else begin
		with Rec do begin
			Left := 0;
			Top := 0;
			Right := Mode.Width;
			Bottom := Mode.Height;
		end;
		AdjustWindowRectEx(Rec, WindowStyle, false, WS_EX_APPWINDOW);
		with D3DPP do begin
			BackBufferFormat := D3DFMT_UNKNOWN;
			BackBufferWidth  := Rec.Right - Rec.Left;
			BackBufferHeight := Rec.Bottom - Rec.Top;
			Windowed         := true;
		end;
		// Изменение параметров окна.
		SetWindowPos(WinHandle, HWND_NOTOPMOST, 100, 100, Rec.Right - Rec.Left, Rec.Bottom - Rec.Top, SWP_SHOWWINDOW);
	end;
	
	Log.Write('Window', 'Screen mode' + NewMode + ' was set.');
	OnLostDevice;
	D3DDevice.Reset(D3DPP);
	OnResetDevice;
end;

// public

constructor TD3DWindow.Create(const WinClassName, WinCaption: AnsiString);
begin
	D3DDevice := nil;
	Mode := FindMode(Options.Graphic.Mode);
	InitWindow(WinClassName, WinCaption);
	InitDirect3D;
	SetFullscreenMode(Options.Graphic.Fullscreen);
	OnResetDevice;
end;

destructor TD3DWindow.Destroy;
begin
	SendMessage(WinHandle, WM_DESTROY, 0, 0);
	FActive := false;
	WinHandle := 0;
	Log.Write('Window', 'Main window was destroyed.');
end;

procedure TD3DWindow.Update;
var
	Msg: TMSG;
begin
	if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then begin
		if Msg.Message = WM_QUIT then begin
			FActive := false;
		end else begin
			TranslateMessage(Msg);
			DispatchMessage(Msg);
		end;
	end;
end;

procedure TD3DWindow.OnLostDevice;
begin
	D3DSprite.OnLostDevice;
end;

procedure TD3DWindow.OnResetDevice;
begin
	D3DSprite.OnResetDevice;
end;

end.