update

separate commits are in POGCL

InstallerSamples/OpenCL/OpenCL/MatrMlt.pas

@@ -35,6 +35,12 @@ begin
   var device: cl_device_id;
   cl.GetDeviceIDs(platform, DeviceTypeFlags.Default, 1, @device, nil).RaiseIfError;
   
+  // DeviceTypeFlags.Default это обычно GPU
+  // К примеру, в ноутбуке его может не быть
+  // Тогда надо хоть для чего то попытаться инициализировать
+  // DeviceTypeFlags.All выберет первый любой девайс, поддерживающий OpenCL
+//  cl.GetDeviceIDs(platform, DeviceTypeFlags.All, 1, @device, nil).RaiseIfError;
+  
   var context := cl.CreateContext(nil, 1, @device, nil, nil, @ec);
   ec.RaiseIfError;
   

InstallerSamples/OpenCL/OpenCL/SimpleAddition.pas

@@ -16,6 +16,12 @@ begin
   var device: cl_device_id;
   cl.GetDeviceIDs(platform, DeviceTypeFlags.Default, 1, @device, nil).RaiseIfError;
   
+  // DeviceTypeFlags.Default это обычно GPU
+  // К примеру, в ноутбуке его может не быть
+  // Тогда надо хоть для чего то попытаться инициализировать
+  // DeviceTypeFlags.All выберет первый любой девайс, поддерживающий OpenCL
+//  cl.GetDeviceIDs(platform, DeviceTypeFlags.All, 1, @device, nil).RaiseIfError;
+  
   var context := cl.CreateContext(nil, 1, @device, nil, nil, @ec);
   ec.RaiseIfError;
   

InstallerSamples/OpenCL/OpenCLABC/MatrMlt.pas

@@ -100,7 +100,7 @@ begin
     
     Calc_C_Q +
     (
-      Otp_C_Q *
+      Otp_C_Q * // выводить C и считать V2 можно одновременно, поэтому тут *, т.е. параллельное выполнение
       (
         Calc_V2_Q +
         Otp_V2_Q

InstallerSamples/OpenGL/OpenGL/Rotating Triangle.pas

@@ -0,0 +1,130 @@
+{$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(1);
+    end).Start;
+    
+  end;
+  
+  Application.Run(f);
+end.

bin/Lib/OpenCL.pas

@@ -23,6 +23,8 @@
 ///
 unit OpenCL;
 
+//ToDo ^T -> pointer
+
 //ToDo расширения с котороми я не знаю что делать:
 //
 // - cl_ext.h
@@ -38,7 +40,7 @@ unit OpenCL;
 // - cl_platform.h
 // -- есть только описание типов и констант, которые нигде не используются. Где они нужны?
 //
-//ToDo кто что то знает - напишите в issue, пожалуйста
+// кто что то знает - напишите в issue, пожалуйста
 
 //ToDo .h файлы которые осталось перевести:
 // - cl_ext_intel

bin/Lib/OpenCLABC.pas

@@ -31,6 +31,8 @@ uses System.Runtime.InteropServices;
 //ToDo клонирование очередей
 // - для паралельного выполнения из разных потоков
 
+//ToDo если контекст создан из cl_context - не удалять его
+
 //ToDo issue компилятора:
 // - #1952
 // - #1981
@@ -442,15 +444,17 @@ type
     
     public static property &Default: Context read _def_cont write _def_cont;
     
-    public constructor := Create(DeviceTypeFlags.GPU);
-    
     static constructor :=
     try
       
       var ec := cl.GetPlatformIDs(1,@_platform,nil);
       ec.RaiseIfError;
       
-      _def_cont := new Context;
+      try
+        _def_cont := new Context;
+      except
+        _def_cont := new Context(DeviceTypeFlags.All); // если нету GPU - попытаться хотя бы для чего то его инициализировать
+      end;
       
     except
       on e: Exception do
@@ -461,6 +465,8 @@ type
       end;
     end;
     
+    public constructor := Create(DeviceTypeFlags.GPU);
+    
     public constructor(dt: DeviceTypeFlags);
     begin
       var ec: ErrorCode;
@@ -472,6 +478,20 @@ type
       
     end;
     
+    public constructor(context: cl_context);
+    begin
+      
+      cl.GetContextInfo(context, ContextInfoType.CL_CONTEXT_DEVICES, new UIntPtr(IntPtr.Size), @_device, nil).RaiseIfError;
+      
+      _context := context;
+    end;
+    
+    public constructor(context: cl_context; device: cl_device_id);
+    begin
+      _device := device;
+      _context := context;
+    end;
+    
     public function BeginInvoke<T>(q: CommandQueue<T>): Task<T>;
     begin
       var ec: ErrorCode;
@@ -488,19 +508,21 @@ type
         cl.ReleaseCommandQueue(cq).RaiseIfError;
         Result := q.res;
       end;
-      Result := Task&<T>.Run(костыль_для_Result);
       
+      Result := Task.Run(костыль_для_Result);
     end;
     
     public function SyncInvoke<T>(q: CommandQueue<T>): T;
     begin
       var tsk := BeginInvoke(q);
-      tsk.Wait;
+      tsk.Wait; //ToDo плавающая ошибка - на этой строчке "System.Threading.Tasks.TaskCanceledException: Отменена задача."
       Result := tsk.Result;
+      // может там Task&<T>.Run криво вызывается... посмотреть IL
     end;
     
     public procedure Finalize; override :=
-    cl.ReleaseContext(_context).RaiseIfError;
+    if _context <> cl_context.Zero then // если было исключение при инициализации
+      cl.ReleaseContext(_context).RaiseIfError;
     
   end;
   

bin/Lib/OpenGLABC.pas

@@ -0,0 +1,14 @@
+unit OpenGLABC;
+
+interface
+
+uses OpenGL;
+
+implementation
+
+begin
+  Writeln('OpenGLABC');
+  Writeln(new System.NotImplementedException);
+  Readln;
+  Halt;
+end.