m2-GTK4/demos/DemosInput.mod

IMPLEMENTATION MODULE DemosInput ;

(*
   See the GTK C originals in gtk/demos/gtk-demo:
     password_entry.c, search_entry.c, tagged_entry.c, shortcut_triggers.c

   Only the bindings under src/ are used, so this module builds with just
   -Isrc -Idemos (see also demos/DemosText.mod).  A few C facilities used
   by the originals are not bound; those spots are simplified and called
   out in comments:
     * GtkPasswordEntry is not bound, so the two password fields use a
       GtkEntry with visibility switched off (still read via GtkEditable).
     * gtk_search_bar_set_key_capture_widget / g_object_bind_property are
       not bound; the header toggle drives the search bar through its
       "toggled" signal instead.
     * the demo-private DemoTaggedEntry composite is not a GTK widget, so
       the tagged entry is approximated with a GtkBox holding an entry,
       tag labels and a spinner.
     * gtk_callback_action_new is not bound; the shortcut rows are
       GtkButtons and the parsed "signal(clicked)" action activates them.
*)

FROM SYSTEM IMPORT ADDRESS, ADR;
FROM GtkWindow IMPORT gtk_window_new, gtk_window_set_title,
   gtk_window_set_default_size, gtk_window_set_resizable,
   gtk_window_set_titlebar, 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_sensitive, gtk_widget_set_halign,
   gtk_widget_set_size_request, gtk_widget_add_css_class,
   gtk_widget_add_controller;
FROM GtkEnums IMPORT GtkVertical, GtkHorizontal, GtkAlignCenter, GtkAlignEnd;
FROM GtkBox IMPORT gtk_box_new, gtk_box_append, gtk_box_remove;
FROM GtkHeaderBar IMPORT gtk_header_bar_new,
   gtk_header_bar_set_show_title_buttons, gtk_header_bar_pack_end;
FROM GtkEntry IMPORT gtk_entry_new, gtk_entry_set_placeholder_text;
FROM GtkPasswordEntry IMPORT gtk_password_entry_new;
FROM GtkEditable IMPORT gtk_editable_get_text;
FROM GtkSearchEntry IMPORT gtk_search_entry_new;
FROM GtkSearchBar IMPORT gtk_search_bar_new, gtk_search_bar_connect_entry,
   gtk_search_bar_set_show_close_button, gtk_search_bar_set_child,
   gtk_search_bar_set_search_mode;
FROM GtkToggleButton IMPORT gtk_toggle_button_new_with_label,
   gtk_toggle_button_get_active;
FROM GtkButton IMPORT gtk_button_new_with_label,
   gtk_button_new_with_mnemonic, gtk_button_get_label;
FROM GtkLabel IMPORT gtk_label_new, gtk_label_set_text;
FROM GtkCheckButton IMPORT gtk_check_button_new_with_mnemonic;
FROM GtkSpinner IMPORT gtk_spinner_new, gtk_spinner_start;
FROM GtkListBox IMPORT gtk_list_box_new, gtk_list_box_insert;
FROM GtkShortcut IMPORT gtk_shortcut_new,
   gtk_shortcut_trigger_parse_string, gtk_shortcut_action_parse_string;
FROM GtkShortcutController IMPORT gtk_shortcut_controller_new,
   gtk_shortcut_controller_set_scope, gtk_shortcut_controller_add_shortcut,
   GtkShortcutScopeGlobal;
FROM GObject IMPORT g_signal_connect_data, GConnectDefault;
FROM GLib IMPORT g_strcmp0;
FROM libc IMPORT printf, strncpy;

(* local stand-in for GtkUtils.CStrToM2 (lib/ is not on the include path
   for these demos): copy a borrowed C string into a Modula-2 buffer. *)
PROCEDURE CopyCStr (src: ADDRESS; VAR dst: ARRAY OF CHAR);
BEGIN
   IF src = NIL THEN
      dst[0] := 0C
   ELSE
      strncpy(ADR(dst), src, HIGH(dst) + 1);
      dst[HIGH(dst)] := 0C
   END
END CopyCStr;

(* ------------------------------------------------------------------ *)
(* Password Entry                                                      *)
(* ------------------------------------------------------------------ *)

VAR
   pwWindow, pwEntry, pwEntry2, pwButton: ADDRESS;

(* void update_button(GObject *object, GParamSpec *pspec, gpointer data) *)
PROCEDURE OnUpdateButton (object: ADDRESS; pspec: ADDRESS; data: ADDRESS);
VAR
   text, text2: ADDRESS;
   buf: ARRAY [0..255] OF CHAR;
BEGIN
   text := gtk_editable_get_text(pwEntry);
   text2 := gtk_editable_get_text(pwEntry2);
   CopyCStr(text, buf);
   IF (buf[0] # 0C) AND (g_strcmp0(text, text2) = 0) THEN
      gtk_widget_set_sensitive(pwButton, 1)
   ELSE
      gtk_widget_set_sensitive(pwButton, 0)
   END
END OnUpdateButton;

(* void button_pressed(GtkButton *widget, GtkWidget *window) *)
PROCEDURE OnDone (button: ADDRESS; data: ADDRESS);
BEGIN
   gtk_window_destroy(pwWindow);
   pwWindow := NIL
END OnDone;

PROCEDURE PasswordField (placeholder: ARRAY OF CHAR) : ADDRESS;
VAR
   entry: ADDRESS;
BEGIN
   entry := gtk_password_entry_new();
   g_signal_connect_data(entry, "notify::text", ADR(OnUpdateButton),
                         NIL, NIL, GConnectDefault);
   RETURN entry
END PasswordField;

PROCEDURE DoPasswordEntry (doWidget: ADDRESS) : ADDRESS;
VAR
   box, header: ADDRESS;
BEGIN
   IF pwWindow = NIL THEN
      pwWindow := gtk_window_new();
      gtk_window_set_title(pwWindow, "Choose a Password");
      gtk_window_set_resizable(pwWindow, 0);

      header := gtk_header_bar_new();
      gtk_header_bar_set_show_title_buttons(header, 0);
      gtk_window_set_titlebar(pwWindow, header);

      box := gtk_box_new(GtkVertical, 6);
      gtk_widget_set_margin_start(box, 18);
      gtk_widget_set_margin_end(box, 18);
      gtk_widget_set_margin_top(box, 18);
      gtk_widget_set_margin_bottom(box, 18);
      gtk_window_set_child(pwWindow, box);

      pwEntry := PasswordField("Password");
      gtk_box_append(box, pwEntry);

      pwEntry2 := PasswordField("Confirm");
      gtk_box_append(box, pwEntry2);

      pwButton := gtk_button_new_with_mnemonic("_Done");
      gtk_widget_add_css_class(pwButton, "suggested-action");
      g_signal_connect_data(pwButton, "clicked", ADR(OnDone),
                            NIL, NIL, GConnectDefault);
      gtk_widget_set_sensitive(pwButton, 0);
      gtk_header_bar_pack_end(header, pwButton)
   END;

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

(* ------------------------------------------------------------------ *)
(* Search Entry                                                        *)
(* ------------------------------------------------------------------ *)

VAR
   searchWindow, searchBar: ADDRESS;

(* void search_changed_cb(GtkSearchEntry *entry, GtkLabel *result_label) *)
PROCEDURE OnSearchChanged (entry: ADDRESS; resultLabel: ADDRESS);
VAR
   text: ADDRESS;
   buf: ARRAY [0..255] OF CHAR;
BEGIN
   text := gtk_editable_get_text(entry);
   CopyCStr(text, buf);
   gtk_label_set_text(resultLabel, buf)
END OnSearchChanged;

(* The C demo binds the header toggle's "active" to the search bar's
   "search-mode-enabled"; g_object_bind_property is not bound here, so
   the same effect is wired through the "toggled" signal. *)
PROCEDURE OnSearchToggled (button: ADDRESS; data: ADDRESS);
BEGIN
   IF gtk_toggle_button_get_active(button) # 0 THEN
      gtk_search_bar_set_search_mode(searchBar, 1)
   ELSE
      gtk_search_bar_set_search_mode(searchBar, 0)
   END
END OnSearchToggled;

PROCEDURE DoSearchEntry (doWidget: ADDRESS) : ADDRESS;
VAR
   vbox, hbox, box, label, entry, button, header: ADDRESS;
BEGIN
   IF searchWindow = NIL THEN
      searchWindow := gtk_window_new();
      gtk_window_set_title(searchWindow, "Type to Search");
      gtk_window_set_resizable(searchWindow, 0);
      gtk_widget_set_size_request(searchWindow, 200, -1);

      header := gtk_header_bar_new();
      gtk_window_set_titlebar(searchWindow, header);

      vbox := gtk_box_new(GtkVertical, 0);
      gtk_window_set_child(searchWindow, vbox);

      entry := gtk_search_entry_new();
      gtk_widget_set_halign(entry, GtkAlignCenter);

      searchBar := gtk_search_bar_new();
      gtk_search_bar_connect_entry(searchBar, entry);
      gtk_search_bar_set_show_close_button(searchBar, 0);
      gtk_search_bar_set_child(searchBar, entry);
      gtk_box_append(vbox, searchBar);

      (* gtk_search_bar_set_key_capture_widget is not bound; the search
         bar is opened via the header toggle below instead. *)

      box := gtk_box_new(GtkVertical, 18);
      gtk_widget_set_margin_start(box, 18);
      gtk_widget_set_margin_end(box, 18);
      gtk_widget_set_margin_top(box, 18);
      gtk_widget_set_margin_bottom(box, 18);
      gtk_box_append(vbox, box);

      button := gtk_toggle_button_new_with_label("Search");
      g_signal_connect_data(button, "toggled", ADR(OnSearchToggled),
                            NIL, NIL, GConnectDefault);
      gtk_header_bar_pack_end(header, button);

      hbox := gtk_box_new(GtkHorizontal, 10);
      gtk_box_append(box, hbox);

      label := gtk_label_new("Searching for:");
      gtk_box_append(hbox, label);

      label := gtk_label_new("");
      gtk_box_append(hbox, label);

      g_signal_connect_data(entry, "search-changed", ADR(OnSearchChanged),
                            label, NIL, GConnectDefault)
   END;

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

(* ------------------------------------------------------------------ *)
(* Tagged Entry                                                        *)
(* ------------------------------------------------------------------ *)

(* The demo's DemoTaggedEntry composite is not bound; this approximates
   it with a horizontal GtkBox that holds the entry, tag labels and an
   optional spinner. *)

VAR
   taggedWindow, tagBox, tagSpinner: ADDRESS;

(* void add_tag(GtkButton *button, DemoTaggedEntry *entry) *)
PROCEDURE OnAddTag (button: ADDRESS; data: ADDRESS);
VAR
   tag: ADDRESS;
BEGIN
   tag := gtk_label_new("Blue");
   gtk_widget_add_css_class(tag, "blue");
   gtk_box_append(tagBox, tag)
END OnAddTag;

(* void toggle_spinner(GtkCheckButton *button, DemoTaggedEntry *entry) *)
PROCEDURE OnToggleSpinner (button: ADDRESS; data: ADDRESS);
BEGIN
   IF tagSpinner = NIL THEN
      tagSpinner := gtk_spinner_new();
      gtk_spinner_start(tagSpinner);
      gtk_box_append(tagBox, tagSpinner)
   ELSE
      gtk_box_remove(tagBox, tagSpinner);
      tagSpinner := NIL
   END
END OnToggleSpinner;

PROCEDURE DoTaggedEntry (doWidget: ADDRESS) : ADDRESS;
VAR
   box, box2, entry, button: ADDRESS;
BEGIN
   IF taggedWindow = NIL THEN
      taggedWindow := gtk_window_new();
      gtk_window_set_title(taggedWindow, "Tagged Entry");
      gtk_window_set_default_size(taggedWindow, 260, -1);
      gtk_window_set_resizable(taggedWindow, 0);

      box := gtk_box_new(GtkVertical, 6);
      gtk_widget_set_margin_start(box, 18);
      gtk_widget_set_margin_end(box, 18);
      gtk_widget_set_margin_top(box, 18);
      gtk_widget_set_margin_bottom(box, 18);
      gtk_window_set_child(taggedWindow, box);

      tagBox := gtk_box_new(GtkHorizontal, 6);
      gtk_box_append(box, tagBox);

      entry := gtk_entry_new();
      gtk_box_append(tagBox, entry);

      box2 := gtk_box_new(GtkHorizontal, 6);
      gtk_widget_set_halign(box2, GtkAlignEnd);
      gtk_box_append(box, box2);

      button := gtk_button_new_with_mnemonic("Add _Tag");
      g_signal_connect_data(button, "clicked", ADR(OnAddTag),
                            entry, NIL, GConnectDefault);
      gtk_box_append(box2, button);

      button := gtk_check_button_new_with_mnemonic("_Spinner");
      g_signal_connect_data(button, "toggled", ADR(OnToggleSpinner),
                            entry, NIL, GConnectDefault);
      gtk_box_append(box2, button)
   END;

   IF gtk_widget_get_visible(taggedWindow) = 0 THEN
      gtk_widget_set_visible(taggedWindow, 1)
   ELSE
      gtk_window_destroy(taggedWindow);
      taggedWindow := NIL;
      tagBox := NIL;
      tagSpinner := NIL
   END;
   RETURN taggedWindow
END DoTaggedEntry;

(* ------------------------------------------------------------------ *)
(* Shortcut Triggers                                                   *)
(* ------------------------------------------------------------------ *)

VAR
   shortcutWindow: ADDRESS;
   shortcutDesc: ARRAY [0..1] OF ARRAY [0..31] OF CHAR;
   shortcutTrig: ARRAY [0..1] OF ARRAY [0..31] OF CHAR;

(* gboolean shortcut_activated(GtkWidget *widget, GVariant *unused, gpointer row) *)
PROCEDURE OnShortcutActivated (button: ADDRESS; data: ADDRESS);
VAR
   label: ADDRESS;
   buf: ARRAY [0..127] OF CHAR;
BEGIN
   label := gtk_button_get_label(button);
   CopyCStr(label, buf);
   printf("activated %s\n", buf)
END OnShortcutActivated;

PROCEDURE DoShortcutTriggers (doWidget: ADDRESS) : ADDRESS;
VAR
   list, row, controller, trigger, action, shortcut: ADDRESS;
   i: INTEGER;
   triggerAction: ARRAY [0..31] OF CHAR;
BEGIN
   IF shortcutWindow = NIL THEN
      shortcutWindow := gtk_window_new();
      gtk_window_set_title(shortcutWindow, "Shortcuts");
      gtk_window_set_default_size(shortcutWindow, 200, -1);
      gtk_window_set_resizable(shortcutWindow, 0);

      shortcutDesc[0] := "Press Ctrl-G";
      shortcutDesc[1] := "Press X";
      shortcutTrig[0] := "<Control>g";
      shortcutTrig[1] := "x";
      triggerAction := "signal(clicked)";

      list := gtk_list_box_new();
      gtk_widget_set_margin_top(list, 6);
      gtk_widget_set_margin_bottom(list, 6);
      gtk_widget_set_margin_start(list, 6);
      gtk_widget_set_margin_end(list, 6);
      gtk_window_set_child(shortcutWindow, list);

      FOR i := 0 TO 1 DO
         (* The C row is a GtkLabel whose shortcut uses
            gtk_callback_action_new (not bound); a GtkButton row plus the
            parsed "signal(clicked)" action gives the same activation. *)
         row := gtk_button_new_with_label(shortcutDesc[i]);
         gtk_list_box_insert(list, row, -1);

         controller := gtk_shortcut_controller_new();
         gtk_shortcut_controller_set_scope(controller, GtkShortcutScopeGlobal);
         gtk_widget_add_controller(row, controller);

         trigger := gtk_shortcut_trigger_parse_string(shortcutTrig[i]);
         action := gtk_shortcut_action_parse_string(triggerAction);
         shortcut := gtk_shortcut_new(trigger, action);
         gtk_shortcut_controller_add_shortcut(controller, shortcut);

         g_signal_connect_data(row, "clicked", ADR(OnShortcutActivated),
                               NIL, NIL, GConnectDefault)
      END
   END;

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

END DemosInput.