Обновление POCGL
This commit is contained in:
SunSerega
parent
defdf17790
commit
2f189dbd5f
|
|
@ -0,0 +1,110 @@
|
|||
uses OpenCLABC;
|
||||
|
||||
const
|
||||
MatrW = 4; // можно поменять на любое положительное значение
|
||||
|
||||
VecByteSize = MatrW*8;
|
||||
MatrByteSize = MatrW*MatrW*8;
|
||||
|
||||
//ToDo issue компилятора:
|
||||
// - #1981
|
||||
|
||||
begin
|
||||
Randomize(0); // нужно чтоб каждое выполнение давало одинаковый результат
|
||||
try
|
||||
|
||||
// Чтение и компиляция .cl файла
|
||||
|
||||
{$resource MatrMlt.cl} // Засовывает файл MatrMlt.cl внуть .exe
|
||||
// Вообще, по хорошему - надо прекомпилировать .cl файл (загружать в переменную ProgramCode)
|
||||
// И сохранять с помощью метода ProgramCode.SerializeTo
|
||||
// А полученный бинарник уже подключать через $resource
|
||||
var code := new ProgramCode(
|
||||
System.IO.StreamReader.Create(
|
||||
GetResourceStream('MatrMlt.cl')
|
||||
).ReadToEnd
|
||||
);
|
||||
|
||||
// Подготовка параметров
|
||||
|
||||
'Матрица A:'.Println;
|
||||
var A_Matr := MatrRandomReal(MatrW,MatrW,0,1).Println;
|
||||
writeln;
|
||||
var A := new Buffer(MatrByteSize);
|
||||
|
||||
'Матрица B:'.Println;
|
||||
var B_Mart := MatrRandomReal(MatrW,MatrW,0,1).Println;
|
||||
writeln;
|
||||
var B := new Buffer(MatrByteSize);
|
||||
|
||||
var C := new Buffer(MatrByteSize);
|
||||
|
||||
'Вектор V1:'.Println;
|
||||
var V1_Arr := ArrRandomReal(MatrW);
|
||||
V1_Arr.Println;
|
||||
writeln;
|
||||
var V1 := new Buffer(VecByteSize);
|
||||
|
||||
var V2 := new Buffer(VecByteSize);
|
||||
|
||||
var N := new Buffer(4);
|
||||
|
||||
// (запись значений в параметры - позже, в очередях)
|
||||
|
||||
// Подготовка очередей выполнения
|
||||
|
||||
var Calc_C_Q :=
|
||||
code['MatrMltMatr'].NewQueue.AddExec2(MatrW, MatrW, // Выделяем ядра в форме квадрата, всего MatrW*MatrW ядер
|
||||
A.NewQueue.AddWriteArray(A_Matr) as CommandQueue<Buffer>,
|
||||
B.NewQueue.AddWriteArray(B_Mart) as CommandQueue<Buffer>,
|
||||
C,
|
||||
N.NewQueue.AddWriteValue(MatrW) as CommandQueue<Buffer>
|
||||
) as CommandQueue<Kernel>;
|
||||
|
||||
var Otp_C_Q :=
|
||||
C.NewQueue.AddReadArray(A_Matr) as CommandQueue<Buffer> +
|
||||
HPQ(()->
|
||||
lock output do
|
||||
begin
|
||||
'Матрица С = A*B:'.Println;
|
||||
A_Matr.Println;
|
||||
writeln;
|
||||
end);
|
||||
|
||||
var Calc_V2_Q :=
|
||||
code['MatrMltVec'].NewQueue.AddExec1(MatrW,
|
||||
C,
|
||||
V1.NewQueue.AddWriteArray(V1_Arr) as CommandQueue<Buffer>,
|
||||
V2,
|
||||
N
|
||||
) as CommandQueue<Kernel>;
|
||||
|
||||
var Otp_V2_Q :=
|
||||
V2.NewQueue.AddReadArray(V1_Arr) as CommandQueue<Buffer> +
|
||||
HPQ(()->
|
||||
lock output do
|
||||
begin
|
||||
'Вектор V2 = C*V1:'.Println;
|
||||
V1_Arr.Println;
|
||||
writeln;
|
||||
end);
|
||||
|
||||
// Выполнение всего и сразу асинхронный вывод
|
||||
|
||||
Context.Default.SyncInvoke(
|
||||
|
||||
Calc_C_Q +
|
||||
(
|
||||
Otp_C_Q * // выводить C и считать V2 можно одновременно, поэтому тут *, т.е. параллельное выполнение
|
||||
(
|
||||
Calc_V2_Q +
|
||||
Otp_V2_Q
|
||||
)
|
||||
)
|
||||
|
||||
);
|
||||
|
||||
except
|
||||
on e: Exception do writeln(e); // Эта строчка позволяет выводить всю ошибку, если при выполнении Context.SyncInvoke возникла ошибка
|
||||
end;
|
||||
end.
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
uses OpenCLABC;
|
||||
|
||||
begin
|
||||
|
||||
// Чтение и компиляция .cl файла
|
||||
|
||||
var prog := new ProgramCode(ReadAllText('SimpleAddition.cl'));
|
||||
|
||||
// Подготовка параметров
|
||||
|
||||
var A := new Buffer( 10 * sizeof(integer) ); // будет хранить 10 чисел типа "integer", то есть по 4 байта каждое
|
||||
|
||||
// Выполнение
|
||||
|
||||
prog['TEST'].Exec1(10, // используем 10 ядер
|
||||
|
||||
A.NewQueue.AddFillValue(1) // заполняем весь буфер единичками, прямо перед выполнением
|
||||
as CommandQueue<Buffer> //ToDo нужно только из за issue компилятора #1981, иначе получаем странную ошибку. Когда исправят - можно будет убрать
|
||||
|
||||
);
|
||||
|
||||
// Чтение и вывод результата
|
||||
|
||||
A.GetArray1&<integer>(10).Println; // читаем значение типа "array of integer", длинной в 10
|
||||
|
||||
end.
|
||||
|
|
@ -1,112 +0,0 @@
|
|||
uses OpenCLABC;
|
||||
|
||||
const
|
||||
MatrW = 4; // можно поменять на любое положительное значение
|
||||
|
||||
VecByteSize = MatrW*8;
|
||||
MatrL = MatrW*MatrW;
|
||||
MatrByteSize = MatrL*8;
|
||||
|
||||
//ToDo issue компилятора:
|
||||
// - #1981
|
||||
|
||||
begin
|
||||
Randomize(0);
|
||||
|
||||
// Инициализация
|
||||
|
||||
// Context.Default := new Context(DeviceTypeFlags.GPU); // не нужно - это и так значение по-умолчанию
|
||||
|
||||
// Чтение и компиляция .cl файла
|
||||
|
||||
{$resource MatrMlt.cl}
|
||||
var code := new ProgramCode(Context.Default,
|
||||
System.IO.StreamReader.Create(GetResourceStream('MatrMlt.cl')).ReadToEnd
|
||||
);
|
||||
|
||||
// Подготовка параметров
|
||||
|
||||
'Матрица A:'.Println;
|
||||
var A_Mart := MatrRandomReal(MatrW,MatrW,0,1).Println;
|
||||
writeln;
|
||||
var A := new KernelArg(MatrByteSize);
|
||||
|
||||
'Матрица B:'.Println;
|
||||
var B_Mart := MatrRandomReal(MatrW,MatrW,0,1).Println;
|
||||
writeln;
|
||||
var B := new KernelArg(MatrByteSize);
|
||||
|
||||
var C := new KernelArg(MatrByteSize);
|
||||
|
||||
'Вектор V1:'.Println;
|
||||
var V1_Arr := ArrRandomReal(MatrW);
|
||||
V1_Arr.Println;
|
||||
writeln;
|
||||
var V1 := new KernelArg(VecByteSize);
|
||||
|
||||
var V2 := new KernelArg(VecByteSize);
|
||||
|
||||
// (запись значений в параметры - позже, в очередях)
|
||||
|
||||
// Подготовка очередей выполнения
|
||||
|
||||
var Calc_C_Q :=
|
||||
code['MatrMltMatr'].NewQueue.Exec(MatrW, MatrW,
|
||||
A.NewQueue.WriteData(A_Mart) as CommandQueue<KernelArg>,
|
||||
B.NewQueue.WriteData(B_Mart) as CommandQueue<KernelArg>,
|
||||
C,
|
||||
KernelArg.ValueQueue(MatrW) as CommandQueue<KernelArg>
|
||||
) as CommandQueue<Kernel>;
|
||||
|
||||
var Otp_C_Q :=
|
||||
HPQ(
|
||||
()->
|
||||
begin
|
||||
var C_Matr := C.GetArray&<array[,] of real>(MatrW,MatrW);
|
||||
lock output do
|
||||
begin
|
||||
'Матрица С = A*B:'.Println;
|
||||
C_Matr.Println;
|
||||
writeln;
|
||||
end;
|
||||
end
|
||||
) as CommandQueue<object>;
|
||||
|
||||
var Calc_V2_Q :=
|
||||
code['MatrMltVec'].NewQueue.Exec(MatrW,
|
||||
C,
|
||||
V1.NewQueue.WriteData(V1_Arr) as CommandQueue<KernelArg>,
|
||||
V2,
|
||||
KernelArg.ValueQueue(MatrW) as CommandQueue<KernelArg>
|
||||
) as CommandQueue<Kernel>;
|
||||
|
||||
var Otp_V2_Q :=
|
||||
HPQ(
|
||||
()->
|
||||
begin
|
||||
var V2_Arr := V2.GetArray&<array of real>(MatrW);
|
||||
lock output do
|
||||
begin
|
||||
'Вектор V2 = C*V1:'.Println;
|
||||
V2_Arr.Println;
|
||||
writeln;
|
||||
end;
|
||||
end
|
||||
) as CommandQueue<object>;
|
||||
|
||||
// Выполнение всего и сразу асинхронный вывод
|
||||
|
||||
Context.Default.SyncInvoke(
|
||||
|
||||
Calc_C_Q +
|
||||
(
|
||||
Otp_C_Q * // выводить C и считать V2 можно одновременно, поэтому тут *, т.е. параллельное выполнение
|
||||
(
|
||||
Calc_V2_Q +
|
||||
Otp_V2_Q
|
||||
)
|
||||
)
|
||||
|
||||
);
|
||||
|
||||
end.
|
||||
|
|
@ -1,33 +0,0 @@
|
|||
uses OpenCLABC;
|
||||
|
||||
//ToDo issue компилятора:
|
||||
// - #1981
|
||||
|
||||
begin
|
||||
|
||||
// Чтение и компиляция .cl файла
|
||||
|
||||
{$resource SimpleAddition.cl} // эта строчка засовывает SimpleAddition.cl внутрь .exe, чтоб не надо было таскать его вместе с .exe
|
||||
var prog := new ProgramCode(Context.Default,
|
||||
System.IO.StreamReader.Create(GetResourceStream('SimpleAddition.cl')).ReadToEnd
|
||||
);
|
||||
|
||||
// Подготовка параметров
|
||||
|
||||
var A := new KernelArg(40);
|
||||
|
||||
// Выполнение
|
||||
|
||||
prog['TEST'].Exec(10,
|
||||
|
||||
A.NewQueue.WriteData(
|
||||
ArrFill(10,1)
|
||||
) as CommandQueue<KernelArg>
|
||||
|
||||
);
|
||||
|
||||
// Чтение и вывод результата
|
||||
|
||||
A.GetArray&<array of integer>(10).Println;
|
||||
|
||||
end.
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
uses OpenCLABC;
|
||||
|
||||
//ToDo Сейчас .AddWriteValue, принимающее очередь, вылетает
|
||||
// - Это из за issue компилятора #2068
|
||||
// - Когда её исправят - эта программа тоже станет нормально запускаться
|
||||
// - А пока - смотрите на программу не запуская. Даже так - пример полезный
|
||||
|
||||
begin
|
||||
var N := ReadInteger('Введите размер буфера:');
|
||||
var b := new Buffer( N*sizeof(integer) );
|
||||
|
||||
var Q_RNG_val := HFQ(()->
|
||||
begin
|
||||
Result := Random(1,100);
|
||||
end);
|
||||
|
||||
// .WriteValue принимает значение размерного типа
|
||||
// Но вместо него - мы передали очередь (CommandQueue это класс, то есть точно не размерный тип)
|
||||
// Так можно, потому что возвращаемое значение очереди Q_RNG_val - размерный тип (integer)
|
||||
var Q_RNG_FillBuff := b.NewQueue.AddWriteValue(Q_RNG_val, 0) as CommandQueue<Buffer>;
|
||||
|
||||
for var i := 1 to N-1 do // 0 пропускаем, потому что его уже добавили выше
|
||||
Q_RNG_FillBuff *= b.NewQueue.AddWriteValue(Q_RNG_val.Clone(), i*sizeof(integer) ) as CommandQueue<Buffer>;
|
||||
|
||||
// Вообще, это далеко не самый эффективный и красивый способ заполнить буфер
|
||||
// В идеале - это надо делать карнелом
|
||||
// То есть написать свой алгоритм Random на языке OpenCL-C (нет, это не сложно)
|
||||
|
||||
Context.Default.SyncInvoke(Q_RNG_FillBuff);
|
||||
|
||||
b.GetArray1&<integer>(N).Println;
|
||||
end.
|
||||
|
|
@ -0,0 +1,46 @@
|
|||
uses OpenCLABC;
|
||||
|
||||
begin
|
||||
|
||||
var b := new Buffer( 3*sizeof(integer) );
|
||||
var A := new integer[3];
|
||||
|
||||
// Код с очередями
|
||||
|
||||
var Q_BuffWrite :=
|
||||
( b.NewQueue.AddWriteValue(1, 0*sizeof(integer) ) as CommandQueue<Buffer> ) *
|
||||
( b.NewQueue.AddWriteValue(5, 1*sizeof(integer) ) as CommandQueue<Buffer> ) *
|
||||
( b.NewQueue.AddWriteValue(7, 2*sizeof(integer) ) as CommandQueue<Buffer> )
|
||||
;
|
||||
|
||||
var Q_BuffRead := b.NewQueue.AddReadArray(A) as CommandQueue<Buffer>;
|
||||
|
||||
var Q_Otp := HPQ(()->
|
||||
begin
|
||||
A.Println;
|
||||
end);
|
||||
|
||||
Context.Default.SyncInvoke(
|
||||
Q_BuffWrite +
|
||||
Q_BuffRead +
|
||||
Q_Otp
|
||||
);
|
||||
|
||||
// Этот же код ещё раз, но без явных очередей
|
||||
// Неявно - каждый метод .Write*** и .Read*** всё равно создаёт по очереди
|
||||
// Такая запись короче, но выполняется медленнее
|
||||
|
||||
// Аналог Q_BuffWrite
|
||||
System.Threading.Tasks.Parallel.Invoke(
|
||||
()->b.WriteValue(1, 0*sizeof(integer) ),
|
||||
()->b.WriteValue(5, 1*sizeof(integer) ),
|
||||
()->b.WriteValue(7, 2*sizeof(integer) )
|
||||
);
|
||||
|
||||
// Аналог Q_BuffRead
|
||||
b.ReadArray(A);
|
||||
|
||||
// Аналог Q_Otp
|
||||
A.Println;
|
||||
|
||||
end.
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
uses OpenCLABC;
|
||||
|
||||
begin
|
||||
var b := new Buffer( 3*sizeof(integer) ); //Буфер достаточного размера чтоб содержать 3 значений типа integer.
|
||||
|
||||
// Создаём очередь
|
||||
var q := b.NewQueue;
|
||||
|
||||
// Добавлять команды в полученную очередь можно вызывая соответствующие методы
|
||||
q.AddWriteValue(1, 0*sizeof(integer) );
|
||||
|
||||
// Методы, добавляющие команду в очередь - возвращают очередь, для которой их вызвали (не копию а ссылку на оригинал)
|
||||
// Поэтому можно добавлять по несколько команд в 1 строчке:
|
||||
q.AddWriteValue(5, 1*sizeof(integer) ).AddWriteValue(7, 2*sizeof(integer) );
|
||||
// Все команды в q будут выполнятся последовательно, что не всегда хорошо
|
||||
// Если надо выполнять параллельно - создавайте несколько "b.NewQueue" и умножайте друг на друга
|
||||
|
||||
// В данной версии надо писать "as CommandQueue<...>", при передаче очереди куда-либо, из за бага компилятора
|
||||
Context.Default.SyncInvoke(q as CommandQueue<Buffer>);
|
||||
|
||||
// Вообще чтение тоже надо делать через очереди, но для простого примера - и так сойдёт
|
||||
b.GetArray1&<integer>(3).Println;
|
||||
|
||||
end.
|
||||
11
InstallerSamples/OpenCL/OpenCLABC/Из справки/6 – Карнел/0.cl
Normal file
11
InstallerSamples/OpenCL/OpenCLABC/Из справки/6 – Карнел/0.cl
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
|
||||
|
||||
|
||||
__kernel void TEST(__global int* message)
|
||||
{
|
||||
int gid = get_global_id(0);
|
||||
|
||||
message[gid] += gid;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
uses OpenCLABC;
|
||||
|
||||
begin
|
||||
|
||||
// Когда код на языке OpenCL-C хранят в файле - обычно ему дают расширение .cl
|
||||
// Но код можно хранить и в $resource или даже в '' в программме
|
||||
var code_text := ReadAllText('0.cl');
|
||||
|
||||
// Создание объекта типа ProgramCode
|
||||
// Перед текстом программы - можно так же указать контекст
|
||||
// Если не указывать - используется Context.Default
|
||||
var code := new ProgramCode(code_text);
|
||||
|
||||
var A := new Buffer( 10 * sizeof(integer) ); // будет хранить 10 чисел типа "integer"
|
||||
|
||||
code['TEST'].Exec1(10, // используем 10 ядер
|
||||
|
||||
A.NewQueue.AddFillValue(1) // заполняем весь буфер единичками, прямо перед выполнением
|
||||
as CommandQueue<Buffer> //ToDo нужно только из за issue компилятора #1981, иначе получаем странную ошибку. Когда исправят - можно будет убрать
|
||||
|
||||
);
|
||||
|
||||
A.GetArray1&<integer>(10).Println; // читаем одномерный массив с элементами "integer", длинной в 10
|
||||
|
||||
end.
|
||||
5
InstallerSamples/OpenCL/OpenCLABC/Из справки/Readme.txt
Normal file
5
InstallerSamples/OpenCL/OpenCLABC/Из справки/Readme.txt
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
Справка находится в начале исходника OpenCLABC
|
||||
|
||||
Исходник можно открыть, зажав Ctrl в IDE и кликнул на любое имя из OpenCLABC (в том числе имя модуля в uses)
|
||||
|
||||
(кстати, это работает со всеми модулями)
|
||||
18
InstallerSamples/OpenGL/OpenGL/Rot Triangle 1.vertex.glsl
Normal file
18
InstallerSamples/OpenGL/OpenGL/Rot Triangle 1.vertex.glsl
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
#version 110
|
||||
|
||||
attribute vec2 position;
|
||||
attribute vec3 color;
|
||||
uniform float rot_k;
|
||||
|
||||
void main()
|
||||
{
|
||||
|
||||
gl_Position.x = position.x*rot_k;
|
||||
gl_Position.y = position.y;
|
||||
gl_Position.z = 0;
|
||||
gl_Position.w = 1;
|
||||
|
||||
gl_FrontColor.rgb = color;
|
||||
gl_FrontColor.a = 1;
|
||||
|
||||
}
|
||||
|
|
@ -1,130 +0,0 @@
|
|||
{$reference System.Windows.Forms.dll}
|
||||
{$reference System.Drawing.dll}
|
||||
uses System.Windows.Forms;
|
||||
uses OpenGL;
|
||||
uses System;
|
||||
|
||||
type
|
||||
PIXELFORMATDESCRIPTOR = record
|
||||
nSize: Word;
|
||||
nVersion: Word;
|
||||
dwFlags: longword;
|
||||
iPixelType: Byte;
|
||||
cColorBits: Byte;
|
||||
cRedBits: Byte;
|
||||
cRedShift: Byte;
|
||||
cGreenBits: Byte;
|
||||
cGreenShift: Byte;
|
||||
cBlueBits: Byte;
|
||||
cBlueShift: Byte;
|
||||
cAlphaBits: Byte;
|
||||
cAlphaShift: Byte;
|
||||
cAccumBits: Byte;
|
||||
cAccumRedBits: Byte;
|
||||
cAccumGreenBits: Byte;
|
||||
cAccumBlueBits: Byte;
|
||||
cAccumAlphaBits: Byte;
|
||||
cDepthBits: Byte;
|
||||
cStencilBits: Byte;
|
||||
cAuxBuffers: Byte;
|
||||
iLayerType: Byte;
|
||||
bReserved: Byte;
|
||||
dwLayerMask: longword;
|
||||
dwVisibleMask: longword;
|
||||
dwDamageMask: longword;
|
||||
end;
|
||||
|
||||
function GetDC(hwnd: IntPtr): IntPtr;
|
||||
external 'user32.dll';
|
||||
|
||||
function SetPixelFormat(hdc: IntPtr; iPixelFormat: integer; ppfd: ^PIXELFORMATDESCRIPTOR): boolean;
|
||||
external 'gdi32.dll';
|
||||
|
||||
function ChoosePixelFormat(_hdc: IntPtr; ppfd: ^PIXELFORMATDESCRIPTOR): integer;
|
||||
external 'gdi32.dll';
|
||||
|
||||
function wglCreateContext(_hdc: IntPtr): HGLRC;
|
||||
external 'opengl32.dll';
|
||||
|
||||
function wglMakeCurrent(_hdc: IntPtr; _hglrc: HGLRC): boolean;
|
||||
external 'opengl32.dll';
|
||||
|
||||
function SwapBuffers(_hdc: IntPtr): boolean;
|
||||
external 'gdi32.dll';
|
||||
|
||||
function InitOpenGL(hwnd: IntPtr): IntPtr;
|
||||
begin
|
||||
Result := GetDC(hwnd);
|
||||
|
||||
|
||||
|
||||
var pfd: PIXELFORMATDESCRIPTOR;
|
||||
pfd.nSize := sizeof( PIXELFORMATDESCRIPTOR );
|
||||
pfd.nVersion := 1;
|
||||
pfd.dwFlags := $1 or $4 or $20;
|
||||
pfd.cColorBits := 24;
|
||||
pfd.cDepthBits := 16;
|
||||
|
||||
if not SetPixelFormat(
|
||||
Result,
|
||||
ChoosePixelFormat(Result, @pfd),
|
||||
@pfd
|
||||
) then raise new InvalidOperationException;
|
||||
|
||||
var context := wglCreateContext(Result);
|
||||
if not wglMakeCurrent(Result, context) then raise new InvalidOperationException;
|
||||
|
||||
|
||||
|
||||
gl_Deprecated.LoadIdentity;
|
||||
gl.ClearColor(0.0, 0.0, 0.0, 1.0);
|
||||
|
||||
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
var f := new Form;
|
||||
|
||||
f.StartPosition := FormStartPosition.CenterScreen;
|
||||
f.ClientSize := new System.Drawing.Size(500,500);
|
||||
f.FormBorderStyle := FormBorderStyle.Fixed3D;
|
||||
|
||||
f.Closing += (o,e)->Halt();
|
||||
|
||||
f.Shown += (o,e)->
|
||||
begin
|
||||
var hdc := InitOpenGL(f.Handle);
|
||||
|
||||
var dy := -Sin(Pi/6) / 2;
|
||||
// var pts := real(0.0).Step(Pi*2/3).Take(3).Select(rot->(Sin(rot), Cos(rot)+dy)).ToArray; //ToDo #2042
|
||||
var pts := Range(0,2).Select(i->i* Pi*2/3 ).Select(rot->(Sin(rot), Cos(rot)+dy)).ToArray;
|
||||
var frame_rot := 0.0;
|
||||
|
||||
System.Threading.Thread.Create(()->
|
||||
while true do
|
||||
begin
|
||||
|
||||
f.Invoke(()->
|
||||
begin
|
||||
gl.Clear(BufferTypeFlags.COLOR_BUFFER_BIT);
|
||||
var rot_k := Cos(frame_rot);
|
||||
|
||||
gl_Deprecated.Begin(PrimitiveType.TRIANGLES);
|
||||
gl_Deprecated.Color4f(1,0,0,1); gl_Deprecated.Vertex2f( pts[0][0]*rot_k, pts[0][1] );
|
||||
gl_Deprecated.Color4f(0,1,0,1); gl_Deprecated.Vertex2f( pts[1][0]*rot_k, pts[1][1] );
|
||||
gl_Deprecated.Color4f(0,0,1,1); gl_Deprecated.Vertex2f( pts[2][0]*rot_k, pts[2][1] );
|
||||
gl_Deprecated._End;
|
||||
|
||||
frame_rot += 0.03;
|
||||
gl.Finish;
|
||||
SwapBuffers(hdc);
|
||||
end);
|
||||
|
||||
Sleep(16);
|
||||
end).Start;
|
||||
|
||||
end;
|
||||
|
||||
Application.Run(f);
|
||||
end.
|
||||
|
|
@ -0,0 +1,237 @@
|
|||
{$reference System.Windows.Forms.dll}
|
||||
{$reference System.Drawing.dll}
|
||||
|
||||
// Данный пример демонстрирует запуск простейшей программы с модулем OpenGL
|
||||
// Примите во внимание, что методы из gl_gdi. - могут служить только временной заменой в серьёзной программе
|
||||
// (По крайней мере в данной версии. В будущем, возможно, gl_gdi будет улучшено)
|
||||
// Они использованы тут, чтоб пример был проще
|
||||
|
||||
uses System.Windows.Forms;
|
||||
uses System.Drawing;
|
||||
uses System;
|
||||
uses OpenGL;
|
||||
|
||||
{$apptype windows} // убираем консоль
|
||||
|
||||
var gl: OpenGL.gl;
|
||||
|
||||
{$region Buffer}
|
||||
|
||||
function InitBuffer(sz: integer; data: IntPtr): BufferName;
|
||||
begin
|
||||
gl.CreateBuffers(1, Result);
|
||||
|
||||
gl.NamedBufferData(Result, new UIntPtr(sz), data, BufferDataUsage.STATIC_DRAW);
|
||||
|
||||
end;
|
||||
|
||||
function InitBuffer(sz: integer; data: pointer) := InitBuffer(sz, IntPtr(data));
|
||||
function InitBuffer<T>(sz: integer; var data: T) := InitBuffer(sz, @data);
|
||||
function InitBuffer<T>(data: array of T) := InitBuffer(data.Length*System.Runtime.InteropServices.Marshal.SizeOf&<T>, data[0]);
|
||||
|
||||
{$endregion Buffer}
|
||||
|
||||
{$region Shader}
|
||||
|
||||
function InitShader(fname: string; st: ShaderType): ShaderName;
|
||||
begin
|
||||
Result := gl.CreateShader(st);
|
||||
|
||||
var source := ReadAllText(fname);
|
||||
|
||||
// в данной версии модуля OpenGL параметры принимающие массив строк - не поддерживаются
|
||||
// поэтому надо ручками преобразовывать управляемую строку в неуправляемую с кодировкой ANSI
|
||||
var source_strptr := System.Runtime.InteropServices.Marshal.StringToHGlobalAnsi(source);
|
||||
var source_len := source.Length;
|
||||
|
||||
gl.ShaderSource(Result, 1, source_strptr, source_len);
|
||||
|
||||
// и обязательно освобождаем память, иначе снова утечка памяти
|
||||
System.Runtime.InteropServices.Marshal.FreeHGlobal(source_strptr);
|
||||
|
||||
gl.CompileShader(Result);
|
||||
// получаем состояние успешности компиляции
|
||||
// 1=успешно
|
||||
// 0=ошибка
|
||||
var comp_ok: integer;
|
||||
gl.GetShaderiv(Result, ShaderInfoType.COMPILE_STATUS, comp_ok);
|
||||
if comp_ok <> 1 then
|
||||
begin
|
||||
|
||||
// узнаём нужную длинную строки
|
||||
var l: integer;
|
||||
gl.GetShaderiv(Result, ShaderInfoType.INFO_LOG_LENGTH, l);
|
||||
|
||||
// выделяем достаточно памяти чтоб сохранить строку
|
||||
var ptr := System.Runtime.InteropServices.Marshal.AllocHGlobal(l);
|
||||
|
||||
// получаем строку логов
|
||||
gl.GetShaderInfoLog(Result, l, nil, ptr);
|
||||
|
||||
// преобразовываем в управляемую строку
|
||||
var log := System.Runtime.InteropServices.Marshal.PtrToStringAnsi(ptr);
|
||||
writeln(log);
|
||||
|
||||
// и опять же, в конце обязательно освобождаем памяти, чтоб не было утечек памяти
|
||||
System.Runtime.InteropServices.Marshal.FreeHGlobal(ptr);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
{$endregion Shader}
|
||||
|
||||
{$region Program}
|
||||
|
||||
function InitProgram(vertex_shader, fragment_shader: ShaderName): ProgramName;
|
||||
begin
|
||||
Result := gl.CreateProgram;
|
||||
|
||||
gl.AttachShader(Result, vertex_shader);
|
||||
if fragment_shader<>0 then gl.AttachShader(Result, fragment_shader);
|
||||
|
||||
gl.LinkProgram(Result);
|
||||
// всё то же самое что и у шейдеров
|
||||
var link_ok: integer;
|
||||
gl.GetProgramiv(Result, ProgramInfoType.LINK_STATUS, link_ok);
|
||||
if link_ok <> 1 then
|
||||
begin
|
||||
|
||||
var l: integer;
|
||||
gl.GetProgramiv(Result, ProgramInfoType.INFO_LOG_LENGTH, l);
|
||||
var ptr := System.Runtime.InteropServices.Marshal.AllocHGlobal(l);
|
||||
|
||||
gl.GetProgramInfoLog(Result, l, nil, ptr);
|
||||
var log := System.Runtime.InteropServices.Marshal.PtrToStringAnsi(ptr);
|
||||
writeln(log);
|
||||
|
||||
System.Runtime.InteropServices.Marshal.FreeHGlobal(ptr);
|
||||
end;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
{$endregion Program}
|
||||
|
||||
const dy = -Sin(Pi / 6) / 2;
|
||||
|
||||
begin
|
||||
|
||||
// Создаёт и настраиваем окно
|
||||
var f := new Form;
|
||||
f.StartPosition := FormStartPosition.CenterScreen;
|
||||
f.ClientSize := new 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;
|
||||
|
||||
{$endregion Настройка глобальных параметров OpenGL}
|
||||
|
||||
{$region Инициализация переменных}
|
||||
|
||||
var vertex_pos_buffer := InitBuffer(ArrGen(3, i->
|
||||
begin
|
||||
var rot := i * Pi * 2 / 3;
|
||||
|
||||
Result := new Vec2f(
|
||||
Sin(rot),
|
||||
Cos(rot) + dy
|
||||
);
|
||||
|
||||
end));
|
||||
var vertex_clr_buffer := InitBuffer(new Vec3f[](
|
||||
new Vec3f(1,0,0),
|
||||
new Vec3f(0,1,0),
|
||||
new Vec3f(0,0,1)
|
||||
));
|
||||
|
||||
var element_buffer := InitBuffer(new byte[](
|
||||
0,1,2
|
||||
));
|
||||
|
||||
var vertex_shader := InitShader('Rot Triangle 1.vertex.glsl', ShaderType.VERTEX_SHADER);
|
||||
// var fragment_shader := InitShader('fragment.glsl', ShaderType.FRAGMENT_SHADER);
|
||||
|
||||
var sprog := InitProgram(vertex_shader, 0 {fragment_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 System.Diagnostics.Stopwatch;
|
||||
t.Start;
|
||||
|
||||
{$endregion Инициализация переменных}
|
||||
|
||||
while true do
|
||||
begin
|
||||
// очищаем окно в начале перерисовки
|
||||
gl.Clear(BufferTypeFlags.COLOR_BUFFER_BIT);
|
||||
|
||||
|
||||
|
||||
gl.UseProgram(sprog);
|
||||
|
||||
gl.Uniform1f(uniform_rot_k, Cos( t.Elapsed.Ticks * 0.0000002 ) );
|
||||
|
||||
gl.BindBuffer(BufferBindType.ARRAY_BUFFER, vertex_pos_buffer);
|
||||
gl.VertexAttribPointer(
|
||||
attribute_position,
|
||||
2,
|
||||
DataType.FLOAT,
|
||||
false,
|
||||
8,
|
||||
nil
|
||||
);
|
||||
gl.EnableVertexAttribArray(attribute_position);
|
||||
|
||||
gl.BindBuffer(BufferBindType.ARRAY_BUFFER, vertex_clr_buffer);
|
||||
gl.VertexAttribPointer(
|
||||
attribute_color,
|
||||
3,
|
||||
DataType.FLOAT,
|
||||
false,
|
||||
12,
|
||||
nil
|
||||
);
|
||||
gl.EnableVertexAttribArray(attribute_color);
|
||||
|
||||
gl.BindBuffer(BufferBindType.ELEMENT_ARRAY_BUFFER, element_buffer);
|
||||
gl.DrawElements(
|
||||
PrimitiveType.TRIANGLES,
|
||||
3,
|
||||
DataType.UNSIGNED_BYTE,
|
||||
pointer(nil)
|
||||
);
|
||||
|
||||
gl.DisableVertexAttribArray(attribute_position);
|
||||
gl.DisableVertexAttribArray(attribute_color);
|
||||
|
||||
|
||||
|
||||
// получаем тип последней ошибки
|
||||
var err := gl.GetError;
|
||||
// и если ошибка есть - выводим её
|
||||
if err.val<>ErrorCode.NO_ERROR then writeln(err);
|
||||
|
||||
gl.Finish;
|
||||
// EndFrame меняет местами буферы и ждёт vsync
|
||||
EndFrame;
|
||||
end;
|
||||
|
||||
end);
|
||||
|
||||
Application.Run(f);
|
||||
end.
|
||||
|
|
@ -6,47 +6,23 @@
|
|||
// https://github.com/SunSerega/POCGL/blob/master/LICENSE
|
||||
//*****************************************************************************************************\\
|
||||
// Copyright (©) Сергей Латченко ( github.com/SunSerega | forum.mmcs.sfedu.ru/u/sun_serega )
|
||||
// Этот код распространяется под Unlicense
|
||||
// Для деталей смотрите в файл LICENSE или это:
|
||||
// Этот код распространяется с лицензией Unlicense
|
||||
// Подробнее в файле LICENSE или тут:
|
||||
// https://github.com/SunSerega/POCGL/blob/master/LICENSE
|
||||
//*****************************************************************************************************\\
|
||||
|
||||
///
|
||||
/// Код переведён отсюда:
|
||||
///Код переведён отсюда:
|
||||
/// https://github.com/KhronosGroup/OpenCL-Headers/tree/master/CL
|
||||
///
|
||||
/// Спецификация (что то типа справки):
|
||||
/// www.khronos.org/registry/OpenCL/specs/2.2/html/OpenCL_API.html
|
||||
///Спецификации всех версий:
|
||||
/// https://www.khronos.org/registry/OpenCL/
|
||||
///
|
||||
/// Если чего то не хватает - писать сюда:
|
||||
///Если не хватает функции, перечисления, или найдена ошибка - писать сюда:
|
||||
/// https://github.com/SunSerega/POCGL/issues
|
||||
///
|
||||
unit OpenCL;
|
||||
|
||||
//ToDo ^T -> pointer
|
||||
|
||||
//ToDo расширения с котороми я не знаю что делать:
|
||||
//
|
||||
// - cl_ext.h
|
||||
// -- cl_qcom_ext_host_ptr
|
||||
// -- cl_qcom_ext_host_ptr_iocoherent
|
||||
// -- cl_qcom_ion_host_ptr
|
||||
// -- cl_qcom_android_native_buffer_host_ptr
|
||||
// -- cl_img_yuv_image
|
||||
//
|
||||
// - cl_d3d11.h
|
||||
// -- там нет функций, есть только энумы и коды ошибок. Но в чём смысл если возвращать и принимать их нечему?
|
||||
//
|
||||
// - cl_platform.h
|
||||
// -- есть только описание типов и констант, которые нигде не используются. Где они нужны?
|
||||
//
|
||||
// кто что то знает - напишите в issue, пожалуйста
|
||||
|
||||
//ToDo .h файлы которые осталось перевести:
|
||||
// - cl_ext_intel
|
||||
// - cl_va_api_media_sharing_intel
|
||||
// - cl_dx9_media_sharing_intel
|
||||
|
||||
uses System;
|
||||
uses System.Runtime.InteropServices;
|
||||
|
||||
|
|
@ -64,7 +40,7 @@ type
|
|||
cl_event = IntPtr;
|
||||
cl_sampler = IntPtr;
|
||||
|
||||
///0=false, остальное=true
|
||||
///0 = false, остальное = true
|
||||
cl_bool = UInt32;
|
||||
cl_bitfield = UInt64;
|
||||
|
||||
|
|
@ -78,7 +54,7 @@ type
|
|||
|
||||
{$endregion Основные типы}
|
||||
|
||||
{$region Энумы} type
|
||||
{$region Перечисления} type
|
||||
|
||||
{$region case Result of}
|
||||
|
||||
|
|
@ -1410,7 +1386,7 @@ type
|
|||
|
||||
{$endregion Флаги}
|
||||
|
||||
{$endregion Энумы}
|
||||
{$endregion Перечисления}
|
||||
|
||||
{$region Делегаты}
|
||||
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
30719
bin/Lib/OpenGL.pas
30719
bin/Lib/OpenGL.pas
File diff suppressed because it is too large
Load diff
|
|
@ -1,4 +1,8 @@
|
|||
unit OpenGLABC;
|
||||
|
||||
///
|
||||
///Модуль, зарезервированный для высокоуровневой оболочки модуля OpenGL
|
||||
///
|
||||
unit OpenGLABC;
|
||||
|
||||
interface
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue