m2-GTK4/tests/test_shim.mod

MODULE test_shim ;

(*
   m2-GTK4 test - the C subclassing shim (M2GtkShim).

   Creates a custom GtkWidget and a custom GdkPaintable, each drawing
   through a Modula-2 Cairo callback, presents them and checks (from a
   timeout) that both draw callbacks ran.  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 GtkBox IMPORT gtk_box_new, gtk_box_append;
FROM GtkEnums IMPORT GtkVertical;
FROM GtkWidget IMPORT gtk_widget_set_size_request;
FROM GtkPicture IMPORT gtk_picture_new, gtk_picture_set_paintable,
   gtk_picture_get_paintable;
FROM M2GtkShim IMPORT m2_gtk_widget_new, m2_paintable_new;
FROM Cairo IMPORT cairo_set_source_rgb, cairo_rectangle, cairo_fill;
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.TestShim";

VAR
   app: ADDRESS;
   passed, widgetDrew, paintableDrew: BOOLEAN;

PROCEDURE DrawWidget (widget: ADDRESS; cr: ADDRESS; width, height: INTEGER;
                      user: ADDRESS);
BEGIN
   widgetDrew := TRUE;
   cairo_set_source_rgb(cr, 0.20, 0.50, 0.90);
   cairo_rectangle(cr, 0.0, 0.0, VAL(REAL, width), VAL(REAL, height));
   cairo_fill(cr)
END DrawWidget;

PROCEDURE DrawPaintable (cr: ADDRESS; width, height: INTEGER; user: ADDRESS);
BEGIN
   paintableDrew := TRUE;
   cairo_set_source_rgb(cr, 0.90, 0.30, 0.20);
   cairo_rectangle(cr, 0.0, 0.0, VAL(REAL, width), VAL(REAL, height));
   cairo_fill(cr)
END DrawPaintable;

PROCEDURE AfterMap (data: ADDRESS) : INTEGER;
BEGIN
   IF NOT widgetDrew THEN
      printf("custom widget draw not called\n");
      passed := FALSE
   END;
   IF NOT paintableDrew THEN
      printf("paintable draw not called\n");
      passed := FALSE
   END;
   g_application_quit(app);
   RETURN GSourceRemove
END AfterMap;

PROCEDURE OnActivate (application: ADDRESS; data: ADDRESS);
VAR
   window, box, widget, paintable, picture: ADDRESS;
   ok: BOOLEAN;
BEGIN
   ok := TRUE;
   widgetDrew := FALSE;
   paintableDrew := FALSE;

   widget := m2_gtk_widget_new(ADR(DrawWidget), NIL, NIL);
   IF widget = NIL THEN
      printf("custom widget NIL\n"); ok := FALSE
   END;
   gtk_widget_set_size_request(widget, 120, 80);

   paintable := m2_paintable_new(ADR(DrawPaintable), 60, 40, NIL, NIL);
   IF paintable = NIL THEN
      printf("paintable NIL\n"); ok := FALSE
   END;
   picture := gtk_picture_new();
   gtk_picture_set_paintable(picture, paintable);
   IF gtk_picture_get_paintable(picture) # paintable THEN
      printf("picture paintable wrong\n"); ok := FALSE
   END;
   gtk_widget_set_size_request(picture, 80, 60);

   box := gtk_box_new(GtkVertical, 6);
   gtk_box_append(box, widget);
   gtk_box_append(box, picture);
   window := gtk_application_window_new(application);
   gtk_window_set_child(window, box);
   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_shim: 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_shim: PASS\n");
      HALT(0)
   ELSE
      printf("test_shim: FAIL\n");
      HALT(1)
   END
END test_shim.