m2-GTK4/tests/test_gl.mod

MODULE test_gl ;

(*
   m2-GTK4 test - GtkGLArea property round-trips.  Requires a display
   (and a GL-capable renderer to actually draw, which this does not do).
*)

FROM Gio IMPORT g_application_run, g_application_quit;
FROM GtkApplication IMPORT gtk_application_new;
FROM GtkWindow IMPORT gtk_application_window_new, gtk_window_set_child,
   gtk_window_present;
FROM GtkGLArea IMPORT gtk_gl_area_new, gtk_gl_area_set_auto_render,
   gtk_gl_area_get_auto_render, gtk_gl_area_set_has_depth_buffer,
   gtk_gl_area_get_has_depth_buffer, gtk_gl_area_set_has_stencil_buffer,
   gtk_gl_area_set_use_es, gtk_gl_area_get_use_es,
   gtk_gl_area_set_required_version, gtk_gl_area_get_required_version;
FROM GtkUtils IMPORT Connect;
FROM SYSTEM IMPORT ADDRESS, ADR;
FROM libc IMPORT printf;

CONST
   AppId = "org.example.m2gtk4.TestGl";

VAR
   app: ADDRESS;
   passed: BOOLEAN;

PROCEDURE OnActivate (application: ADDRESS; data: ADDRESS);
VAR
   window, area: ADDRESS;
   major, minor: INTEGER;
   ok: BOOLEAN;
BEGIN
   ok := TRUE;

   area := gtk_gl_area_new();
   IF area = NIL THEN printf("gl area NIL\n"); ok := FALSE END;

   gtk_gl_area_set_auto_render(area, 1);
   IF gtk_gl_area_get_auto_render(area) # 1 THEN
      printf("auto_render wrong\n"); ok := FALSE
   END;

   gtk_gl_area_set_has_depth_buffer(area, 1);
   IF gtk_gl_area_get_has_depth_buffer(area) # 1 THEN
      printf("has_depth_buffer wrong\n"); ok := FALSE
   END;

   gtk_gl_area_set_has_stencil_buffer(area, 1);

   gtk_gl_area_set_use_es(area, 0);
   IF gtk_gl_area_get_use_es(area) # 0 THEN
      printf("use_es wrong\n"); ok := FALSE
   END;

   gtk_gl_area_set_required_version(area, 3, 3);
   gtk_gl_area_get_required_version(area, major, minor);
   IF (major # 3) OR (minor # 3) THEN
      printf("required version wrong: %d.%d\n", major, minor); ok := FALSE
   END;

   window := gtk_application_window_new(application);
   gtk_window_set_child(window, area);
   gtk_window_present(window);

   passed := ok;
   g_application_quit(application)
END OnActivate;

VAR
   rc: INTEGER;
BEGIN
   passed := FALSE;
   app := gtk_application_new(AppId, 0);
   IF app = NIL THEN
      printf("test_gl: FAIL (no app)\n");
      HALT(1)
   END;
   Connect(app, "activate", ADR(OnActivate), NIL);
   rc := g_application_run(app, 0, NIL);

   IF passed THEN
      printf("test_gl: PASS\n");
      HALT(0)
   ELSE
      printf("test_gl: FAIL\n");
      HALT(1)
   END
END test_gl.