m2-GTK4/demos/DemosWindows.mod

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 GtkImage IMPORT gtk_image_new_from_icon_name;
FROM GtkButton IMPORT gtk_button_new, gtk_button_set_child;
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;
FROM GtkTextBuffer IMPORT gtk_text_buffer_set_text;
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;

(* gtk_button_new_from_icon_name() is not bound: build the equivalent
   from an empty button and an icon-name GtkImage child. *)
PROCEDURE IconButton (name: ARRAY OF CHAR) : ADDRESS;
VAR
   button: ADDRESS;
BEGIN
   button := gtk_button_new();
   gtk_button_set_child(button, gtk_image_new_from_icon_name(name));
   RETURN button
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: 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);

      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.