|
|
@@ -0,0 +1,356 @@
|
|
|
+IMPLEMENTATION MODULE DemoImpl ;
|
|
|
+
|
|
|
+(*
|
|
|
+ Five demos ported from the GTK source tree (gtk/demos/gtk-demo),
|
|
|
+ simplified to the features bound by m2-GTK4:
|
|
|
+ Links (links.c) - markup with hyperlinks + activate-link
|
|
|
+ List Box (listbox.c) - rows in a GtkListBox
|
|
|
+ Flow Box (flowbox.c) - reflowing color swatches
|
|
|
+ Expander (expander.c) - collapsible scrolled text
|
|
|
+ CSS Basics (css_basics.c) - live CSS editing
|
|
|
+*)
|
|
|
+
|
|
|
+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_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_vexpand, gtk_widget_add_css_class;
|
|
|
+FROM GtkEnums IMPORT GtkVertical, GtkSelectionNone;
|
|
|
+FROM GtkLabel IMPORT gtk_label_new, gtk_label_set_use_markup,
|
|
|
+ gtk_label_set_wrap, gtk_label_set_wrap_mode, gtk_label_set_max_width_chars;
|
|
|
+FROM GtkBox IMPORT gtk_box_new, gtk_box_append, gtk_box_set_spacing;
|
|
|
+FROM GtkScrolledWindow IMPORT gtk_scrolled_window_new,
|
|
|
+ gtk_scrolled_window_set_child, gtk_scrolled_window_set_min_content_height,
|
|
|
+ gtk_scrolled_window_set_has_frame;
|
|
|
+FROM GtkListBox IMPORT gtk_list_box_new, gtk_list_box_append,
|
|
|
+ gtk_list_box_row_new, gtk_list_box_row_set_child;
|
|
|
+FROM GtkFlowBox IMPORT gtk_flow_box_new, gtk_flow_box_append,
|
|
|
+ gtk_flow_box_set_selection_mode, gtk_flow_box_set_max_children_per_line;
|
|
|
+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 GtkButton IMPORT gtk_button_new, gtk_button_set_child;
|
|
|
+FROM GtkExpander IMPORT gtk_expander_new, gtk_expander_set_child;
|
|
|
+FROM GtkTextView IMPORT gtk_text_view_new, gtk_text_view_new_with_buffer;
|
|
|
+FROM GtkTextBuffer IMPORT gtk_text_buffer_new, gtk_text_buffer_set_text,
|
|
|
+ gtk_text_buffer_get_text, gtk_text_buffer_get_start_iter,
|
|
|
+ gtk_text_buffer_get_end_iter;
|
|
|
+FROM GtkTextIter IMPORT GtkTextIter;
|
|
|
+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 GtkAlertDialog IMPORT gtk_alert_dialog_new, gtk_alert_dialog_set_detail,
|
|
|
+ gtk_alert_dialog_show;
|
|
|
+FROM Gdk IMPORT gdk_display_get_default, GdkRGBA, gdk_rgba_parse,
|
|
|
+ gdk_cairo_set_source_rgba;
|
|
|
+FROM Cairo IMPORT cairo_paint;
|
|
|
+FROM GObject IMPORT g_signal_connect_data, g_object_unref, GConnectDefault;
|
|
|
+FROM GtkClosures IMPORT Connect2;
|
|
|
+FROM GtkUtils IMPORT IntToStr, Free, CStrToM2;
|
|
|
+FROM GLib IMPORT g_strcmp0;
|
|
|
+FROM libc IMPORT printf;
|
|
|
+
|
|
|
+(* ------------------------------------------------------------------ *)
|
|
|
+(* Links *)
|
|
|
+(* ------------------------------------------------------------------ *)
|
|
|
+
|
|
|
+VAR
|
|
|
+ linksWindow: ADDRESS;
|
|
|
+
|
|
|
+CONST
|
|
|
+ LinksMarkup = "Some <a href='http://en.wikipedia.org/wiki/Text' title='plain text'>text</a> may be marked up as hyperlinks, which can be clicked or activated via <a href='keynav'>keynav</a>, working fine alongside other markup such as <a href='http://www.flathub.org/'><b>Flathub</b></a>.";
|
|
|
+
|
|
|
+(* gboolean activate_link(GtkWidget *label, const char *uri, gpointer data) *)
|
|
|
+PROCEDURE OnActivateLink (label: ADDRESS; uri: ADDRESS; data: ADDRESS) : INTEGER;
|
|
|
+VAR
|
|
|
+ dialog: ADDRESS;
|
|
|
+ key: ARRAY [0..7] OF CHAR;
|
|
|
+BEGIN
|
|
|
+ key := "keynav";
|
|
|
+ IF g_strcmp0(uri, ADR(key)) = 0 THEN
|
|
|
+ dialog := gtk_alert_dialog_new("Keyboard navigation");
|
|
|
+ gtk_alert_dialog_set_detail(dialog,
|
|
|
+ "keynav is a shorthand for keyboard navigation.");
|
|
|
+ gtk_alert_dialog_show(dialog, NIL);
|
|
|
+ g_object_unref(dialog);
|
|
|
+ RETURN 1
|
|
|
+ END;
|
|
|
+ RETURN 0
|
|
|
+END OnActivateLink;
|
|
|
+
|
|
|
+PROCEDURE DoLinks (doWidget: ADDRESS) : ADDRESS;
|
|
|
+VAR
|
|
|
+ label: ADDRESS;
|
|
|
+BEGIN
|
|
|
+ IF linksWindow = NIL THEN
|
|
|
+ linksWindow := gtk_window_new();
|
|
|
+ gtk_window_set_title(linksWindow, "Links");
|
|
|
+ gtk_window_set_resizable(linksWindow, 0);
|
|
|
+ label := gtk_label_new(LinksMarkup);
|
|
|
+ gtk_label_set_use_markup(label, 1);
|
|
|
+ gtk_label_set_max_width_chars(label, 40);
|
|
|
+ gtk_label_set_wrap(label, 1);
|
|
|
+ gtk_label_set_wrap_mode(label, 0); (* PANGO_WRAP_WORD *)
|
|
|
+ g_signal_connect_data(label, "activate-link", ADR(OnActivateLink),
|
|
|
+ NIL, NIL, GConnectDefault);
|
|
|
+ gtk_widget_set_margin_start(label, 20);
|
|
|
+ gtk_widget_set_margin_end(label, 20);
|
|
|
+ gtk_widget_set_margin_top(label, 20);
|
|
|
+ gtk_widget_set_margin_bottom(label, 20);
|
|
|
+ gtk_window_set_child(linksWindow, label)
|
|
|
+ END;
|
|
|
+
|
|
|
+ IF gtk_widget_get_visible(linksWindow) = 0 THEN
|
|
|
+ gtk_widget_set_visible(linksWindow, 1)
|
|
|
+ ELSE
|
|
|
+ gtk_window_destroy(linksWindow);
|
|
|
+ linksWindow := NIL
|
|
|
+ END;
|
|
|
+ RETURN linksWindow
|
|
|
+END DoLinks;
|
|
|
+
|
|
|
+(* ------------------------------------------------------------------ *)
|
|
|
+(* List Box *)
|
|
|
+(* ------------------------------------------------------------------ *)
|
|
|
+
|
|
|
+VAR
|
|
|
+ listBoxWindow: ADDRESS;
|
|
|
+
|
|
|
+PROCEDURE DoListBox (doWidget: ADDRESS) : ADDRESS;
|
|
|
+VAR
|
|
|
+ box, row, sw: ADDRESS;
|
|
|
+ i: INTEGER;
|
|
|
+ text: ARRAY [0..15] OF CHAR;
|
|
|
+BEGIN
|
|
|
+ IF listBoxWindow = NIL THEN
|
|
|
+ listBoxWindow := gtk_window_new();
|
|
|
+ gtk_window_set_title(listBoxWindow, "List Box");
|
|
|
+ gtk_window_set_default_size(listBoxWindow, 260, 220);
|
|
|
+
|
|
|
+ box := gtk_list_box_new();
|
|
|
+ FOR i := 1 TO 5 DO
|
|
|
+ row := gtk_list_box_row_new();
|
|
|
+ IntToStr(i, text);
|
|
|
+ gtk_list_box_row_set_child(row, gtk_label_new(text));
|
|
|
+ gtk_list_box_append(box, row)
|
|
|
+ END;
|
|
|
+
|
|
|
+ sw := gtk_scrolled_window_new();
|
|
|
+ gtk_scrolled_window_set_child(sw, box);
|
|
|
+ gtk_window_set_child(listBoxWindow, sw)
|
|
|
+ END;
|
|
|
+
|
|
|
+ IF gtk_widget_get_visible(listBoxWindow) = 0 THEN
|
|
|
+ gtk_widget_set_visible(listBoxWindow, 1)
|
|
|
+ ELSE
|
|
|
+ gtk_window_destroy(listBoxWindow);
|
|
|
+ listBoxWindow := NIL
|
|
|
+ END;
|
|
|
+ RETURN listBoxWindow
|
|
|
+END DoListBox;
|
|
|
+
|
|
|
+(* ------------------------------------------------------------------ *)
|
|
|
+(* Flow Box *)
|
|
|
+(* ------------------------------------------------------------------ *)
|
|
|
+
|
|
|
+VAR
|
|
|
+ flowBoxWindow: ADDRESS;
|
|
|
+ colors: ARRAY [0..11] OF ARRAY [0..31] OF CHAR;
|
|
|
+
|
|
|
+(* void draw_color(GtkDrawingArea *area, cairo_t *cr, int w, int h, gpointer d) *)
|
|
|
+PROCEDURE DrawColor (area: ADDRESS; cr: ADDRESS; width, height: INTEGER;
|
|
|
+ data: ADDRESS);
|
|
|
+VAR
|
|
|
+ spec: ARRAY [0..31] OF CHAR;
|
|
|
+ rgba: GdkRGBA;
|
|
|
+BEGIN
|
|
|
+ CStrToM2(data, spec);
|
|
|
+ IF gdk_rgba_parse(rgba, spec) # 0 THEN
|
|
|
+ gdk_cairo_set_source_rgba(cr, rgba);
|
|
|
+ cairo_paint(cr)
|
|
|
+ END
|
|
|
+END DrawColor;
|
|
|
+
|
|
|
+PROCEDURE ColorSwatch (color: ADDRESS) : ADDRESS;
|
|
|
+VAR
|
|
|
+ button, area: ADDRESS;
|
|
|
+BEGIN
|
|
|
+ button := gtk_button_new();
|
|
|
+ area := gtk_drawing_area_new();
|
|
|
+ gtk_drawing_area_set_content_width(area, 24);
|
|
|
+ gtk_drawing_area_set_content_height(area, 24);
|
|
|
+ gtk_drawing_area_set_draw_func(area, ADR(DrawColor), color, NIL);
|
|
|
+ gtk_button_set_child(button, area);
|
|
|
+ RETURN button
|
|
|
+END ColorSwatch;
|
|
|
+
|
|
|
+PROCEDURE DoFlowBox (doWidget: ADDRESS) : ADDRESS;
|
|
|
+VAR
|
|
|
+ sw, flowbox: ADDRESS;
|
|
|
+ i: INTEGER;
|
|
|
+BEGIN
|
|
|
+ IF flowBoxWindow = NIL THEN
|
|
|
+ flowBoxWindow := gtk_window_new();
|
|
|
+ gtk_window_set_title(flowBoxWindow, "Flow Box");
|
|
|
+ gtk_window_set_default_size(flowBoxWindow, 320, 260);
|
|
|
+
|
|
|
+ colors[0] := "AliceBlue"; colors[1] := "AntiqueWhite";
|
|
|
+ colors[2] := "aqua"; colors[3] := "blue";
|
|
|
+ colors[4] := "chartreuse"; colors[5] := "coral";
|
|
|
+ colors[6] := "crimson"; colors[7] := "DarkOrange";
|
|
|
+ colors[8] := "gold"; colors[9] := "ForestGreen";
|
|
|
+ colors[10] := "Orchid"; colors[11] := "SteelBlue";
|
|
|
+
|
|
|
+ flowbox := gtk_flow_box_new();
|
|
|
+ gtk_flow_box_set_selection_mode(flowbox, GtkSelectionNone);
|
|
|
+ gtk_flow_box_set_max_children_per_line(flowbox, 8);
|
|
|
+ FOR i := 0 TO 11 DO
|
|
|
+ gtk_flow_box_append(flowbox, ColorSwatch(ADR(colors[i])))
|
|
|
+ END;
|
|
|
+
|
|
|
+ sw := gtk_scrolled_window_new();
|
|
|
+ gtk_scrolled_window_set_child(sw, flowbox);
|
|
|
+ gtk_window_set_child(flowBoxWindow, sw)
|
|
|
+ END;
|
|
|
+
|
|
|
+ IF gtk_widget_get_visible(flowBoxWindow) = 0 THEN
|
|
|
+ gtk_widget_set_visible(flowBoxWindow, 1)
|
|
|
+ ELSE
|
|
|
+ gtk_window_destroy(flowBoxWindow);
|
|
|
+ flowBoxWindow := NIL
|
|
|
+ END;
|
|
|
+ RETURN flowBoxWindow
|
|
|
+END DoFlowBox;
|
|
|
+
|
|
|
+(* ------------------------------------------------------------------ *)
|
|
|
+(* Expander *)
|
|
|
+(* ------------------------------------------------------------------ *)
|
|
|
+
|
|
|
+VAR
|
|
|
+ expanderWindow: ADDRESS;
|
|
|
+
|
|
|
+PROCEDURE DoExpander (doWidget: ADDRESS) : ADDRESS;
|
|
|
+VAR
|
|
|
+ box, expander, sw, tv: ADDRESS;
|
|
|
+BEGIN
|
|
|
+ IF expanderWindow = NIL THEN
|
|
|
+ expanderWindow := gtk_window_new();
|
|
|
+ gtk_window_set_title(expanderWindow, "Expander");
|
|
|
+ gtk_window_set_default_size(expanderWindow, 320, 260);
|
|
|
+
|
|
|
+ box := gtk_box_new(GtkVertical, 10);
|
|
|
+ gtk_box_set_spacing(box, 10);
|
|
|
+ gtk_widget_set_margin_start(box, 10);
|
|
|
+ gtk_widget_set_margin_end(box, 10);
|
|
|
+ gtk_widget_set_margin_top(box, 10);
|
|
|
+ gtk_widget_set_margin_bottom(box, 10);
|
|
|
+
|
|
|
+ gtk_box_append(box, gtk_label_new("Here are some more details:"));
|
|
|
+ expander := gtk_expander_new("Details:");
|
|
|
+ gtk_widget_set_vexpand(expander, 1);
|
|
|
+
|
|
|
+ tv := gtk_text_view_new();
|
|
|
+ sw := gtk_scrolled_window_new();
|
|
|
+ gtk_scrolled_window_set_min_content_height(sw, 100);
|
|
|
+ gtk_scrolled_window_set_has_frame(sw, 1);
|
|
|
+ gtk_scrolled_window_set_child(sw, tv);
|
|
|
+ gtk_widget_set_vexpand(sw, 1);
|
|
|
+ gtk_expander_set_child(expander, sw);
|
|
|
+ gtk_box_append(box, expander);
|
|
|
+
|
|
|
+ gtk_window_set_child(expanderWindow, box)
|
|
|
+ END;
|
|
|
+
|
|
|
+ IF gtk_widget_get_visible(expanderWindow) = 0 THEN
|
|
|
+ gtk_widget_set_visible(expanderWindow, 1)
|
|
|
+ ELSE
|
|
|
+ gtk_window_destroy(expanderWindow);
|
|
|
+ expanderWindow := NIL
|
|
|
+ END;
|
|
|
+ RETURN expanderWindow
|
|
|
+END DoExpander;
|
|
|
+
|
|
|
+(* ------------------------------------------------------------------ *)
|
|
|
+(* CSS Basics *)
|
|
|
+(* ------------------------------------------------------------------ *)
|
|
|
+
|
|
|
+VAR
|
|
|
+ cssWindow, cssBuffer, cssProvider: ADDRESS;
|
|
|
+
|
|
|
+CONST
|
|
|
+ InitialCss = ".sample { color: #1c71d8; font-weight: bold; font-size: 20px; }";
|
|
|
+
|
|
|
+PROCEDURE ApplyCss;
|
|
|
+VAR
|
|
|
+ start, stop: GtkTextIter;
|
|
|
+ text: ADDRESS;
|
|
|
+ buf: ARRAY [0..1023] OF CHAR;
|
|
|
+BEGIN
|
|
|
+ gtk_text_buffer_get_start_iter(cssBuffer, start);
|
|
|
+ gtk_text_buffer_get_end_iter(cssBuffer, stop);
|
|
|
+ text := gtk_text_buffer_get_text(cssBuffer, start, stop, 0);
|
|
|
+ IF text # NIL THEN
|
|
|
+ CStrToM2(text, buf);
|
|
|
+ gtk_css_provider_load_from_string(cssProvider, buf);
|
|
|
+ Free(text)
|
|
|
+ END
|
|
|
+END ApplyCss;
|
|
|
+
|
|
|
+PROCEDURE OnCssChanged (buffer: ADDRESS; user: ADDRESS);
|
|
|
+BEGIN
|
|
|
+ ApplyCss
|
|
|
+END OnCssChanged;
|
|
|
+
|
|
|
+PROCEDURE DoCss (doWidget: ADDRESS) : ADDRESS;
|
|
|
+VAR
|
|
|
+ box, view, sw, sample: ADDRESS;
|
|
|
+BEGIN
|
|
|
+ IF cssWindow = NIL THEN
|
|
|
+ cssWindow := gtk_window_new();
|
|
|
+ gtk_window_set_title(cssWindow, "CSS Basics");
|
|
|
+ gtk_window_set_default_size(cssWindow, 400, 300);
|
|
|
+
|
|
|
+ cssProvider := gtk_css_provider_new();
|
|
|
+ gtk_style_context_add_provider_for_display(gdk_display_get_default(),
|
|
|
+ cssProvider, GtkStyleProviderPriorityApplication);
|
|
|
+
|
|
|
+ sample := gtk_label_new("Sample label (styled by the CSS below)");
|
|
|
+ gtk_widget_add_css_class(sample, "sample");
|
|
|
+
|
|
|
+ cssBuffer := gtk_text_buffer_new(NIL);
|
|
|
+ gtk_text_buffer_set_text(cssBuffer, InitialCss, -1);
|
|
|
+ view := gtk_text_view_new_with_buffer(cssBuffer);
|
|
|
+
|
|
|
+ sw := gtk_scrolled_window_new();
|
|
|
+ gtk_scrolled_window_set_child(sw, view);
|
|
|
+ gtk_scrolled_window_set_min_content_height(sw, 120);
|
|
|
+ gtk_widget_set_vexpand(sw, 1);
|
|
|
+
|
|
|
+ box := gtk_box_new(GtkVertical, 10);
|
|
|
+ gtk_box_set_spacing(box, 10);
|
|
|
+ gtk_widget_set_margin_start(box, 10);
|
|
|
+ gtk_widget_set_margin_end(box, 10);
|
|
|
+ gtk_widget_set_margin_top(box, 10);
|
|
|
+ gtk_widget_set_margin_bottom(box, 10);
|
|
|
+ gtk_box_append(box, sample);
|
|
|
+ gtk_box_append(box, sw);
|
|
|
+
|
|
|
+ Connect2(cssBuffer, "changed", OnCssChanged, NIL);
|
|
|
+ gtk_window_set_child(cssWindow, box);
|
|
|
+ ApplyCss
|
|
|
+ END;
|
|
|
+
|
|
|
+ IF gtk_widget_get_visible(cssWindow) = 0 THEN
|
|
|
+ gtk_widget_set_visible(cssWindow, 1)
|
|
|
+ ELSE
|
|
|
+ gtk_window_destroy(cssWindow);
|
|
|
+ cssWindow := NIL
|
|
|
+ END;
|
|
|
+ RETURN cssWindow
|
|
|
+END DoCss;
|
|
|
+
|
|
|
+END DemoImpl.
|