m2-GTK4/demos/m2gtkdemo.mod

MODULE m2gtkdemo ;

(*
   m2-GTK4 - an m2 gtk-demo.

   A browser in the spirit of GTK's own gtk4-demo: a searchable sidebar
   listing every demo in DemoCatalog, and an info pane describing the
   selected demo.  Activating a demo (double-click / Enter) or pressing
   "Run" opens it in its own window; demos that have not been ported yet
   are shown as such.

   Build:  make demos
   Run:    ./build/demos/m2gtkdemo
*)

FROM Gio IMPORT g_application_run;
FROM GtkApplication IMPORT gtk_application_new;
FROM GtkApplicationWindow IMPORT gtk_application_window_new;
FROM GtkWindow IMPORT gtk_window_set_title, gtk_window_set_default_size,
   gtk_window_set_child, gtk_window_present;
FROM GtkBox IMPORT gtk_box_new, gtk_box_append, gtk_box_set_spacing;
FROM GtkPaned IMPORT gtk_paned_new, gtk_paned_set_start_child,
   gtk_paned_set_end_child, gtk_paned_set_position;
FROM GtkEnums IMPORT GtkVertical, GtkHorizontal;
FROM GtkWidget IMPORT gtk_widget_set_size_request, gtk_widget_set_vexpand,
   gtk_widget_set_hexpand, gtk_widget_set_margin_start,
   gtk_widget_set_margin_end, gtk_widget_set_margin_top,
   gtk_widget_set_margin_bottom;
FROM GtkLabel IMPORT gtk_label_new, gtk_label_set_text,
   gtk_label_set_wrap, gtk_label_set_max_width_chars;
FROM GtkButton IMPORT gtk_button_new_with_label;
FROM GtkSearchEntry IMPORT gtk_search_entry_new,
   gtk_search_entry_set_placeholder_text;
FROM GtkEditable IMPORT gtk_editable_get_text;
FROM GtkScrolledWindow IMPORT gtk_scrolled_window_new,
   gtk_scrolled_window_set_child;
FROM GtkListView IMPORT gtk_list_view_new;
FROM GtkListItem IMPORT gtk_list_item_get_item, gtk_list_item_get_child,
   gtk_list_item_set_child;
FROM GtkSignalListItemFactory IMPORT gtk_signal_list_item_factory_new;
FROM GtkSingleSelection IMPORT gtk_single_selection_new,
   gtk_single_selection_get_selected;
FROM GtkFilterListModel IMPORT gtk_filter_list_model_new;
FROM GtkCustomFilter IMPORT gtk_custom_filter_new,
   gtk_custom_filter_set_filter_func;
FROM GtkStringList IMPORT gtk_string_list_new, gtk_string_list_append;
FROM GtkStringObject IMPORT gtk_string_object_get_string;
FROM GListModel IMPORT g_list_model_get_item;
FROM GObject IMPORT g_signal_connect_data, g_object_unref, GConnectDefault;
FROM GtkClosures IMPORT Connect2, Connect3;
FROM GtkUtils IMPORT Connect, CStrToM2;
FROM GtkDemo IMPORT BuildByName, IsPorted;
FROM DemoCatalog IMPORT DemoCatalogCount, DemoCatalogGet;
FROM SYSTEM IMPORT ADDRESS, ADR;
FROM libc IMPORT printf;

CONST
   AppId = "org.example.m2gtk4.Demo4";
   Invalid = 0FFFFFFFFH;

VAR
   window, filter, filterModel, selection, infoTitle, infoBody, infoStatus,
   searchEntry: ADDRESS;
   query: ARRAY [0..63] OF CHAR;

PROCEDURE Contains (hay, needle: ARRAY OF CHAR) : BOOLEAN;
VAR
   i, j, hl, nl: CARDINAL;
   found: BOOLEAN;
BEGIN
   hl := 0;
   WHILE (hl <= HIGH(hay)) AND (hay[hl] # 0C) DO INC(hl) END;
   nl := 0;
   WHILE (nl <= HIGH(needle)) AND (needle[nl] # 0C) DO INC(nl) END;
   IF nl = 0 THEN RETURN TRUE END;
   IF nl > hl THEN RETURN FALSE END;
   i := 0;
   WHILE i + nl <= hl DO
      found := TRUE;
      j := 0;
      WHILE j < nl DO
         IF hay[i + j] # needle[j] THEN found := FALSE END;
         INC(j)
      END;
      IF found THEN RETURN TRUE END;
      INC(i)
   END;
   RETURN FALSE
END Contains;

PROCEDURE CopyStr (VAR dst: ARRAY OF CHAR; src: ARRAY OF CHAR);
VAR
   i: CARDINAL;
BEGIN
   i := 0;
   WHILE (i <= HIGH(dst)) AND (i <= HIGH(src)) AND (src[i] # 0C) DO
      dst[i] := src[i];
      INC(i)
   END;
   IF i <= HIGH(dst) THEN dst[i] := 0C END
END CopyStr;

PROCEDURE LookupByName (name: ARRAY OF CHAR;
                        VAR title, keywords, description: ARRAY OF CHAR);
VAR
   i: CARDINAL;
   n, t, k, d: ARRAY [0..511] OF CHAR;
BEGIN
   i := 0;
   WHILE i < DemoCatalogCount() DO
      DemoCatalogGet(i, n, t, k, d);
      IF Contains(n, name) AND Contains(name, n) THEN
         CopyStr(title, t); CopyStr(keywords, k); CopyStr(description, d);
         RETURN
      END;
      INC(i)
   END;
   title[0] := 0C; keywords[0] := 0C; description[0] := 0C
END LookupByName;

(* gboolean match(gpointer item, gpointer user) - item is a demo name *)
PROCEDURE Match (item: ADDRESS; user: ADDRESS) : INTEGER;
VAR
   name, title, keywords, description: ARRAY [0..511] OF CHAR;
BEGIN
   CStrToM2(gtk_string_object_get_string(item), name);
   LookupByName(name, title, keywords, description);
   IF Contains(title, query) OR Contains(keywords, query) THEN
      RETURN 1
   ELSE
      RETURN 0
   END
END Match;

PROCEDURE UpdateInfo (name: ARRAY OF CHAR);
VAR
   title, keywords, description: ARRAY [0..1023] OF CHAR;
BEGIN
   LookupByName(name, title, keywords, description);

   gtk_label_set_text(infoTitle, title);
   gtk_label_set_text(infoBody, description);
   IF IsPorted(name) THEN
      gtk_label_set_text(infoStatus, "Ported to Modula-2.  Press Run.")
   ELSE
      gtk_label_set_text(infoStatus, "Not ported yet.")
   END
END UpdateInfo;

PROCEDURE NameAtSelection (VAR name: ARRAY OF CHAR);
VAR
   index: CARDINAL;
   item: ADDRESS;
BEGIN
   name[0] := 0C;
   index := gtk_single_selection_get_selected(selection);
   IF index # Invalid THEN
      item := g_list_model_get_item(filterModel, index);
      CStrToM2(gtk_string_object_get_string(item), name);
      g_object_unref(item)
   END
END NameAtSelection;

PROCEDURE RunSelected;
VAR
   name: ARRAY [0..511] OF CHAR;
   demoWindow: ADDRESS;
BEGIN
   NameAtSelection(name);
   IF name[0] # 0C THEN
      UpdateInfo(name);
      IF IsPorted(name) THEN
         demoWindow := BuildByName(name, window);
         IF demoWindow = NIL THEN
            printf("demo %s could not be built\n", name)
         END
      END
   END
END RunSelected;

(* void activate(GtkListView *list, guint position, gpointer user) *)
PROCEDURE OnActivate (list: ADDRESS; position: CARDINAL; user: ADDRESS);
VAR
   item, demoWindow: ADDRESS;
   name: ARRAY [0..511] OF CHAR;
BEGIN
   item := g_list_model_get_item(filterModel, position);
   CStrToM2(gtk_string_object_get_string(item), name);
   g_object_unref(item);
   UpdateInfo(name);
   IF IsPorted(name) THEN
      demoWindow := BuildByName(name, window)
   END
END OnActivate;

PROCEDURE OnRun (button: ADDRESS; user: ADDRESS);
BEGIN
   RunSelected
END OnRun;

PROCEDURE OnSelectionChanged (sel: ADDRESS; user: ADDRESS);
BEGIN
   RunSelected
END OnSelectionChanged;

PROCEDURE OnSearchChanged (entry: ADDRESS; user: ADDRESS);
BEGIN
   CStrToM2(gtk_editable_get_text(entry), query);
   gtk_custom_filter_set_filter_func(filter, ADR(Match), NIL, NIL)
END OnSearchChanged;

PROCEDURE RowSetup (factory: ADDRESS; item: ADDRESS; user: ADDRESS);
BEGIN
   gtk_list_item_set_child(item, gtk_label_new(""))
END RowSetup;

PROCEDURE RowBind (factory: ADDRESS; item: ADDRESS; user: ADDRESS);
VAR
   obj, child: ADDRESS;
   name, title, keywords, description: ARRAY [0..511] OF CHAR;
BEGIN
   obj := gtk_list_item_get_item(item);
   CStrToM2(gtk_string_object_get_string(obj), name);
   LookupByName(name, title, keywords, description);
   child := gtk_list_item_get_child(item);
   gtk_label_set_text(child, title)
END RowBind;

PROCEDURE OnActivateApp (application: ADDRESS; data: ADDRESS);
VAR
   root, paned, sidebar, listView, factory, store, runButton, info: ADDRESS;
   name, title, keywords, description: ARRAY [0..511] OF CHAR;
   i: CARDINAL;
BEGIN
   query[0] := 0C;

   store := gtk_string_list_new(NIL);
   i := 0;
   WHILE i < DemoCatalogCount() DO
      DemoCatalogGet(i, name, title, keywords, description);
      gtk_string_list_append(store, name);
      INC(i)
   END;

   filter := gtk_custom_filter_new(ADR(Match), NIL, NIL);
   filterModel := gtk_filter_list_model_new(store, filter);
   selection := gtk_single_selection_new(filterModel);

   factory := gtk_signal_list_item_factory_new();
   Connect3(factory, "setup", RowSetup, NIL);
   Connect3(factory, "bind", RowBind, NIL);

   listView := gtk_list_view_new(selection, factory);
   gtk_widget_set_vexpand(listView, 1);
   g_signal_connect_data(listView, "activate", ADR(OnActivate), NIL, NIL,
                         GConnectDefault);
   Connect2(selection, "notify::selected", OnSelectionChanged, NIL);

   searchEntry := gtk_search_entry_new();
   gtk_search_entry_set_placeholder_text(searchEntry, "Search demos");
   Connect2(searchEntry, "search-changed", OnSearchChanged, NIL);

   sidebar := gtk_box_new(GtkVertical, 6);
   gtk_box_set_spacing(sidebar, 6);
   gtk_box_append(sidebar, searchEntry);
   gtk_box_append(sidebar, listView);
   gtk_widget_set_size_request(sidebar, 240, -1);

   infoTitle := gtk_label_new("");
   gtk_label_set_wrap(infoTitle, 1);
   gtk_label_set_max_width_chars(infoTitle, 40);
   gtk_widget_set_margin_start(infoTitle, 12);
   gtk_widget_set_margin_end(infoTitle, 12);
   gtk_widget_set_margin_top(infoTitle, 12);

   infoBody := gtk_label_new("");
   gtk_label_set_wrap(infoBody, 1);
   gtk_label_set_max_width_chars(infoBody, 50);
   gtk_widget_set_margin_start(infoBody, 12);
   gtk_widget_set_margin_end(infoBody, 12);

   infoStatus := gtk_label_new("");
   gtk_label_set_wrap(infoStatus, 1);
   gtk_widget_set_margin_start(infoStatus, 12);
   gtk_widget_set_margin_end(infoStatus, 12);

   runButton := gtk_button_new_with_label("Run selected demo");
   gtk_widget_set_margin_start(runButton, 12);
   gtk_widget_set_margin_end(runButton, 12);
   gtk_widget_set_margin_bottom(runButton, 12);
   Connect2(runButton, "clicked", OnRun, NIL);

   info := gtk_box_new(GtkVertical, 10);
   gtk_box_set_spacing(info, 10);
   gtk_box_append(info, infoTitle);
   gtk_box_append(info, infoBody);
   gtk_box_append(info, infoStatus);
   gtk_box_append(info, runButton);

   paned := gtk_paned_new(GtkHorizontal);
   gtk_paned_set_start_child(paned, sidebar);
   gtk_paned_set_end_child(paned, info);
   gtk_paned_set_position(paned, 260);

   root := gtk_box_new(GtkVertical, 0);
   gtk_box_append(root, paned);

   window := gtk_application_window_new(application);
   gtk_window_set_title(window, "m2-GTK4 Demo");
   gtk_window_set_default_size(window, 760, 520);
   gtk_window_set_child(window, root);
   gtk_window_present(window)
END OnActivateApp;

VAR
   app: ADDRESS;
BEGIN
   app := gtk_application_new(AppId, 0);
   IF app = NIL THEN
      printf("gtk_application_new failed\n");
      HALT(1)
   END;
   Connect2(app, "activate", OnActivateApp, NIL);
   g_application_run(app, 0, NIL)
END m2gtkdemo.