m2-GTK4/tests/test_containers2.mod

MODULE test_containers2 ;

(*
   m2-GTK4 test - the second batch of containers: GtkFrame,
   GtkExpander, GtkPaned, GtkOverlay and GtkListBox/GtkListBoxRow.
   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;
FROM GtkBox IMPORT gtk_box_new, gtk_box_append;
FROM GtkEnums IMPORT GtkVertical, GtkHorizontal, GtkSelectionSingle;
FROM GtkLabel IMPORT gtk_label_new;
FROM GtkFrame IMPORT gtk_frame_new, gtk_frame_get_label,
   gtk_frame_set_child, gtk_frame_get_child,
   gtk_frame_set_label_align, gtk_frame_get_label_align,
   gtk_frame_set_label_widget, gtk_frame_get_label_widget;
FROM GtkExpander IMPORT gtk_expander_new, gtk_expander_get_label,
   gtk_expander_set_expanded, gtk_expander_get_expanded,
   gtk_expander_set_resize_toplevel, gtk_expander_get_resize_toplevel,
   gtk_expander_set_child, gtk_expander_get_child;
FROM GtkPaned IMPORT gtk_paned_new, gtk_paned_set_start_child,
   gtk_paned_get_start_child, gtk_paned_set_end_child,
   gtk_paned_get_end_child, gtk_paned_set_position, gtk_paned_get_position;
FROM GtkOverlay IMPORT gtk_overlay_new, gtk_overlay_set_child,
   gtk_overlay_get_child, gtk_overlay_add_overlay,
   gtk_overlay_remove_overlay, gtk_overlay_set_measure_overlay,
   gtk_overlay_get_measure_overlay, gtk_overlay_set_clip_overlay,
   gtk_overlay_get_clip_overlay;
FROM GtkListBox IMPORT gtk_list_box_new, gtk_list_box_append,
   gtk_list_box_get_row_at_index, gtk_list_box_select_row,
   gtk_list_box_get_selected_row, gtk_list_box_set_selection_mode,
   gtk_list_box_get_selection_mode, gtk_list_box_set_show_separators,
   gtk_list_box_get_show_separators, gtk_list_box_row_new,
   gtk_list_box_row_set_child, gtk_list_box_row_get_child,
   gtk_list_box_row_get_index, gtk_list_box_row_set_activatable,
   gtk_list_box_row_get_activatable, gtk_list_box_row_set_selectable,
   gtk_list_box_row_get_selectable;
FROM GtkUtils IMPORT Connect, CStrToM2;
FROM SYSTEM IMPORT ADDRESS, ADR;
FROM libc IMPORT printf;

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

VAR
   app: ADDRESS;
   passed: BOOLEAN;

PROCEDURE OnActivate (application: ADDRESS; data: ADDRESS);
VAR
   window, box, frame, expander, paned, overlay, listbox: ADDRESS;
   label, startLabel, stopLabel, over, row, r0, r1, r2: ADDRESS;
   buf: ARRAY [0..63] OF CHAR;
   xalign: SHORTREAL;
   ok: BOOLEAN;
BEGIN
   ok := TRUE;

   (* --- GtkFrame --- *)
   label := gtk_label_new("child");
   frame := gtk_frame_new("Title");
   gtk_frame_set_child(frame, label);
   IF gtk_frame_get_child(frame) # label THEN
      printf("frame child wrong\n"); ok := FALSE
   END;
   CStrToM2(gtk_frame_get_label(frame), buf);
   IF (buf[0] # 'T') OR (buf[5] # 0C) THEN
      printf("frame label wrong: [%s]\n", buf); ok := FALSE
   END;
   gtk_frame_set_label_align(frame, 0.5);
   xalign := gtk_frame_get_label_align(frame);
   IF ABS(xalign - 0.5) > 0.01 THEN
      printf("frame label align wrong\n"); ok := FALSE
   END;
   gtk_frame_set_label_widget(frame, gtk_label_new("header"));
   IF gtk_frame_get_label_widget(frame) = NIL THEN ok := FALSE END;

   (* --- GtkExpander --- *)
   expander := gtk_expander_new("Section");
   gtk_expander_set_child(expander, gtk_label_new("body"));
   IF gtk_expander_get_child(expander) = NIL THEN ok := FALSE END;
   CStrToM2(gtk_expander_get_label(expander), buf);
   IF (buf[0] # 'S') OR (buf[7] # 0C) THEN
      printf("expander label wrong: [%s]\n", buf); ok := FALSE
   END;
   gtk_expander_set_expanded(expander, 1);
   IF gtk_expander_get_expanded(expander) # 1 THEN ok := FALSE END;
   gtk_expander_set_resize_toplevel(expander, 1);
   IF gtk_expander_get_resize_toplevel(expander) # 1 THEN ok := FALSE END;

   (* --- GtkPaned --- *)
   startLabel := gtk_label_new("start");
   stopLabel := gtk_label_new("end");
   paned := gtk_paned_new(GtkHorizontal);
   gtk_paned_set_start_child(paned, startLabel);
   gtk_paned_set_end_child(paned, stopLabel);
   IF gtk_paned_get_start_child(paned) # startLabel THEN ok := FALSE END;
   IF gtk_paned_get_end_child(paned) # stopLabel THEN ok := FALSE END;
   gtk_paned_set_position(paned, 120);
   IF gtk_paned_get_position(paned) # 120 THEN
      printf("paned position wrong: %d\n", gtk_paned_get_position(paned));
      ok := FALSE
   END;

   (* --- GtkOverlay --- *)
   over := gtk_label_new("overlay");
   overlay := gtk_overlay_new();
   gtk_overlay_set_child(overlay, gtk_label_new("main"));
   IF gtk_overlay_get_child(overlay) = NIL THEN ok := FALSE END;
   gtk_overlay_add_overlay(overlay, over);
   gtk_overlay_set_measure_overlay(overlay, over, 1);
   IF gtk_overlay_get_measure_overlay(overlay, over) # 1 THEN
      printf("overlay measure wrong\n"); ok := FALSE
   END;
   gtk_overlay_set_clip_overlay(overlay, over, 1);
   IF gtk_overlay_get_clip_overlay(overlay, over) # 1 THEN
      printf("overlay clip wrong\n"); ok := FALSE
   END;
   gtk_overlay_remove_overlay(overlay, over);

   (* --- GtkListBox + GtkListBoxRow --- *)
   listbox := gtk_list_box_new();
   gtk_list_box_set_selection_mode(listbox, GtkSelectionSingle);
   IF gtk_list_box_get_selection_mode(listbox) # GtkSelectionSingle THEN
      ok := FALSE
   END;
   r0 := gtk_list_box_row_new();
   gtk_list_box_row_set_child(r0, gtk_label_new("row 0"));
   r1 := gtk_list_box_row_new();
   gtk_list_box_row_set_child(r1, gtk_label_new("row 1"));
   r2 := gtk_list_box_row_new();
   gtk_list_box_row_set_child(r2, gtk_label_new("row 2"));
   gtk_list_box_append(listbox, r0);
   gtk_list_box_append(listbox, r1);
   gtk_list_box_append(listbox, r2);
   row := gtk_list_box_get_row_at_index(listbox, 1);
   IF row # r1 THEN
      printf("listbox row-at-index wrong\n"); ok := FALSE
   END;
   IF gtk_list_box_row_get_index(r1) # 1 THEN
      printf("listbox row index wrong\n"); ok := FALSE
   END;
   gtk_list_box_row_set_selectable(r1, 1);
   IF gtk_list_box_row_get_selectable(r1) # 1 THEN ok := FALSE END;
   gtk_list_box_row_set_activatable(r1, 0);
   IF gtk_list_box_row_get_activatable(r1) # 0 THEN ok := FALSE END;
   gtk_list_box_select_row(listbox, r1);
   IF gtk_list_box_get_selected_row(listbox) # r1 THEN
      printf("listbox selected row wrong\n"); ok := FALSE
   END;
   gtk_list_box_set_show_separators(listbox, 1);
   IF gtk_list_box_get_show_separators(listbox) # 1 THEN ok := FALSE END;

   (* assemble into a window *)
   box := gtk_box_new(GtkVertical, 4);
   gtk_box_append(box, frame);
   gtk_box_append(box, expander);
   gtk_box_append(box, paned);
   gtk_box_append(box, listbox);
   window := gtk_application_window_new(application);
   gtk_window_set_child(window, box);

   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_containers2: 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_containers2: PASS\n");
      HALT(0)
   ELSE
      printf("test_containers2: FAIL\n");
      HALT(1)
   END
END test_containers2.