m2-GTK4/examples/customwidget.mod

MODULE customwidget ;

(*
   m2-GTK4 example - custom GObject subclasses via the C shim.

   A custom GtkWidget (concentric circles) and a custom GdkPaintable
   shown in a GtkPicture, both drawn from Modula-2 Cairo callbacks.

   Build:  make examples
   Run:    ./build/examples/customwidget
*)

FROM Gio IMPORT g_application_run;
FROM GtkApplication IMPORT gtk_application_new;
FROM GtkWindow IMPORT gtk_application_window_new, gtk_window_set_title,
   gtk_window_set_default_size, gtk_window_set_child, gtk_window_present;
FROM GtkBox IMPORT gtk_box_new, gtk_box_append, gtk_box_set_spacing;
FROM GtkEnums IMPORT GtkVertical;
FROM GtkWidget IMPORT gtk_widget_set_size_request;
FROM GtkPicture IMPORT gtk_picture_new, gtk_picture_set_paintable;
FROM M2GtkShim IMPORT m2_gtk_widget_new, m2_paintable_new;
FROM Cairo IMPORT cairo_set_source_rgb, cairo_rectangle, cairo_fill,
   cairo_arc, cairo_set_line_width, cairo_stroke;
FROM GtkClosures IMPORT Connect2;
FROM SYSTEM IMPORT ADDRESS, ADR;
FROM libc IMPORT printf;

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

PROCEDURE DrawCircles (widget: ADDRESS; cr: ADDRESS; width, height: INTEGER;
                       user: ADDRESS);
VAR
   i: INTEGER;
   cx, cy, radius: REAL;
BEGIN
   cairo_set_source_rgb(cr, 0.95, 0.95, 0.97);
   cairo_rectangle(cr, 0.0, 0.0, VAL(REAL, width), VAL(REAL, height));
   cairo_fill(cr);

   cx := VAL(REAL, width DIV 2);
   cy := VAL(REAL, height DIV 2);
   FOR i := 0 TO 4 DO
      IF i MOD 2 = 0 THEN
         cairo_set_source_rgb(cr, 0.20, 0.50, 0.90)
      ELSE
         cairo_set_source_rgb(cr, 0.90, 0.30, 0.20)
      END;
      radius := VAL(REAL, 12 + i * 14);
      cairo_arc(cr, cx, cy, radius, 0.0, 6.2831853);
      cairo_fill(cr)
   END
END DrawCircles;

PROCEDURE DrawPaintable (cr: ADDRESS; width, height: INTEGER; user: ADDRESS);
BEGIN
   cairo_set_source_rgb(cr, 0.14, 0.54, 0.34);
   cairo_rectangle(cr, 0.0, 0.0, VAL(REAL, width), VAL(REAL, height));
   cairo_fill(cr);
   cairo_set_source_rgb(cr, 1.0, 1.0, 1.0);
   cairo_set_line_width(cr, 3.0);
   cairo_rectangle(cr, 4.0, 4.0, VAL(REAL, width) - 8.0, VAL(REAL, height) - 8.0);
   cairo_stroke(cr)
END DrawPaintable;

PROCEDURE OnActivate (application: ADDRESS; data: ADDRESS);
VAR
   window, box, custom, picture, paintable: ADDRESS;
BEGIN
   custom := m2_gtk_widget_new(ADR(DrawCircles), NIL, NIL);
   gtk_widget_set_size_request(custom, 180, 180);

   paintable := m2_paintable_new(ADR(DrawPaintable), 120, 80, NIL, NIL);
   picture := gtk_picture_new();
   gtk_picture_set_paintable(picture, paintable);
   gtk_widget_set_size_request(picture, 120, 80);

   box := gtk_box_new(GtkVertical, 12);
   gtk_box_set_spacing(box, 12);
   gtk_box_append(box, custom);
   gtk_box_append(box, picture);

   window := gtk_application_window_new(application);
   gtk_window_set_title(window, "m2-GTK4 Custom Widget");
   gtk_window_set_default_size(window, 320, 340);
   gtk_window_set_child(window, box);
   gtk_window_present(window)
END OnActivate;

VAR
   app: ADDRESS;
BEGIN
   app := gtk_application_new(AppId, 0);
   IF app = NIL THEN
      printf("gtk_application_new failed\n");
      HALT(1)
   END;
   Connect2(app, "activate", OnActivate, NIL);
   g_application_run(app, 0, NIL)
END customwidget.