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.