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.