m2-GTK4/demos/DemosLayout.mod

IMPLEMENTATION MODULE DemosLayout ;

(*
   m2-GTK4 - the layout-related gtk-demo demos: Size Groups, Fixed Layout
   Transformations and Layout Manager/Transition.  Ported from the GTK C
   demo sources in gtk/demos/gtk-demo (sizegroup.c, fixed2.c,
   layoutmanager.c).

   Bindings that are not (yet) exposed under src/ forced a few faithful
   simplifications; each one is marked with a "SIMPLIFIED" note below.
*)

FROM SYSTEM IMPORT ADDRESS;
FROM GtkWindow IMPORT gtk_window_new, gtk_window_set_title,
   gtk_window_set_default_size, gtk_window_set_resizable,
   gtk_window_set_child, gtk_window_destroy;
FROM GtkWidget IMPORT gtk_widget_set_visible, gtk_widget_get_visible,
   gtk_widget_set_margin_start, gtk_widget_set_margin_end,
   gtk_widget_set_margin_top, gtk_widget_set_margin_bottom,
   gtk_widget_set_halign, gtk_widget_set_valign, gtk_widget_set_hexpand;
FROM GtkBox IMPORT gtk_box_new, gtk_box_append;
FROM GtkGrid IMPORT gtk_grid_new, gtk_grid_attach,
   gtk_grid_set_row_spacing, gtk_grid_set_column_spacing;
FROM GtkFrame IMPORT gtk_frame_new, gtk_frame_set_child;
FROM GtkLabel IMPORT gtk_label_new;
FROM GtkDropDown IMPORT gtk_drop_down_new;
FROM GtkStringList IMPORT gtk_string_list_new, gtk_string_list_append;
FROM GtkSizeGroup IMPORT gtk_size_group_new, gtk_size_group_add_widget,
   GtkSizeGroupHorizontal;
FROM GtkCheckButton IMPORT gtk_check_button_new_with_label,
   gtk_check_button_set_active;
FROM GtkScrolledWindow IMPORT gtk_scrolled_window_new,
   gtk_scrolled_window_set_child;
FROM GtkFixed IMPORT gtk_fixed_new, gtk_fixed_put;
FROM GtkEnums IMPORT GtkVertical, GtkAlignStart, GtkAlignEnd,
   GtkAlignBaseline;

(* ------------------------------------------------------------------ *)
(* Size Groups                                                        *)
(* ------------------------------------------------------------------ *)

VAR
   sizeGroupWindow: ADDRESS;

(* Build a drop-down from three literal labels.  The C demo passes a
   NULL-terminated const char * array to gtk_drop_down_new_from_strings();
   this binding favours a GtkStringList model, which is the equivalent
   route exposed under src/. *)
PROCEDURE MakeDropDown (a, b, c: ARRAY OF CHAR) : ADDRESS;
VAR
   list: ADDRESS;
BEGIN
   list := gtk_string_list_new(NIL);
   gtk_string_list_append(list, a);
   gtk_string_list_append(list, b);
   gtk_string_list_append(list, c);
   RETURN gtk_drop_down_new(list, NIL)
END MakeDropDown;

(* add_row(): one mnemonic label plus a drop-down in a grid row.
   SIMPLIFIED: gtk_label_new_with_mnemonic() and
   gtk_label_set_mnemonic_widget() are not bound, so a plain label is
   used (the underscores are dropped rather than shown literally). *)
PROCEDURE AddRow (group, table: ADDRESS; row: INTEGER;
                  labelText, a, b, c: ARRAY OF CHAR);
VAR
   label, dropdown: ADDRESS;
BEGIN
   label := gtk_label_new(labelText);
   gtk_widget_set_halign(label, GtkAlignStart);
   gtk_widget_set_valign(label, GtkAlignBaseline);
   gtk_widget_set_hexpand(label, 1);
   IF group # NIL THEN gtk_size_group_add_widget(group, label) END;
   gtk_grid_attach(table, label, 0, row, 1, 1);

   dropdown := MakeDropDown(a, b, c);
   gtk_widget_set_halign(dropdown, GtkAlignEnd);
   gtk_widget_set_valign(dropdown, GtkAlignBaseline);
   gtk_grid_attach(table, dropdown, 1, row, 1, 1)
END AddRow;

PROCEDURE DoSizeGroup (doWidget: ADDRESS) : ADDRESS;
VAR
   vbox, frame, table, checkButton, group: ADDRESS;
BEGIN
   IF sizeGroupWindow = NIL THEN
      sizeGroupWindow := gtk_window_new();
      gtk_window_set_title(sizeGroupWindow, "Size Groups");
      gtk_window_set_resizable(sizeGroupWindow, 0);

      vbox := gtk_box_new(GtkVertical, 5);
      gtk_widget_set_margin_start(vbox, 5);
      gtk_widget_set_margin_end(vbox, 5);
      gtk_widget_set_margin_top(vbox, 5);
      gtk_widget_set_margin_bottom(vbox, 5);
      gtk_window_set_child(sizeGroupWindow, vbox);

      (* the labels in both grids share one horizontal size group *)
      group := gtk_size_group_new(GtkSizeGroupHorizontal);

      (* Color options *)
      frame := gtk_frame_new("Color Options");
      gtk_box_append(vbox, frame);
      table := gtk_grid_new();
      gtk_widget_set_margin_start(table, 5);
      gtk_widget_set_margin_end(table, 5);
      gtk_widget_set_margin_top(table, 5);
      gtk_widget_set_margin_bottom(table, 5);
      gtk_grid_set_row_spacing(table, 5);
      gtk_grid_set_column_spacing(table, 10);
      gtk_frame_set_child(frame, table);
      AddRow(group, table, 0, "Foreground", "Red", "Green", "Blue");
      AddRow(group, table, 1, "Background", "Red", "Green", "Blue");

      (* Line options *)
      frame := gtk_frame_new("Line Options");
      gtk_box_append(vbox, frame);
      table := gtk_grid_new();
      gtk_widget_set_margin_start(table, 5);
      gtk_widget_set_margin_end(table, 5);
      gtk_widget_set_margin_top(table, 5);
      gtk_widget_set_margin_bottom(table, 5);
      gtk_grid_set_row_spacing(table, 5);
      gtk_grid_set_column_spacing(table, 10);
      gtk_frame_set_child(frame, table);
      AddRow(group, table, 0, "Dashing", "Solid", "Dashed", "Dotted");
      AddRow(group, table, 1, "Line ends", "Square", "Round", "Double Arrow");

      checkButton := gtk_check_button_new_with_label("Enable grouping");
      gtk_box_append(vbox, checkButton);
      gtk_check_button_set_active(checkButton, 1)
   END;

   IF gtk_widget_get_visible(sizeGroupWindow) = 0 THEN
      gtk_widget_set_visible(sizeGroupWindow, 1)
   ELSE
      gtk_window_destroy(sizeGroupWindow);
      sizeGroupWindow := NIL
   END;
   RETURN sizeGroupWindow
END DoSizeGroup;

(* ------------------------------------------------------------------ *)
(* Fixed Layout / Transformations                                     *)
(* ------------------------------------------------------------------ *)

VAR
   fixed2Window: ADDRESS;

PROCEDURE DoFixed2 (doWidget: ADDRESS) : ADDRESS;
VAR
   sw, fixed, child: ADDRESS;
BEGIN
   IF fixed2Window = NIL THEN
      fixed2Window := gtk_window_new();
      gtk_window_set_title(fixed2Window, "Fixed Layout - Transformations");
      gtk_window_set_default_size(fixed2Window, 400, 300);

      sw := gtk_scrolled_window_new();
      gtk_window_set_child(fixed2Window, sw);

      fixed := gtk_fixed_new();
      gtk_scrolled_window_set_child(sw, fixed);

      child := gtk_label_new("All fixed?");
      gtk_fixed_put(fixed, child, 0.0, 0.0)

      (* SIMPLIFIED: the C demo animates the child with a frame-clock
         tick callback (gtk_widget_add_tick_callback), a transform on the
         fixed child (gtk_fixed_set_child_transform) and
         gtk_widget_set_overflow(); none of those are bound under src/.
         The widget hierarchy is kept, the rotation/scale animation is
         omitted. *)
   END;

   IF gtk_widget_get_visible(fixed2Window) = 0 THEN
      gtk_widget_set_visible(fixed2Window, 1)
   ELSE
      gtk_window_destroy(fixed2Window);
      fixed2Window := NIL
   END;
   RETURN fixed2Window
END DoFixed2;

(* ------------------------------------------------------------------ *)
(* Layout Manager / Transition                                        *)
(* ------------------------------------------------------------------ *)

VAR
   layoutManagerWindow: ADDRESS;
   layoutColors: ARRAY [0..15] OF ARRAY [0..9] OF CHAR;

(* SIMPLIFIED: the C demo builds a bespoke DemoWidget whose custom
   GtkLayoutManager animates its 16 DemoChild() squares between a grid
   and a circle.  Neither that C widget pair nor a GtkLayoutManager /
   GtkCustomLayout binding exists under src/.  The bound equivalent used
   here is a GtkGrid holding the same 16 coloured children; the names
   are shown as label text (the animation and the drawn colour fill are
   omitted). *)
PROCEDURE InitColors;
BEGIN
   layoutColors[0] := "red";
   layoutColors[1] := "orange";
   layoutColors[2] := "yellow";
   layoutColors[3] := "green";
   layoutColors[4] := "blue";
   layoutColors[5] := "grey";
   layoutColors[6] := "magenta";
   layoutColors[7] := "lime";
   layoutColors[8] := "yellow";
   layoutColors[9] := "firebrick";
   layoutColors[10] := "aqua";
   layoutColors[11] := "purple";
   layoutColors[12] := "tomato";
   layoutColors[13] := "pink";
   layoutColors[14] := "thistle";
   layoutColors[15] := "maroon"
END InitColors;

PROCEDURE DoLayoutManager (doWidget: ADDRESS) : ADDRESS;
VAR
   grid, child: ADDRESS;
   i: INTEGER;
BEGIN
   IF layoutManagerWindow = NIL THEN
      layoutManagerWindow := gtk_window_new();
      gtk_window_set_title(layoutManagerWindow,
                           "Layout Manager - Transition");
      gtk_window_set_default_size(layoutManagerWindow, 600, 600);

      InitColors;
      grid := gtk_grid_new();
      FOR i := 0 TO 15 DO
         child := gtk_label_new(layoutColors[i]);
         gtk_widget_set_margin_start(child, 4);
         gtk_widget_set_margin_end(child, 4);
         gtk_widget_set_margin_top(child, 4);
         gtk_widget_set_margin_bottom(child, 4);
         gtk_grid_attach(grid, child, i MOD 4, i DIV 4, 1, 1)
      END;
      gtk_window_set_child(layoutManagerWindow, grid)
   END;

   IF gtk_widget_get_visible(layoutManagerWindow) = 0 THEN
      gtk_widget_set_visible(layoutManagerWindow, 1)
   ELSE
      gtk_window_destroy(layoutManagerWindow);
      layoutManagerWindow := NIL
   END;
   RETURN layoutManagerWindow
END DoLayoutManager;

END DemosLayout.