administrator/pascalabcnet
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

POCGL update

Browse source
This commit is contained in:
Sun Serega 2022-03-25 13:27:17 +02:00
parent 6211fe2275
commit d2fdeb81fe
22 changed files with 22445 additions and 20628 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

55
InstallerSamples/OpenGL и OpenCL/OpenCLABC/0Простейшие примеры/MatrMlt.pas
View file

@ -13,7 +13,8 @@ begin
// Чтение и компиляция .cl файла
{$resource MatrMlt.cl} // Засовывает файл MatrMlt.cl внуть .exe
// Вообще лучше прекомпилировать .cl файл (загружать в переменную ProgramCode)
// Вообще лучше прекомпилировать .cl файл
// (загружать в переменную типа ProgramCode)
// И сохранять с помощью метода ProgramCode.SerializeTo
// А полученный бинарник уже подключать через $resource
var code := new ProgramCode(Context.Default,
@ -26,12 +27,12 @@ begin
'Матрица A:'.Println;
var A_Matr := MatrRandomReal(MatrW,MatrW,0,1).Println;
Writeln;
Println;
var A := new MemorySegment(MatrByteSize);
'Матрица B:'.Println;
var B_Mart := MatrRandomReal(MatrW,MatrW,0,1).Println;
Writeln;
Println;
var B := new MemorySegment(MatrByteSize);
var C := new MemorySegment(MatrByteSize);
@ -39,7 +40,7 @@ begin
'Вектор V1:'.Println;
var V1_Arr := ArrRandomReal(MatrW);
V1_Arr.Println;
Writeln;
Println;
var V1 := new MemorySegment(VecByteSize);
var V2 := new MemorySegment(VecByteSize);
@ -51,38 +52,44 @@ begin
// Подготовка очередей выполнения
var Calc_C_Q :=
code['MatrMltMatr'].NewQueue.AddExec2(MatrW, MatrW, // Выделяем ядра в форме квадрата, всего MatrW*MatrW ядер
A.NewQueue.AddWriteArray2(A_Matr),
B.NewQueue.AddWriteArray2(B_Mart),
// Выделяем ядра в форме квадрата, всего MatrW*MatrW ядер
code['MatrMltMatr'].NewQueue.ThenExec2(MatrW, MatrW,
A.NewQueue.ThenWriteArray2(A_Matr),
B.NewQueue.ThenWriteArray2(B_Mart),
C,
W
);
// DiscardResult не обязательно, но желательно
// чтобы не использовать результат случайно
).DiscardResult;
var Otp_C_Q :=
C.NewQueue.AddReadArray2(A_Matr) +
HPQ(()->
C.NewQueue.ThenGetArray2&<real>(MatrW, MatrW)
.ThenQuickUse(C_Matr->
begin
'Матрица С = A*B:'.Println;
A_Matr.Println;
Writeln;
end);
C_Matr.Println;
Println;
end).DiscardResult;
var Calc_V2_Q :=
code['MatrMltVec'].NewQueue.AddExec1(MatrW,
code['MatrMltVec'].NewQueue.ThenExec1(MatrW,
C,
V1.NewQueue.AddWriteArray1(V1_Arr),
V1.NewQueue.ThenWriteArray1(V1_Arr),
V2,
W
);
).DiscardResult;
var Otp_V2_Q :=
V2.NewQueue.AddReadArray1(V1_Arr) +
HPQ(()->
V2.NewQueue.ThenGetArray1&<real>
.ThenQuickUse(V2_Arr->
begin
'Вектор V2 = C*V1:'.Println;
V1_Arr.Println;
Writeln;
end);
V2_Arr.Println;
Println;
// Единственный DiscardResult, меняющий поведение очереди:
// С ним не выделяются ресурсы на то, чтобы передать V2_Arr
// Из результата ThenGetArray1 в результат SyncInvoke
end).DiscardResult;
// Выполнение всего и сразу асинхронный вывод
@ -95,6 +102,10 @@ begin
);
except
on e: Exception do Writeln(e); // Эта строчка позволяет выводить всю ошибку, если при выполнении Context.SyncInvoke возникла ошибка
// except позволяет получать список ошибку,
// возникшую при выполнении SyncInvoke
on ae: System.AggregateException do
foreach var e in ae.InnerExceptions do
Println(e);
end;
end.

2
InstallerSamples/OpenGL и OpenCL/OpenCLABC/0Простейшие примеры/SimpleAddition.pas
View file

@ -13,7 +13,7 @@ var A := new CLArray<integer>(10);
prog['TEST'].Exec1(10, // Используем 10 ядер
// Заполняем весь массив значениями (1), прямо перед выполнением
A.NewQueue.AddFillValue(1)
A.NewQueue.ThenFillValue(1)
);

6
InstallerSamples/OpenGL и OpenCL/OpenCLABC/Игра жизнь/Игра жизнь.pas
View file

@ -43,14 +43,14 @@ try
var Q_1Step :=
code['CalcStep']
.NewQueue
.AddExec2(W,W,
.ThenExec2(W,W,
B, B_temp, W
) +
B.NewQueue.AddCopyFrom(B_temp)
B.NewQueue.ThenCopyFrom(B_temp)
;
var Q_Otp :=
B.NewQueue
.AddGetArray2&<byte>(W,W)
.ThenGetArray2&<byte>(W,W)
.ThenUse(field->
begin
// Если уже слишком далеко вперёд насчитали - можно немного отдохнуть

2
InstallerSamples/OpenGL и OpenCL/OpenCLABC/Прекомпиляция ProgramCode/Использовать.pas
View file

@ -15,7 +15,7 @@ begin
prog['TEST'].Exec1(10, // Используем 10 ядер
A.NewQueue.AddFillValue(1)
A.NewQueue.ThenFillValue(1)
);

172
InstallerSamples/OpenGL и OpenCL/OpenGL/!Крутящийся треугольник/Крутящийся треугольник.pas
View file

@ -1,172 +0,0 @@
{$reference System.Windows.Forms.dll}
{$reference System.Drawing.dll}
// Данный пример демонстрирует запуск простейшей программы с модулем OpenGL
// Примите во внимание, что методы из gl_gdi. - могут служить только временной заменой в серьёзной программе
// (По крайней мере в данной версии. В будущем, возможно, gl_gdi будет улучшено)
// Они использованы тут, чтоб пример был проще
uses System.Windows.Forms;
uses System;
uses OpenGL;
uses Common in '..\Common';
{$apptype windows} // убираем консоль
const dy = -Sin(Pi / 6) / 2;
begin
// Создаём и настраиваем окно
var f := new Form;
f.StartPosition := FormStartPosition.CenterScreen;
f.ClientSize := new System.Drawing.Size(500, 500);
f.FormBorderStyle := FormBorderStyle.Fixed3D;
// Если окно закрылось - надо сразу завершить программу
f.Closed += (o,e)->Halt();
// Настраиваем поверхность рисования
var hdc := gl_gdi.InitControl(f);
// Настраиваем перерисовку
gl_gdi.SetupControlRedrawing(f, hdc, EndFrame->
begin
{$region Настройка глобальных параметров OpenGL}
// При создании экземпляра OpenGL.gl инициализируются некоторые функции
// Это необходимо для всех функций из OpenGL1.2 и выше, потому что они локальны для контекста OpenGL
gl := new OpenGL.gl<PlWin>;
{$endregion Настройка глобальных параметров OpenGL}
{$region Инициализация переменных}
var vertex_pos_buffer: gl_buffer;
gl.CreateBuffers(1, vertex_pos_buffer);
gl.NamedBufferData(
vertex_pos_buffer,
new IntPtr(3*sizeof(Vec2f)),
ArrGen(3, i->
begin
var rot := i * Pi * 2 / 3;
Result := new Vec2f(
Sin(rot),
Cos(rot) + dy
);
end),
VertexBufferObjectUsage.STATIC_DRAW
);
var vertex_clr_buffer: gl_buffer;
gl.CreateBuffers(1, vertex_clr_buffer);
gl.NamedBufferData(
vertex_clr_buffer,
new IntPtr(3*sizeof(Vec3f)),
new Vec3f[](
new Vec3f(1,0,0),
new Vec3f(0,1,0),
new Vec3f(0,0,1)
),
VertexBufferObjectUsage.STATIC_DRAW
);
var element_buffer: gl_buffer;
gl.CreateBuffers(1, element_buffer);
gl.NamedBufferData(
element_buffer,
new IntPtr(3*sizeof(byte)),
new byte[](
0,1,2
),
VertexBufferObjectUsage.STATIC_DRAW
);
var vertex_shader := InitShader('Крутящийся треугольник.vert', ShaderType.VERTEX_SHADER);
var sprog := InitProgram(vertex_shader{, другие_шейдеры});
var uniform_rot_k := gl.GetUniformLocation(sprog, 'rot_k');
var attribute_position := gl.GetAttribLocation(sprog, 'position');
var attribute_color := gl.GetAttribLocation(sprog, 'color');
var t := new Stopwatch;
t.Start;
{$endregion Инициализация переменных}
// Для поиска, где возникла ошибка
// var RaiseIfError := procedure->
// begin
//
// // получаем тип последней ошибки
// var err := gl.GetError;
// // и если ошибка есть - выводим её
// if err<>ErrorCode.NO_ERROR then raise new System.Exception(err.ToString);
//
// end;
while true do
begin
// очищаем окно в начале перерисовки
gl.Clear(ClearBufferMask.COLOR_BUFFER_BIT);
gl.UseProgram(sprog);
gl.Uniform1f(uniform_rot_k, Cos( t.Elapsed.Ticks * 0.0000002 ) );
gl.BindBuffer(BufferTarget.ARRAY_BUFFER, vertex_pos_buffer);
gl.VertexAttribPointer(
attribute_position,
2,
VertexAttribPointerType.FLOAT,
false,
8,
IntPtr.Zero
);
gl.EnableVertexAttribArray(attribute_position);
gl.BindBuffer(BufferTarget.ARRAY_BUFFER, vertex_clr_buffer);
gl.VertexAttribPointer(
attribute_color,
3,
VertexAttribPointerType.FLOAT,
false,
12,
IntPtr.Zero
);
gl.EnableVertexAttribArray(attribute_color);
gl.BindBuffer(BufferTarget.ELEMENT_ARRAY_BUFFER, element_buffer);
gl.DrawElements(
PrimitiveType.TRIANGLES,
3,
DrawElementsType.UNSIGNED_BYTE,
IntPtr.Zero
);
gl.DisableVertexAttribArray(attribute_position);
gl.DisableVertexAttribArray(attribute_color);
// получаем тип последней ошибки
var err := gl.GetError;
// и если ошибка есть - выводим её
if err<>ErrorCode.NO_ERROR then Writeln(err);
gl.Finish;
// EndFrame меняет местами буферы и ждёт vsync
EndFrame;
end;
end);
Application.Run(f);
end.

149
InstallerSamples/OpenGL и OpenCL/OpenGLABC/!Крутящийся треугольник/Крутящийся треугольник.pas Normal file
View file

@ -0,0 +1,149 @@
{$reference System.Windows.Forms.dll}
{$reference System.Drawing.dll}
// Данный пример демонстрирует запуск простейшей программы с модулем OpenGL
// Примите во внимание, что модуль OpenGLABC будет сильно переделан
// Его текущее содержимое может служить только временной заменой в серьёзной программе
// Он использованы тут, чтобы пример был проще
uses System.Windows.Forms;
uses System;
uses OpenGL;
uses OpenGLABC;
uses Common in '..\Common';
{$apptype windows} // убираем консоль
const dy = -Sin(Pi / 6) / 2;
procedure RedrawProc(pl: PlatformLoader; EndFrame: ()->());
begin
{$region Настройка глобальных параметров OpenGL}
// При создании экземпляра OpenGL.gl в память загружаются адреса функций OpenGL
// Это необходимо для функций из OpenGL, потому что они локальны для контекста OpenGL
// Переменная pl указывает как надо загружать адреса
gl := new OpenGL.gl(pl);
{$endregion Настройка глобальных параметров OpenGL}
{$region Инициализация переменных}
var sprog := InitProgram(
InitShader('Крутящийся треугольник.vert', ShaderType.VERTEX_SHADER)
{, другие_шейдеры});
gl.UseProgram(sprog);
var uniform_rot_k := gl.GetUniformLocation(sprog, 'rot_k');
// Значения, которые будут передаваться в атрибут "position" в шейдере
begin
var vertex_pos_buffer: gl_buffer;
gl.CreateBuffers(1, vertex_pos_buffer);
gl.NamedBufferData(
vertex_pos_buffer,
new IntPtr(3*sizeof(Vec2f)),
ArrGen(3, i->
begin
var rot := i * Pi * 2 / 3;
Result := new Vec2f(
Sin(rot),
Cos(rot) + dy
);
end),
VertexBufferObjectUsage.STATIC_DRAW
);
var attribute_position := gl.GetAttribLocation(sprog, 'position');
// Оставляем всё настроенным и привязанным
// В данном случае можно, потому что шейдерная программа одна
gl.VertexAttribFormat(attribute_position, 2,VertexAttribType.FLOAT, false, 0);
gl.BindVertexBuffer(attribute_position, vertex_pos_buffer, IntPtr.Zero, sizeof(Vec2f));
gl.EnableVertexAttribArray(attribute_position);
end;
// Значения, которые будут передаваться в атрибут "color" в шейдере
begin
var vertex_clr_buffer: gl_buffer;
gl.CreateBuffers(1, vertex_clr_buffer);
gl.NamedBufferData(
vertex_clr_buffer,
new IntPtr(3*sizeof(Vec3f)),
|
new Vec3f(1,0,0),
new Vec3f(0,1,0),
new Vec3f(0,0,1)
|,
VertexBufferObjectUsage.STATIC_DRAW
);
var attribute_color := gl.GetAttribLocation(sprog, 'color');
gl.VertexAttribFormat(attribute_color, 3,VertexAttribType.FLOAT, false, 0);
gl.BindVertexBuffer(attribute_color, vertex_clr_buffer, IntPtr.Zero, sizeof(Vec3f));
gl.EnableVertexAttribArray(attribute_color);
end;
var t := new Stopwatch;
t.Start;
{$endregion Инициализация переменных}
// Для поиска, где возникла ошибка
// var RaiseIfError := procedure->
// begin
//
// // получаем тип последней ошибки
// var err := gl.GetError;
// // и если ошибка есть - выводим её
// if err<>ErrorCode.NO_ERROR then raise new System.Exception(err.ToString);
//
// end;
while true do
begin
// очищаем окно в начале перерисовки
gl.Clear(ClearBufferMask.COLOR_BUFFER_BIT);
gl.Uniform1f(uniform_rot_k, Cos( t.Elapsed.Ticks * 0.0000002 ) );
// Рисуем треугольники из всего 3 вершин (то есть получится 1 треугольник)
// Для каждой вершины берём 1 значение из vertex_pos_buffer и 1 из vertex_clr_buffer
gl.DrawArrays(PrimitiveType.TRIANGLES, 0,3);
// получаем тип последней ошибки
var err := gl.GetError;
// и если ошибка есть - выводим её
if err<>ErrorCode.NO_ERROR then Writeln(err);
gl.Finish;
// EndFrame меняет местами буферы и ждёт vsync
EndFrame;
end;
end;
begin
// Создаём и настраиваем окно
var f := new Form;
f.StartPosition := FormStartPosition.CenterScreen;
f.ClientSize := new System.Drawing.Size(500, 500);
f.FormBorderStyle := FormBorderStyle.Fixed3D;
// Если окно закрылось - надо сразу завершить программу
// Иначе поток перерисовки продолжит пытаться рисовать на закрытом окне
f.Closed += (o,e)->Halt();
// Настраиваем поверхность рисования
var hdc := OpenGLABC.gl_gdi.InitControl(f);
// Настраиваем перерисовку
f.Load += (o,e)->OpenGLABC.RedrawHelper.SetupRedrawThread(hdc, RedrawProc);
Application.Run(f);
end.

0
InstallerSamples/OpenGL и OpenCL/OpenGL/!Крутящийся треугольник/Крутящийся треугольник.vert → InstallerSamples/OpenGL и OpenCL/OpenGLABC/!Крутящийся треугольник/Крутящийся треугольник.vert
View file

2
InstallerSamples/OpenGL и OpenCL/OpenGL/Common.pas → InstallerSamples/OpenGL и OpenCL/OpenGLABC/Common.pas
View file

@ -3,7 +3,7 @@
uses System;
uses OpenGL;
var gl: OpenGL.gl<PlWin>;
var gl: OpenGL.gl;
{$region Shader}

0
InstallerSamples/OpenGL и OpenCL/OpenGL/Точки на поле/Empty.vert → InstallerSamples/OpenGL и OpenCL/OpenGLABC/Точки на поле/Empty.vert
View file

0
InstallerSamples/OpenGL и OpenCL/OpenGL/Точки на поле/Mandelbrot.frag → InstallerSamples/OpenGL и OpenCL/OpenGLABC/Точки на поле/Mandelbrot.frag
View file

0
InstallerSamples/OpenGL и OpenCL/OpenGL/Точки на поле/SinglePointToScreen.geom → InstallerSamples/OpenGL и OpenCL/OpenGLABC/Точки на поле/SinglePointToScreen.geom
View file

0
InstallerSamples/OpenGL и OpenCL/OpenGL/Точки на поле/Волны.frag → InstallerSamples/OpenGL и OpenCL/OpenGLABC/Точки на поле/Волны.frag
View file

0
InstallerSamples/OpenGL и OpenCL/OpenGL/Точки на поле/Минимум расстояний.frag → InstallerSamples/OpenGL и OpenCL/OpenGLABC/Точки на поле/Минимум расстояний.frag
View file

0
InstallerSamples/OpenGL и OpenCL/OpenGL/Точки на поле/Спирали.frag → InstallerSamples/OpenGL и OpenCL/OpenGLABC/Точки на поле/Спирали.frag
View file

0
InstallerSamples/OpenGL и OpenCL/OpenGL/Точки на поле/Сумма расстояний.frag → InstallerSamples/OpenGL и OpenCL/OpenGLABC/Точки на поле/Сумма расстояний.frag
View file

17
InstallerSamples/OpenGL и OpenCL/OpenGL/Точки на поле/Точки.pas → InstallerSamples/OpenGL и OpenCL/OpenGLABC/Точки на поле/Точки.pas
View file

@ -14,6 +14,7 @@
uses System.Windows.Forms;
uses System;
uses OpenGL;
uses OpenGLABC;
uses Common in '..\Common';
@ -164,9 +165,9 @@ begin
end;
{$endregion Управление}
gl_gdi.SetupControlRedrawing(f, gl_gdi.InitControl(f), EndFrame->
OpenGLABC.RedrawHelper.SetupRedrawThread(OpenGLABC.gl_gdi.InitControl(f), (pl, EndFrame)->
try
gl := new OpenGL.gl<PlWin>;
gl := new OpenGL.gl(pl);
var sprog: gl_program;
var last_fragment_shader := -1;
@ -174,7 +175,7 @@ begin
var uniform_point_count := 0;
var buffer_points: gl_buffer;
gl.CreateBuffers(1, buffer_points);
gl.BindBufferBase(BufferTarget.SHADER_STORAGE_BUFFER, 0, buffer_points);
gl.BindBufferBase(BufferTarget.SHADER_STORAGE_BUFFER, 0, buffer_points);
var uniform_aspect := 1;
var uniform_scale := 2;
@ -184,7 +185,7 @@ begin
// var buffer_temp: gl_buffer;
// gl.CreateBuffers(1, buffer_temp);
// gl.NamedBufferData(buffer_temp, new IntPtr(3*sizeof(real)), IntPtr.Zero, VertexBufferObjectUsage.DYNAMIC_READ);
// gl.BindBufferBase(BufferTarget.SHADER_STORAGE_BUFFER, 1, buffer_temp);
// gl.BindBufferBase(BufferTarget.SHADER_STORAGE_BUFFER, 1, buffer_temp);
var timings_max_count := 30;
var timings := new Queue<TimeSpan>(timings_max_count);
@ -198,10 +199,10 @@ begin
begin
var w_size := f.ClientSize;
gl.Viewport(0,0, w_size.Width,w_size.Height);
need_set_resize_ev := true;
camera.aspect := w_size.Width/w_size.Height;
gl.Viewport(0,0, w_size.Width,w_size.Height);
need_set_resize_ev := true;
camera.aspect := w_size.Width/w_size.Height;
end;
if last_fragment_shader<>curr_fragment_shader then

20
InstallerSamples/OpenGL и OpenCL/Гайд по использованию OpenGL и OpenCL.html
View file

@ -293,11 +293,13 @@ const on_start_folder = (folder_name, root_page)=>{
}
currently_loading_folder = res;
if (root_page) {
if (root_folder !== res) {
res.content_ref = root_page;
root_page.tree_obj = res;
document.getElementById("page-display-container-body").append(root_page);
if (!res.auto_fill_content) fix_links(root_page);
add_to_switch_list(root_page);
if (!res.auto_fill_content)
fix_links(root_page);
}
}
@ -334,6 +336,7 @@ const on_page_added = (page)=>{
currently_loading_folder.pages.push(res);
define_page_with_path(res.path, page);
add_to_switch_list(page);
fix_links(page);
if (!selected_page && !document.location.hash) select_page(page);
@ -465,13 +468,16 @@ const define_broken_lnk = (path, source, fixer)=>{
});
}
const fix_links = (page)=>{
const add_to_switch_list = (o)=>{
if (globalThis.last_page) {
page.page_l = last_page;
last_page.page_r = page;
if (add_to_switch_list.last_o) {
o.page_l = add_to_switch_list.last_o;
add_to_switch_list.last_o.page_r = o;
}
last_page = page;
add_to_switch_list.last_o = o;
}
const fix_links = (page)=>{
for (let lnk of page.getElementsByTagName('a'))
{

766
InstallerSamples/OpenGL и OpenCL/Справка OpenCLABC.html
View file

File diff suppressed because it is too large Load diff

20
InstallerSamples/OpenGL и OpenCL/Справка OpenGLABC.html
View file

@ -293,11 +293,13 @@ const on_start_folder = (folder_name, root_page)=>{
}
currently_loading_folder = res;
if (root_page) {
if (root_folder !== res) {
res.content_ref = root_page;
root_page.tree_obj = res;
document.getElementById("page-display-container-body").append(root_page);
if (!res.auto_fill_content) fix_links(root_page);
add_to_switch_list(root_page);
if (!res.auto_fill_content)
fix_links(root_page);
}
}
@ -334,6 +336,7 @@ const on_page_added = (page)=>{
currently_loading_folder.pages.push(res);
define_page_with_path(res.path, page);
add_to_switch_list(page);
fix_links(page);
if (!selected_page && !document.location.hash) select_page(page);
@ -465,13 +468,16 @@ const define_broken_lnk = (path, source, fixer)=>{
});
}
const fix_links = (page)=>{
const add_to_switch_list = (o)=>{
if (globalThis.last_page) {
page.page_l = last_page;
last_page.page_r = page;
if (add_to_switch_list.last_o) {
o.page_l = add_to_switch_list.last_o;
add_to_switch_list.last_o.page_r = o;
}
last_page = page;
add_to_switch_list.last_o = o;
}
const fix_links = (page)=>{
for (let lnk of page.getElementsByTagName('a'))
{

7872
bin/Lib/OpenCLABC.pas
View file

File diff suppressed because it is too large Load diff

33876
bin/Lib/OpenGL.pas
View file

File diff suppressed because it is too large Load diff

114
bin/Lib/OpenGLABC.pas
View file

@ -1,17 +1,111 @@
///

//*****************************************************************************************************\\
// 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;
interface
uses System;
uses OpenGL;
implementation
begin
Writeln('OpenGLABC');
Writeln(new System.NotImplementedException);
Readln;
Halt;
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.