m2-GTK4/tests/test_shim3.mod

MODULE test_shim3 ;

(*
   m2-GTK4 test - the shim's custom GtkLayoutManager.

   Installs a Modula-2 layout manager on a parent widget, adds two
   children, and checks (from a timeout) that the allocate callback ran
   and positioned them.  Requires a display.
*)

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 GtkLabel IMPORT gtk_label_new;
FROM GtkWidget IMPORT gtk_widget_set_parent, gtk_widget_get_first_child,
   gtk_widget_get_next_sibling, gtk_widget_set_layout_manager,
   gtk_widget_get_width;
FROM M2GtkShim IMPORT m2_gtk_widget_new, m2_layout_manager_new,
   m2_layout_allocate_child;
FROM GLib IMPORT g_timeout_add, GSourceRemove;
FROM GtkUtils IMPORT Connect;
FROM SYSTEM IMPORT ADDRESS, ADR;
FROM libc IMPORT printf;

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

VAR
   app, child1: ADDRESS;
   passed, allocated: BOOLEAN;

(* PROCEDURE (widget, orientation, for_size; VAR minimum, natural; user) *)
PROCEDURE Measure (widget: ADDRESS; orientation: INTEGER; for_size: INTEGER;
                   VAR minimum, natural: INTEGER; user: ADDRESS);
BEGIN
   minimum := 200;
   natural := 200
END Measure;

(* PROCEDURE (widget, width, height, baseline, user) *)
PROCEDURE Allocate (widget: ADDRESS; width, height, baseline: INTEGER;
                    user: ADDRESS);
VAR
   child: ADDRESS;
   i: INTEGER;
BEGIN
   allocated := TRUE;
   i := 0;
   child := gtk_widget_get_first_child(widget);
   WHILE child # NIL DO
      m2_layout_allocate_child(child, 0, i * 30, width, 30);
      INC(i);
      child := gtk_widget_get_next_sibling(child)
   END
END Allocate;

PROCEDURE AfterMap (data: ADDRESS) : INTEGER;
BEGIN
   IF NOT allocated THEN
      printf("allocate callback did not run\n");
      passed := FALSE
   END;
   IF (child1 # NIL) AND (gtk_widget_get_width(child1) <= 0) THEN
      printf("child was not allocated\n");
      passed := FALSE
   END;
   g_application_quit(app);
   RETURN GSourceRemove
END AfterMap;

PROCEDURE OnActivate (application: ADDRESS; data: ADDRESS);
VAR
   window, parent, manager: ADDRESS;
   ok: BOOLEAN;
BEGIN
   ok := TRUE;
   allocated := FALSE;

   parent := m2_gtk_widget_new(NIL, NIL, NIL);
   manager := m2_layout_manager_new(ADR(Measure), ADR(Allocate), NIL, NIL);
   gtk_widget_set_layout_manager(parent, manager);

   child1 := gtk_label_new("one");
   gtk_widget_set_parent(child1, parent);
   gtk_widget_set_parent(gtk_label_new("two"), parent);

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

   passed := ok;
   g_timeout_add(300, AfterMap, NIL)
END OnActivate;

VAR
   rc: INTEGER;
BEGIN
   passed := FALSE;
   app := gtk_application_new(AppId, 0);
   IF app = NIL THEN
      printf("test_shim3: 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_shim3: PASS\n");
      HALT(0)
   ELSE
      printf("test_shim3: FAIL\n");
      HALT(1)
   END
END test_shim3.