m2-GTK4/tests/test_media.mod

MODULE test_media ;

(*
   m2-GTK4 test - media: GdkTexture from a generated PNG, plus GtkVideo
   and GtkMediaFile construction.  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 GtkPicture IMPORT gtk_picture_new, gtk_picture_set_paintable,
   gtk_picture_get_paintable;
FROM GtkVideo IMPORT gtk_video_new, gtk_video_set_autoplay,
   gtk_video_get_autoplay, gtk_video_set_loop, gtk_video_get_loop;
FROM GtkMediaFile IMPORT gtk_media_file_new;
FROM GdkTexture IMPORT gdk_texture_new_from_filename,
   gdk_texture_get_width, gdk_texture_get_height;
FROM GError IMPORT GError;
FROM Cairo IMPORT cairo_image_surface_create, cairo_create, cairo_destroy,
   cairo_surface_destroy, cairo_set_source_rgb, cairo_rectangle, cairo_fill,
   cairo_surface_write_to_png, CairoFormatARGB32;
FROM GtkUtils IMPORT Connect, ClearError;
FROM SYSTEM IMPORT ADDRESS, ADR;
FROM libc IMPORT printf;

CONST
   AppId = "org.example.m2gtk4.TestMedia";
   PngPath = "/tmp/opencode/m2media.png";

VAR
   app: ADDRESS;
   passed: BOOLEAN;

PROCEDURE OnActivate (application: ADDRESS; data: ADDRESS);
VAR
   window, box, picture, texture, video, mediafile, surface, cr: ADDRESS;
   err: GError;
   ok: BOOLEAN;
BEGIN
   ok := TRUE;

   surface := cairo_image_surface_create(CairoFormatARGB32, 40, 30);
   cr := cairo_create(surface);
   cairo_set_source_rgb(cr, 0.20, 0.60, 0.30);
   cairo_rectangle(cr, 0.0, 0.0, 40.0, 30.0);
   cairo_fill(cr);
   cairo_destroy(cr);
   IF cairo_surface_write_to_png(surface, PngPath) # 0 THEN
      printf("png write failed\n"); ok := FALSE
   END;
   cairo_surface_destroy(surface);

   err := NIL;
   texture := gdk_texture_new_from_filename(PngPath, err);
   IF texture = NIL THEN
      printf("texture NIL\n");
      ClearError(err);
      ok := FALSE
   ELSE
      IF gdk_texture_get_width(texture) # 40 THEN
         printf("texture width wrong\n"); ok := FALSE
      END;
      IF gdk_texture_get_height(texture) # 30 THEN
         printf("texture height wrong\n"); ok := FALSE
      END
   END;

   picture := gtk_picture_new();
   IF texture # NIL THEN gtk_picture_set_paintable(picture, texture) END;
   IF texture # NIL THEN
      IF gtk_picture_get_paintable(picture) # texture THEN
         printf("picture paintable wrong\n"); ok := FALSE
      END
   END;

   video := gtk_video_new();
   IF video = NIL THEN printf("video NIL\n"); ok := FALSE END;
   gtk_video_set_autoplay(video, 1);
   IF gtk_video_get_autoplay(video) # 1 THEN ok := FALSE END;
   gtk_video_set_loop(video, 1);
   IF gtk_video_get_loop(video) # 1 THEN ok := FALSE END;

   mediafile := gtk_media_file_new();
   IF mediafile = NIL THEN printf("media file NIL\n"); ok := FALSE END;

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