IMPLEMENTATION MODULE DemosWindows ; (* m2-GTK4 - window-oriented gtk-demo ports, following the gtk-demo pattern used by DemosBasic/DemoImpl: each Do* procedure creates its window once (module VAR), then toggles visibility - showing it, or destroying it and resetting the handle to NIL - and returns it. Originals: gtk/demos/gtk-demo/{headerbar,infobar,tabs,assistant}.c Simplifications forced by the curated bindings under src/: * GtkInfoBar is not bound, so DoInfoBar lays the messages out as plain labels plus toggle buttons instead of real info bars. * Pango tab arrays and gtk_text_view_set_tabs() are not bound, so DoTabs omits the tab-stop setup (the sample text is unchanged). * GtkAccessible and g_object_bind_property are not bound; the accessibility annotations and the toggle/info-bar bindings are dropped. * gtk_widget_set_display() / g_object_add_weak_pointer() are not used, matching the existing demos (display is inherited, and the module VAR is reset to NIL explicitly). *) 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, gtk_window_set_titlebar; 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, gtk_widget_add_css_class; FROM GtkEnums IMPORT GtkHorizontal, GtkVertical, GtkAlignCenter, GtkAlignFill, GtkWrapWord; FROM GtkHeaderBar IMPORT gtk_header_bar_new, gtk_header_bar_pack_start, gtk_header_bar_pack_end; FROM GtkBox IMPORT gtk_box_new, gtk_box_append; FROM GtkButton IMPORT gtk_button_new_from_icon_name; FROM GtkSwitch IMPORT gtk_switch_new; FROM GtkTextView IMPORT gtk_text_view_new, gtk_text_view_get_buffer, gtk_text_view_set_wrap_mode, gtk_text_view_set_top_margin, gtk_text_view_set_bottom_margin, gtk_text_view_set_left_margin, gtk_text_view_set_right_margin, gtk_text_view_set_tabs; FROM GtkTextBuffer IMPORT gtk_text_buffer_set_text; FROM PangoTabArray IMPORT pango_tab_array_new, pango_tab_array_set_tab, pango_tab_array_free, PangoTabLeft, PangoTabDecimal; FROM GtkScrolledWindow IMPORT gtk_scrolled_window_new, gtk_scrolled_window_set_child, gtk_scrolled_window_set_policy, GtkPolicyNever, GtkPolicyAutomatic; FROM GtkLabel IMPORT gtk_label_new, gtk_label_set_wrap; FROM GtkToggleButton IMPORT gtk_toggle_button_new_with_label; FROM GtkFrame IMPORT gtk_frame_new, gtk_frame_set_child; FROM GtkAssistant IMPORT gtk_assistant_new, gtk_assistant_append_page, gtk_assistant_set_page_title, gtk_assistant_set_page_type, gtk_assistant_set_page_complete, gtk_assistant_get_current_page, gtk_assistant_get_n_pages, gtk_assistant_get_nth_page, gtk_assistant_commit, AssistantPageIntro, AssistantPageConfirm, AssistantPageProgress; FROM GtkEntry IMPORT gtk_entry_new, gtk_entry_set_activates_default; FROM GtkEditable IMPORT gtk_editable_get_text; FROM GtkCheckButton IMPORT gtk_check_button_new_with_label; FROM GtkProgressBar IMPORT gtk_progress_bar_new, gtk_progress_bar_get_fraction, gtk_progress_bar_set_fraction; FROM GtkClosures IMPORT Connect2, Connect3; FROM GtkUtils IMPORT StrAppend, IntToStr, CStrToM2; FROM GLib IMPORT g_timeout_add, GSourceContinue, GSourceRemove; (* ------------------------------------------------------------------ *) (* Header Bar (headerbar.c) *) (* ------------------------------------------------------------------ *) VAR headerBarWindow: ADDRESS; (* GtkWidget *gtk_button_new_from_icon_name(const char *icon_name) *) PROCEDURE IconButton (name: ARRAY OF CHAR) : ADDRESS; BEGIN RETURN gtk_button_new_from_icon_name(name) END IconButton; PROCEDURE DoHeaderBar (doWidget: ADDRESS) : ADDRESS; VAR header, button, box, content: ADDRESS; BEGIN IF headerBarWindow = NIL THEN headerBarWindow := gtk_window_new(); gtk_window_set_title(headerBarWindow, "Welcome to the Hotel California"); gtk_window_set_default_size(headerBarWindow, 600, 400); header := gtk_header_bar_new(); button := IconButton("mail-send-receive-symbolic"); gtk_header_bar_pack_end(header, button); box := gtk_box_new(GtkHorizontal, 0); gtk_widget_add_css_class(box, "linked"); button := IconButton("go-previous-symbolic"); gtk_box_append(box, button); button := IconButton("go-next-symbolic"); gtk_box_append(box, button); gtk_header_bar_pack_start(header, box); button := gtk_switch_new(); gtk_header_bar_pack_start(header, button); gtk_window_set_titlebar(headerBarWindow, header); content := gtk_text_view_new(); gtk_window_set_child(headerBarWindow, content) END; IF gtk_widget_get_visible(headerBarWindow) = 0 THEN gtk_widget_set_visible(headerBarWindow, 1) ELSE gtk_window_destroy(headerBarWindow); headerBarWindow := NIL END; RETURN headerBarWindow END DoHeaderBar; (* ------------------------------------------------------------------ *) (* Info Bars (infobar.c) *) (* ------------------------------------------------------------------ *) VAR infoBarWindow: ADDRESS; (* GtkInfoBar is not bound by m2-GTK4, so this simplified port shows the five message types as wrapped labels, with a linked row of toggle buttons underneath, all inside a titled frame. *) PROCEDURE DoInfoBar (doWidget: ADDRESS) : ADDRESS; VAR vbox, frame, actions, label, button: ADDRESS; BEGIN IF infoBarWindow = NIL THEN actions := gtk_box_new(GtkHorizontal, 0); gtk_widget_add_css_class(actions, "linked"); infoBarWindow := gtk_window_new(); gtk_window_set_title(infoBarWindow, "Info Bars"); gtk_window_set_resizable(infoBarWindow, 0); vbox := gtk_box_new(GtkVertical, 0); gtk_widget_set_margin_start(vbox, 8); gtk_widget_set_margin_end(vbox, 8); gtk_widget_set_margin_top(vbox, 8); gtk_widget_set_margin_bottom(vbox, 8); gtk_window_set_child(infoBarWindow, vbox); label := gtk_label_new("This is an info bar with message type GTK_MESSAGE_INFO"); gtk_label_set_wrap(label, 1); gtk_box_append(vbox, label); button := gtk_toggle_button_new_with_label("Message"); gtk_box_append(actions, button); label := gtk_label_new("This is an info bar with message type GTK_MESSAGE_WARNING"); gtk_label_set_wrap(label, 1); gtk_box_append(vbox, label); button := gtk_toggle_button_new_with_label("Warning"); gtk_box_append(actions, button); label := gtk_label_new("This is an info bar with message type GTK_MESSAGE_QUESTION"); gtk_label_set_wrap(label, 1); gtk_box_append(vbox, label); button := gtk_toggle_button_new_with_label("Question"); gtk_box_append(actions, button); label := gtk_label_new("This is an info bar with message type GTK_MESSAGE_ERROR"); gtk_label_set_wrap(label, 1); gtk_box_append(vbox, label); button := gtk_toggle_button_new_with_label("Error"); gtk_box_append(actions, button); label := gtk_label_new("This is an info bar with message type GTK_MESSAGE_OTHER"); gtk_label_set_wrap(label, 1); gtk_box_append(vbox, label); button := gtk_toggle_button_new_with_label("Other"); gtk_box_append(actions, button); frame := gtk_frame_new("An example of different info bars"); gtk_widget_set_margin_top(frame, 8); gtk_widget_set_margin_bottom(frame, 8); gtk_box_append(vbox, frame); gtk_widget_set_halign(actions, GtkAlignCenter); gtk_widget_set_margin_start(actions, 8); gtk_widget_set_margin_end(actions, 8); gtk_widget_set_margin_top(actions, 8); gtk_widget_set_margin_bottom(actions, 8); gtk_frame_set_child(frame, actions) END; IF gtk_widget_get_visible(infoBarWindow) = 0 THEN gtk_widget_set_visible(infoBarWindow, 1) ELSE gtk_window_destroy(infoBarWindow); infoBarWindow := NIL END; RETURN infoBarWindow END DoInfoBar; (* ------------------------------------------------------------------ *) (* Text View/Tabs (tabs.c) *) (* ------------------------------------------------------------------ *) VAR tabsWindow: ADDRESS; (* Pango tab arrays and gtk_text_view_set_tabs() are not bound; the tab stops are therefore omitted, but the sample text is preserved (built with explicit TAB/LF characters so no escape sequences are needed). *) PROCEDURE SetTabsText (buffer: ADDRESS); VAR text: ARRAY [0..127] OF CHAR; tab, nl: ARRAY [0..1] OF CHAR; BEGIN tab[0] := CHR(9); tab[1] := 0C; nl[0] := CHR(10); nl[1] := 0C; text[0] := 0C; StrAppend(text, "one"); StrAppend(text, tab); StrAppend(text, "2.0"); StrAppend(text, tab); StrAppend(text, "three"); StrAppend(text, nl); StrAppend(text, "four"); StrAppend(text, tab); StrAppend(text, "5.555"); StrAppend(text, tab); StrAppend(text, "six"); StrAppend(text, nl); StrAppend(text, "seven"); StrAppend(text, tab); StrAppend(text, "88.88"); StrAppend(text, tab); StrAppend(text, "nine"); gtk_text_buffer_set_text(buffer, text, -1) END SetTabsText; PROCEDURE DoTabs (doWidget: ADDRESS) : ADDRESS; VAR view, sw, buffer, tabs: ADDRESS; BEGIN IF tabsWindow = NIL THEN tabsWindow := gtk_window_new(); gtk_window_set_title(tabsWindow, "Tabs"); gtk_window_set_default_size(tabsWindow, 330, 130); gtk_window_set_resizable(tabsWindow, 0); view := gtk_text_view_new(); gtk_text_view_set_wrap_mode(view, GtkWrapWord); gtk_text_view_set_top_margin(view, 20); gtk_text_view_set_bottom_margin(view, 20); gtk_text_view_set_left_margin(view, 20); gtk_text_view_set_right_margin(view, 20); tabs := pango_tab_array_new(2, 1); pango_tab_array_set_tab(tabs, 0, PangoTabLeft, 50); pango_tab_array_set_tab(tabs, 1, PangoTabDecimal, 100); gtk_text_view_set_tabs(view, tabs); pango_tab_array_free(tabs); buffer := gtk_text_view_get_buffer(view); SetTabsText(buffer); sw := gtk_scrolled_window_new(); gtk_scrolled_window_set_policy(sw, GtkPolicyNever, GtkPolicyAutomatic); gtk_window_set_child(tabsWindow, sw); gtk_scrolled_window_set_child(sw, view) END; IF gtk_widget_get_visible(tabsWindow) = 0 THEN gtk_widget_set_visible(tabsWindow, 1) ELSE gtk_window_destroy(tabsWindow); tabsWindow := NIL END; RETURN tabsWindow END DoTabs; (* ------------------------------------------------------------------ *) (* Assistant (assistant.c) *) (* ------------------------------------------------------------------ *) VAR assistantWindow, progressBar: ADDRESS; (* gboolean apply_changes_gradually(gpointer data) *) PROCEDURE ApplyChangesGradually (data: ADDRESS) : INTEGER; VAR fraction: REAL; BEGIN fraction := gtk_progress_bar_get_fraction(progressBar); fraction := fraction + 0.05; IF fraction < 1.0 THEN gtk_progress_bar_set_fraction(progressBar, fraction); RETURN GSourceContinue ELSE gtk_window_destroy(data); RETURN GSourceRemove END END ApplyChangesGradually; (* void on_assistant_apply(GtkWidget *widget, gpointer data) *) PROCEDURE OnAssistantApply (widget: ADDRESS; data: ADDRESS); BEGIN g_timeout_add(100, ApplyChangesGradually, widget) END OnAssistantApply; (* void on_assistant_close_cancel(GtkWidget *widget, gpointer data) *) PROCEDURE OnAssistantCloseCancel (widget: ADDRESS; data: ADDRESS); BEGIN gtk_window_destroy(widget) END OnAssistantCloseCancel; (* gint format "Sample assistant (%d of %d)" without g_strdup_printf. *) PROCEDURE MakeAssistantTitle (current, total: INTEGER; VAR title: ARRAY OF CHAR); VAR num: ARRAY [0..15] OF CHAR; BEGIN title[0] := 0C; StrAppend(title, "Sample assistant ("); IntToStr(current, num); StrAppend(title, num); StrAppend(title, " of "); IntToStr(total, num); StrAppend(title, num); StrAppend(title, ")") END MakeAssistantTitle; (* void on_assistant_prepare(GtkWidget *widget, GtkWidget *page, gpointer data) *) PROCEDURE OnAssistantPrepare (widget: ADDRESS; page: ADDRESS; data: ADDRESS); VAR currentPage, nPages: INTEGER; title: ARRAY [0..63] OF CHAR; BEGIN currentPage := gtk_assistant_get_current_page(widget); nPages := gtk_assistant_get_n_pages(widget); MakeAssistantTitle(currentPage + 1, nPages, title); gtk_window_set_title(widget, title); (* The fourth page (zero-based) is the progress page: commit once the user has clicked Apply to reach it. *) IF currentPage = 3 THEN gtk_assistant_commit(widget) END END OnAssistantPrepare; (* void on_entry_changed(GtkWidget *widget, gpointer data) *) PROCEDURE OnEntryChanged (widget: ADDRESS; data: ADDRESS); VAR currentPage: ADDRESS; pageNumber: INTEGER; text: ARRAY [0..1] OF CHAR; BEGIN pageNumber := gtk_assistant_get_current_page(data); currentPage := gtk_assistant_get_nth_page(data, pageNumber); CStrToM2(gtk_editable_get_text(widget), text); IF text[0] # 0C THEN gtk_assistant_set_page_complete(data, currentPage, 1) ELSE gtk_assistant_set_page_complete(data, currentPage, 0) END END OnEntryChanged; PROCEDURE CreatePage1 (assistant: ADDRESS); VAR box, label, entry: ADDRESS; BEGIN box := gtk_box_new(GtkHorizontal, 12); gtk_widget_set_margin_start(box, 12); gtk_widget_set_margin_end(box, 12); gtk_widget_set_margin_top(box, 12); gtk_widget_set_margin_bottom(box, 12); label := gtk_label_new("You must fill out this entry to continue:"); gtk_box_append(box, label); entry := gtk_entry_new(); gtk_entry_set_activates_default(entry, 1); gtk_widget_set_valign(entry, GtkAlignCenter); gtk_box_append(box, entry); Connect2(entry, "changed", OnEntryChanged, assistant); gtk_assistant_append_page(assistant, box); gtk_assistant_set_page_title(assistant, box, "Page 1"); gtk_assistant_set_page_type(assistant, box, AssistantPageIntro) END CreatePage1; PROCEDURE CreatePage2 (assistant: ADDRESS); VAR box, checkbutton: ADDRESS; BEGIN box := gtk_box_new(GtkHorizontal, 12); gtk_widget_set_margin_start(box, 12); gtk_widget_set_margin_end(box, 12); gtk_widget_set_margin_top(box, 12); gtk_widget_set_margin_bottom(box, 12); checkbutton := gtk_check_button_new_with_label ("This is optional data, you may continue even if you do not check this"); gtk_widget_set_valign(checkbutton, GtkAlignCenter); gtk_box_append(box, checkbutton); gtk_assistant_append_page(assistant, box); gtk_assistant_set_page_complete(assistant, box, 1); gtk_assistant_set_page_title(assistant, box, "Page 2") END CreatePage2; PROCEDURE CreatePage3 (assistant: ADDRESS); VAR label: ADDRESS; BEGIN label := gtk_label_new("This is a confirmation page, press 'Apply' to apply changes"); gtk_assistant_append_page(assistant, label); gtk_assistant_set_page_type(assistant, label, AssistantPageConfirm); gtk_assistant_set_page_complete(assistant, label, 1); gtk_assistant_set_page_title(assistant, label, "Confirmation") END CreatePage3; PROCEDURE CreatePage4 (assistant: ADDRESS); BEGIN progressBar := gtk_progress_bar_new(); gtk_widget_set_halign(progressBar, GtkAlignFill); gtk_widget_set_valign(progressBar, GtkAlignCenter); gtk_widget_set_hexpand(progressBar, 1); gtk_widget_set_margin_start(progressBar, 40); gtk_widget_set_margin_end(progressBar, 40); gtk_assistant_append_page(assistant, progressBar); gtk_assistant_set_page_type(assistant, progressBar, AssistantPageProgress); gtk_assistant_set_page_title(assistant, progressBar, "Applying changes"); (* Prevents the assistant from being closed while we are "busy". *) gtk_assistant_set_page_complete(assistant, progressBar, 0) END CreatePage4; PROCEDURE DoAssistant (doWidget: ADDRESS) : ADDRESS; BEGIN IF assistantWindow = NIL THEN assistantWindow := gtk_assistant_new(); gtk_window_set_default_size(assistantWindow, -1, 300); CreatePage1(assistantWindow); CreatePage2(assistantWindow); CreatePage3(assistantWindow); CreatePage4(assistantWindow); Connect2(assistantWindow, "cancel", OnAssistantCloseCancel, NIL); Connect2(assistantWindow, "close", OnAssistantCloseCancel, NIL); Connect2(assistantWindow, "apply", OnAssistantApply, NIL); Connect3(assistantWindow, "prepare", OnAssistantPrepare, NIL) END; IF gtk_widget_get_visible(assistantWindow) = 0 THEN gtk_widget_set_visible(assistantWindow, 1) ELSE gtk_window_destroy(assistantWindow); assistantWindow := NIL END; RETURN assistantWindow END DoAssistant; END DemosWindows.