m2-GTK4/demos/DemoImpl.mod

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.