Q to reset sheet

SunSerega · Dec 28, 2023 · cc66a90 · cc66a90
1 parent 9cc72e8
commit cc66a90
Show file tree

Hide file tree

Showing 4 changed files with 97 additions and 44 deletions.
diff --git a/PackAll.pas b/PackAll.pas
@@ -395,7 +395,7 @@
           );
           var DisallowedExtensions := HSet(
             '.gitignore', '.td',
-            '.cache',
+            '.cache', '.dat',
             '.exe', '.pdb', '.pcu'
           );
 

diff --git a/Samples/OpenGLABC/Mandelbrot/0Mandelbrot.pas b/Samples/OpenGLABC/Mandelbrot/0Mandelbrot.pas
@@ -13,15 +13,14 @@
 // - Ctrl+C:      Скопировать положение камеры (+Shift чтобы добавить комментарий)
 // - Ctrl+V:      Вставить положение камеры
 // - Win+V:       Вставить положение камеры из истории буфера обмена
+// - Q:           Сбросить визуальную информацию предыдущих кадров
 //TODO:
-// - Alt:         Вид без копирования информации предыдущих кадров
-// - Alt+Enter:   Полноэкранный режим
 // - B:           Телепортировать камеру к курсору (Blink)
 // --- Пока держат - выводить точку в начале заголовка, а телепортировать когда отпускают
 
 // В модуле Settings находятся все основных константы
 // + объяснение логики программы, чтобы понимать зачем эти константы
-// Ctrl+тыкните на название модуля в uses чтобы открыть его
+// Ctrl+тыкните на название модуля тут, в uses, чтобы открыть его
 uses Settings;
 
 //TODO Вывод шагов под курсором чтобы норм дебажить
@@ -30,17 +29,11 @@
 //TODO Выводить отдельно для sheet и для блоков
 // - Для этого надо находить номер блока и точки в нём и кидать (x;y) точки в CQ_GetData
 
-//TODO Alt-режим почему то не работает...
-// - Точнее, если масштабировать с ним - начинаются глюки
-// - Вообще, он уже и не полезен. Зато полезна была бы возможность сбрасывать sheet вручную
-
-//TODO Отдельная программа для полной прорисовки кардров с движением камеры от 1 точки (и масштаба) к другой
-
 //TODO При очень большом приближении край рисунка ведёт себя криво
 // - Потому что FirstWordToReal
 // - Надо в виде PointComponent считать разницу сначала
 
-//TODO mouse_grab_move ведёт себя не стабильно (точка которую держат может потихоньку сдвигаться)
+//TODO mouse_grab_move ведёт себя не стабильно: точка которую держат может потихоньку сдвигаться
 // - Надо запоминать camera.pos в начале движения мышкой
 // - И затем пересчитывать на каждом кадре относительно него
 
@@ -49,6 +42,13 @@
 // - Скорость обработки блоков (ну и текущее кол-во слов там же)
 // - Для начала выводить сколько памяти тратится на sheet-ы
 
+//TODO Всё ещё наблюдаются редкие глюки CQ_CopySheet, особенно при больших прыжках масштаба
+//TODO Так же заметил с горизонтальным движением, когда не хватает оперативки
+// - Может это скорее потому что что-то не обнуляется?
+// - Сложно тестировать потому что начинаются ещё и всякие INVALID_KERNEL_ARGS вдруг...
+
+//TODO Отдельная программа для полной прорисовки кардров с движением камеры от 1 точки (и масштаба) к другой
+
 uses System;
 uses System.Windows.Forms;
 
@@ -216,19 +216,6 @@   BoundUniforms = record
 
   {$endregion Закрытие}
 
-  var need_resize := false;
-  f.Shown += (o,e)->
-  begin
-    need_resize := true;
-    f.Resize += (o,e)->
-    begin
-      need_resize := true;
-      // Чтобы не мигало - ждём завершения одной перерисовки
-      // в потоке формы, то есть блокируя отсыл информации системе
-      while need_resize do ;
-    end;
-  end;
-
   {$region speak}
 
   var speak: string->();
@@ -341,10 +328,11 @@   BoundUniforms = record
 
   {$endregion speak}
 
+  var need_resize := false;
   var copy_camera_pos := default(Tuple<string>);
   var paste_camera_pos := default(Tuple<CameraPos>);
   var mouse_captured := true;
-  var draw_alt_mode := false;
+  var sheet_less_mode := false;
   var mouse_pos := default(Vec2i);
   var mouse_grab_move := default(Vec2i);
   var scale_speed_add := 0;
@@ -355,6 +343,22 @@   BoundUniforms = record
   {$region Управление}
   begin
 
+    {$region resize}
+
+    f.Shown += (o,e)->
+    begin
+      need_resize := true;
+      f.Resize += (o,e)->
+      begin
+        need_resize := true;
+        // Чтобы не мигало - ждём завершения одной перерисовки
+        // в потоке формы, то есть блокируя отсыл информации системе
+        while need_resize do ;
+      end;
+    end;
+
+    {$endregion resize}
+
     {$region copy/paste}
 
     if FileExists(camera_saved_pos_fname) then
@@ -441,12 +445,12 @@   BoundUniforms = record
 
     {$endregion mouse_captured}
 
-    {$region draw_alt_mode}
+    {$region sheet_less_mode}
 
-    f.KeyDown += (o,e)->(draw_alt_mode := e.Alt);
-    f.KeyUp += (o,e)->(draw_alt_mode := e.Alt);
+    f.KeyDown += (o,e)->if e.KeyCode=Keys.Q then sheet_less_mode := true;
+    f.KeyUp   += (o,e)->if e.KeyCode=Keys.Q then sheet_less_mode := false;
 
-    {$endregion draw_alt_mode}
+    {$endregion sheet_less_mode}
 
     {$region camera reset}
 
@@ -578,8 +582,8 @@   BoundUniforms = record
 //    gl.NamedBufferData(buffer_temp, new IntPtr(3*sizeof(real)), IntPtr.Zero, VertexBufferObjectUsage.DYNAMIC_READ);
 //    gl.BindBufferBase(BufferTarget.SHADER_STORAGE_BUFFER, 1, buffer_temp);
 
-    var t_full := new UpdateTimingQueue(120);
-    var t_body := new UpdateTimingQueue(120);
+    var t_full := new UpdateTimingQueue(30);
+    var t_body := new UpdateTimingQueue(30);
 
     var camera := new CameraPos(f.ClientSize.Width, f.ClientSize.Height);
     var scale_speed := 0.0;
@@ -664,20 +668,21 @@   BoundUniforms = record
       var render_sheet_w := b_cx * block_w;
       var render_sheet_h := b_cy * block_w;
 
-      var need_back_sheet := not draw_alt_mode
+      var l_sheet_less_mode := sheet_less_mode;
+      var need_back_sheet := not l_sheet_less_mode
         and (render_info.last_sheet_diff<>nil)
         and not render_info.last_sheet_diff.Value.IsNoChange;
 
       var Q_Acquire := CQNil;
       var Q_Release := CQNil;
       var Q_Init := CQNil;
-      if need_back_sheet then
+      if need_back_sheet and not l_sheet_less_mode then
       begin
         Q_Acquire += CQAcquireGL(sheet_draw.b_cl);
         Q_Release += CQReleaseGL(sheet_draw.b_cl);
         Swap(sheet_back, sheet_draw);
       end;
-      var need_zero_out := sheet_draw.EnsureLen(render_sheet_w * render_sheet_h);
+      var need_zero_out := l_sheet_less_mode or sheet_draw.EnsureLen(render_sheet_w * render_sheet_h);
       Q_Acquire += CQAcquireGL(sheet_draw.b_cl);
       Q_Release += CQReleaseGL(sheet_draw.b_cl);
       if need_back_sheet or need_zero_out then
@@ -728,8 +733,9 @@   BoundUniforms = record
 
 //      gl.BindBufferBase(glBufferTarget.SHADER_STORAGE_BUFFER, ssb_sheet, gl_buffer.Zero);
 
-      {$endregion Кадр}
       gl.Finish; //TODO Использовать обмент ивентами OpenCL/OpenGL
+      {$endregion Кадр}
+
       var err := gl.GetError;
       if err.IS_ERROR then MessageBox.Show(err.ToString);
 
@@ -766,13 +772,16 @@   BoundUniforms = record
       if BlockUpdater.LackingVRAM then
         title_parts += $'LACKING VRAM!!!';
 
-      f.BeginInvoke(()->
-      try
-        f.Text := title_parts.JoinToString(', ');
-      except
-        on e: Exception do
-          MessageBox.Show(e.ToString);
-      end);
+      System.Threading.Tasks.Task.Run(()->
+        f.Invoke(()->
+        try
+          f.Text := title_parts.JoinToString(', ');
+        except
+          on e: Exception do
+            MessageBox.Show(e.ToString);
+        end)
+      );
+
       EndFrame;
     except
       on e: Exception do

diff --git a/Samples/OpenGLABC/Mandelbrot/0Mandelbrot.td b/Samples/OpenGLABC/Mandelbrot/0Mandelbrot.td
@@ -11,10 +11,44 @@
 0Mandelbrot.$delegate? = procedure
 0Mandelbrot.$delegate? = procedure
 0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure
+0Mandelbrot.$delegate? = procedure(<>ch: char; <>new_speaker: SpeechSynthesizer)
+0Mandelbrot.$delegate? = procedure(<>ch: char; <>new_speaker: SpeechSynthesizer)
+0Mandelbrot.$delegate? = procedure(<>ch: char; <>v: InstalledVoice)
+0Mandelbrot.$delegate? = procedure(<>ch: char; <>v: InstalledVoice)
 0Mandelbrot.$delegate? = procedure(<>key_low: Keys; <>key_high: Keys; <>modifiers: Keys; <>on_change: integer -> ())
 0Mandelbrot.$delegate? = procedure(<>key_low: Keys; <>key_high: Keys; <>modifiers: Keys; <>on_change: integer -> ())
 0Mandelbrot.$delegate? = procedure(<>s_frag: gl_shader)
 0Mandelbrot.$delegate? = procedure(<>s_frag: gl_shader)
+0Mandelbrot.$delegate? = procedure(ch: char; new_speaker: SpeechSynthesizer)
+0Mandelbrot.$delegate? = procedure(ch: char; v: InstalledVoice)
 0Mandelbrot.$delegate? = procedure(key_low: Keys; key_high: Keys; modifiers: Keys; on_change: integer -> ())
 0Mandelbrot.$delegate? = procedure(s_frag: gl_shader)
 Blocks.$delegate? = procedure(<>ml: MemoryLayer<PointBlock>)
@@ -66,7 +100,12 @@ OpenGL.$delegate? = procedure(shader: gl_shader; pname: glShaderParameterName; p
 OpenGL.$delegate? = procedure(shader: gl_shader; pname: glShaderParameterName; var params: integer)
 OpenGL.$delegate? = procedure(target: glBufferTarget; index: longword; buffer: gl_buffer)
 OpenGL.$delegate? = procedure(x: integer; y: integer; width: integer; height: integer)
-OpenGLABC.RedrawThreadProc = procedure(pl: IGLPlatformLoader; EndFrame: procedure)
+OpenGLABC.RedrawThreadProc = procedure(pl: IGLPlatformLoader; EndFrame: procedure)
+PointComponents.$delegate? = procedure(<>m: string)
+PointComponents.$delegate? = procedure(<>m: string)
+PointComponents.$delegate? = procedure(m: string)
+PointComponents.$delegate? = procedure(m: string)
+PointComponents.$delegate? = procedure(m: string)
 
 #ReqModules
 OpenGL+OpenGLABC

diff --git a/Samples/OpenGLABC/Mandelbrot/FieldTest.td b/Samples/OpenGLABC/Mandelbrot/FieldTest.td
@@ -15,7 +15,12 @@ OpenCL.clProgramCallback = procedure(program: cl_program; user_data: System.IntP
 OpenCLABC.$delegate? = function(ntv: cl_program; var data: clBool; validate: boolean): clErrorCode
 OpenCLABC._GetPropValueFunc<T> = function(ntv: cl_program; var data: T): clErrorCode
 OpenCLABC_implementation______.EnqFunc<T> = function(prev_res: T; cq: cl_command_queue; ev_l2: EventList): ValueTuple<cl_event,CLContext -> ()>
-OpenCLABC_implementation______.InvokeParamsFunc<T> = function(enq_c: integer; o_const: boolean; g: CLTaskGlobalData; enq_evs: DoubleList<EventList>; par_err_handlers: DoubleList<ErrHandler>): ValueTuple<procedure,EnqFunc<T>>
+OpenCLABC_implementation______.InvokeParamsFunc<T> = function(enq_c: integer; o_const: boolean; g: CLTaskGlobalData; enq_evs: DoubleList<EventList>; par_err_handlers: DoubleList<ErrHandler>): ValueTuple<procedure,EnqFunc<T>>
+PointComponents.$delegate? = procedure(<>m: string)
+PointComponents.$delegate? = procedure(<>m: string)
+PointComponents.$delegate? = procedure(m: string)
+PointComponents.$delegate? = procedure(m: string)
+PointComponents.$delegate? = procedure(m: string)
 
 #ExpExecOtp
 Updates: 115036204