m2-GTK4/tests/test_cairo.mod

MODULE test_cairo ;

(*
   m2-GTK4 test - Cairo + Pango on an off-screen image surface.

   Draws a filled rectangle and lays out text, checks the surface/text
   extents, and writes a PNG (build/m2cairo.png).  Needs no display.
*)

FROM Cairo IMPORT cairo_image_surface_create, cairo_create, cairo_destroy,
   cairo_surface_destroy, cairo_surface_status, cairo_status,
   cairo_set_source_rgb, cairo_rectangle, cairo_fill,
   cairo_surface_write_to_png, CairoFormatARGB32;
FROM Pango IMPORT pango_font_description_from_string,
   pango_font_description_free, pango_layout_set_text,
   pango_layout_set_font_description, pango_layout_get_pixel_size,
   pango_layout_get_pixel_extents, PangoRectangle;
FROM PangoCairo IMPORT pango_cairo_create_layout, pango_cairo_show_layout;
FROM GObject IMPORT g_object_unref;
FROM SYSTEM IMPORT ADDRESS;
FROM libc IMPORT printf;

VAR
   failed: BOOLEAN;

PROCEDURE Check (condition: BOOLEAN; what: ARRAY OF CHAR);
BEGIN
   IF NOT condition THEN
      printf("FAIL: %s\n", what);
      failed := TRUE
   END
END Check;

VAR
   surface, cr, layout, desc: ADDRESS;
   ink, logical: PangoRectangle;
   w, h: INTEGER;
BEGIN
   failed := FALSE;

   surface := cairo_image_surface_create(CairoFormatARGB32, 200, 100);
   Check(cairo_surface_status(surface) = 0, "image surface status");

   cr := cairo_create(surface);
   Check(cairo_status(cr) = 0, "cairo context status");

   cairo_set_source_rgb(cr, 0.20, 0.40, 0.80);
   cairo_rectangle(cr, 10.0, 10.0, 180.0, 80.0);
   cairo_fill(cr);

   layout := pango_cairo_create_layout(cr);
   desc := pango_font_description_from_string("Sans 14");
   pango_layout_set_font_description(layout, desc);
   pango_font_description_free(desc);
   pango_layout_set_text(layout, "Hello Pango", -1);

   pango_layout_get_pixel_size(layout, w, h);
   Check((w > 0) AND (h > 0), "layout pixel size > 0");
   pango_layout_get_pixel_extents(layout, ink, logical);
   Check(logical.width > 0, "logical extent width > 0");

   cairo_set_source_rgb(cr, 0.0, 0.0, 0.0);
   pango_cairo_show_layout(cr, layout);

   Check(cairo_surface_write_to_png(surface, "/tmp/opencode/m2cairo.png") = 0,
         "write PNG");

   g_object_unref(layout);
   cairo_destroy(cr);
   cairo_surface_destroy(surface);

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