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.