m2-GTK4/examples/demo.mod

MODULE demo ;

(*
   m2-GTK4 example - a small "gtk-demo"-style browser.

   A searchable sidebar (GtkListView over a GtkFilterListModel with a
   Modula-2 GtkCustomFilter) drives a GtkStack of demo pages.  Shows the
   infrastructure a full gtk-demo port would need.

   Build:  make examples
   Run:    ./build/examples/demo
*)

FROM Gio IMPORT g_application_run;
FROM GtkApplication IMPORT gtk_application_new;
FROM GtkWindow IMPORT gtk_application_window_new, 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 GtkEnums IMPORT GtkVertical, GtkHorizontal;
FROM GtkLabel IMPORT gtk_label_new, gtk_label_set_text;
FROM GtkButton IMPORT gtk_button_new_with_label;
FROM GtkListBox IMPORT gtk_list_box_new, gtk_list_box_append,
   gtk_list_box_row_new, gtk_list_box_row_set_child;
FROM GtkSearchEntry IMPORT gtk_search_entry_new,
   gtk_search_entry_set_placeholder_text;
FROM GtkEditable IMPORT gtk_editable_get_text;
FROM GtkWidget IMPORT gtk_widget_set_size_request, gtk_widget_set_vexpand,
   gtk_widget_set_hexpand, gtk_widget_add_css_class,
   gtk_widget_set_margin_start, gtk_widget_set_margin_end,
   gtk_widget_set_margin_top, gtk_widget_set_margin_bottom;
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 GtkStack IMPORT gtk_stack_new, gtk_stack_add_titled,
   gtk_stack_set_visible_child_name;
FROM GtkDrawingArea IMPORT gtk_drawing_area_new,
   gtk_drawing_area_set_content_width, gtk_drawing_area_set_content_height,
   gtk_drawing_area_set_draw_func;
FROM GtkCssProvider IMPORT gtk_css_provider_new,
   gtk_css_provider_load_from_string;
FROM GtkStyleContext IMPORT gtk_style_context_add_provider_for_display,
   GtkStyleProviderPriorityApplication;
FROM Gdk IMPORT gdk_display_get_default;
FROM GListStore IMPORT g_list_store_new, g_list_store_append;
FROM GListModel IMPORT g_list_model_get_item;
FROM GtkStringObject IMPORT gtk_string_object_new,
   gtk_string_object_get_string, gtk_string_object_get_type;
FROM Cairo IMPORT cairo_set_source_rgb, cairo_arc, cairo_fill,
   cairo_set_line_width, cairo_move_to, cairo_line_to, cairo_stroke;
FROM GObject IMPORT g_object_unref;
FROM GtkClosures IMPORT Connect2, Connect3;
FROM GtkUtils IMPORT CStrToM2;
FROM SYSTEM IMPORT ADDRESS, ADR;
FROM libc IMPORT printf;

CONST
   AppId = "org.example.m2gtk4.Demo";
   InvalidPosition = 0FFFFFFFFH;
   Css = ".demo-accent { color: #e01b24; font-weight: bold; }";

TYPE
   DemoProc = PROCEDURE () : ADDRESS;
   Demo = RECORD
      title: ARRAY [0..31] OF CHAR;
      build: DemoProc;
   END;

VAR
   stack, filter, filterModel, selection: ADDRESS;
   searchText: ARRAY [0..63] OF CHAR;

(* --- a couple of demo pages --- *)

PROCEDURE BuildWelcome () : ADDRESS;
BEGIN
   RETURN gtk_label_new("Welcome to the m2-GTK4 demo browser.")
END BuildWelcome;

PROCEDURE BuildButtons () : ADDRESS;
VAR box: ADDRESS;
BEGIN
   box := gtk_box_new(GtkVertical, 6);
   gtk_box_append(box, gtk_button_new_with_label("Click me"));
   gtk_box_append(box, gtk_button_new_with_label("Me too"));
   RETURN box
END BuildButtons;

PROCEDURE BuildList () : ADDRESS;
VAR box, row: ADDRESS; i: INTEGER;
BEGIN
   box := gtk_list_box_new();
   FOR i := 1 TO 3 DO
      row := gtk_list_box_row_new();
      gtk_list_box_row_set_child(row, gtk_label_new("A list row"));
      gtk_list_box_append(box, row)
   END;
   RETURN box
END BuildList;

PROCEDURE BuildCSS () : ADDRESS;
VAR label: ADDRESS;
BEGIN
   label := gtk_label_new("Styled by CSS");
   gtk_widget_add_css_class(label, "demo-accent");
   RETURN label
END BuildCSS;

PROCEDURE DrawDemo (area: ADDRESS; cr: ADDRESS; width, height: INTEGER;
                    data: ADDRESS);
BEGIN
   cairo_set_source_rgb(cr, 0.20, 0.50, 0.90);
   cairo_arc(cr, 80.0, 80.0, 50.0, 0.0, 6.2831853);
   cairo_fill(cr);
   cairo_set_source_rgb(cr, 0.90, 0.20, 0.20);
   cairo_set_line_width(cr, 6.0);
   cairo_move_to(cr, 150.0, 40.0);
   cairo_line_to(cr, 280.0, 120.0);
   cairo_stroke(cr)
END DrawDemo;

PROCEDURE BuildDrawing () : ADDRESS;
VAR area: ADDRESS;
BEGIN
   area := gtk_drawing_area_new();
   gtk_drawing_area_set_content_width(area, 300);
   gtk_drawing_area_set_content_height(area, 160);
   gtk_drawing_area_set_draw_func(area, ADR(DrawDemo), NIL, NIL);
   RETURN area
END BuildDrawing;

(* --- search filter --- *)

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 Match (item: ADDRESS; user: ADDRESS) : INTEGER;
VAR
   buf: ARRAY [0..63] OF CHAR;
BEGIN
   CStrToM2(gtk_string_object_get_string(item), buf);
   IF Contains(buf, searchText) THEN RETURN 1 ELSE RETURN 0 END
END Match;

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

PROCEDURE OnSelected (model: ADDRESS; pspec: ADDRESS; user: ADDRESS);
VAR
   index: CARDINAL;
   item: ADDRESS;
   name: ARRAY [0..31] OF CHAR;
BEGIN
   index := gtk_single_selection_get_selected(selection);
   IF index = InvalidPosition THEN RETURN END;
   item := g_list_model_get_item(filterModel, index);
   CStrToM2(gtk_string_object_get_string(item), name);
   g_object_unref(item);
   gtk_stack_set_visible_child_name(stack, name)
END OnSelected;

(* --- list factory --- *)

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;
   buf: ARRAY [0..63] OF CHAR;
BEGIN
   obj := gtk_list_item_get_item(item);
   CStrToM2(gtk_string_object_get_string(obj), buf);
   child := gtk_list_item_get_child(item);
   gtk_label_set_text(child, buf)
END RowBind;

PROCEDURE OnActivate (application: ADDRESS; data: ADDRESS);
VAR
   window, root, content, search, listView, factory, store, provider: ADDRESS;
   demos: ARRAY [0..4] OF Demo;
   i: INTEGER;
BEGIN
   searchText[0] := 0C;

   provider := gtk_css_provider_new();
   gtk_css_provider_load_from_string(provider, Css);
   gtk_style_context_add_provider_for_display(gdk_display_get_default(),
      provider, GtkStyleProviderPriorityApplication);

   demos[0].title := "Welcome"; demos[0].build := BuildWelcome;
   demos[1].title := "Buttons"; demos[1].build := BuildButtons;
   demos[2].title := "List";    demos[2].build := BuildList;
   demos[3].title := "CSS";     demos[3].build := BuildCSS;
   demos[4].title := "Drawing"; demos[4].build := BuildDrawing;

   store := g_list_store_new(gtk_string_object_get_type());
   stack := gtk_stack_new();
   FOR i := 0 TO 4 DO
      gtk_stack_add_titled(stack, demos[i].build(),
                           demos[i].title, demos[i].title);
      g_list_store_append(store, gtk_string_object_new(demos[i].title))
   END;

   filter := gtk_custom_filter_new(ADR(Match), NIL, NIL);
   filterModel := gtk_filter_list_model_new(store, filter);
   selection := gtk_single_selection_new(filterModel);
   Connect3(selection, "notify::selected", OnSelected, NIL);

   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_size_request(listView, 180, -1);
   gtk_widget_set_vexpand(listView, 1);

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

   content := gtk_box_new(GtkHorizontal, 0);
   gtk_widget_set_vexpand(content, 1);
   gtk_box_append(content, listView);
   gtk_box_append(content, stack);
   gtk_widget_set_hexpand(stack, 1);

   root := gtk_box_new(GtkVertical, 6);
   gtk_box_set_spacing(root, 6);
   gtk_widget_set_margin_top(root, 8);
   gtk_widget_set_margin_bottom(root, 8);
   gtk_widget_set_margin_start(root, 8);
   gtk_widget_set_margin_end(root, 8);
   gtk_box_append(root, search);
   gtk_box_append(root, content);

   window := gtk_application_window_new(application);
   gtk_window_set_title(window, "m2-GTK4 Demo");
   gtk_window_set_default_size(window, 640, 420);
   gtk_window_set_child(window, root);
   gtk_stack_set_visible_child_name(stack, "Welcome");
   gtk_window_present(window)
END OnActivate;

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", OnActivate, NIL);
   g_application_run(app, 0, NIL)
END demo.