m2-GTK4/demos/DemosBasic.mod

IMPLEMENTATION MODULE DemosBasic ;

(*
   See the GTK C originals: spinner.c, panes.c, overlay.c.
*)

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_sensitive, gtk_widget_set_hexpand, gtk_widget_set_vexpand,
   gtk_widget_set_halign, gtk_widget_set_valign, gtk_widget_set_can_target;
FROM GtkEnums IMPORT GtkVertical, GtkHorizontal, GtkAlignCenter,
   GtkAlignStart;
FROM GtkBox IMPORT gtk_box_new, gtk_box_append, gtk_box_set_spacing;
FROM GtkSpinner IMPORT gtk_spinner_new, gtk_spinner_start, gtk_spinner_stop;
FROM GtkEntry IMPORT gtk_entry_new, gtk_entry_set_placeholder_text;
FROM GtkButton IMPORT gtk_button_new_with_label, gtk_button_get_label;
FROM GtkEditable IMPORT gtk_editable_set_text;
FROM GtkLabel IMPORT gtk_label_new, gtk_label_set_use_markup;
FROM GtkPaned IMPORT gtk_paned_new, gtk_paned_set_start_child,
   gtk_paned_set_end_child, gtk_paned_set_shrink_start_child,
   gtk_paned_set_shrink_end_child;
FROM GtkFrame IMPORT gtk_frame_new, gtk_frame_set_child;
FROM GtkOverlay IMPORT gtk_overlay_new, gtk_overlay_add_overlay,
   gtk_overlay_set_child;
FROM GtkGrid IMPORT gtk_grid_new, gtk_grid_attach;
FROM GtkUtils IMPORT Connect, IntToStr, CStrToM2;
FROM GtkClosures IMPORT Connect2;
FROM libc IMPORT printf;

(* ------------------------------------------------------------------ *)
(* Spinner                                                            *)
(* ------------------------------------------------------------------ *)

VAR
   spinnerWindow, spinnerSensitive, spinnerUnsafe: ADDRESS;

PROCEDURE OnPlay (button: ADDRESS; data: ADDRESS);
BEGIN
   gtk_spinner_start(spinnerSensitive);
   gtk_spinner_start(spinnerUnsafe)
END OnPlay;

PROCEDURE OnStop (button: ADDRESS; data: ADDRESS);
BEGIN
   gtk_spinner_stop(spinnerSensitive);
   gtk_spinner_stop(spinnerUnsafe)
END OnStop;

PROCEDURE DoSpinner (doWidget: ADDRESS) : ADDRESS;
VAR
   vbox, hbox, button, spinner: ADDRESS;
BEGIN
   IF spinnerWindow = NIL THEN
      spinnerWindow := gtk_window_new();
      gtk_window_set_title(spinnerWindow, "Spinner");
      gtk_window_set_resizable(spinnerWindow, 0);

      vbox := gtk_box_new(GtkVertical, 10);
      gtk_widget_set_margin_top(vbox, 5);
      gtk_widget_set_margin_bottom(vbox, 5);
      gtk_widget_set_margin_start(vbox, 5);
      gtk_widget_set_margin_end(vbox, 5);
      gtk_window_set_child(spinnerWindow, vbox);

      (* sensitive *)
      hbox := gtk_box_new(GtkHorizontal, 5);
      spinner := gtk_spinner_new();
      gtk_box_append(hbox, spinner);
      gtk_box_append(hbox, gtk_entry_new());
      gtk_box_append(vbox, hbox);
      spinnerSensitive := spinner;

      (* disabled *)
      hbox := gtk_box_new(GtkHorizontal, 5);
      spinner := gtk_spinner_new();
      gtk_box_append(hbox, spinner);
      gtk_box_append(hbox, gtk_entry_new());
      gtk_box_append(vbox, hbox);
      spinnerUnsafe := spinner;
      gtk_widget_set_sensitive(hbox, 0);

      button := gtk_button_new_with_label("Play");
      Connect2(button, "clicked", OnPlay, NIL);
      gtk_box_append(vbox, button);

      button := gtk_button_new_with_label("Stop");
      Connect2(button, "clicked", OnStop, NIL);
      gtk_box_append(vbox, button);

      OnPlay(NIL, NIL)
   END;

   IF gtk_widget_get_visible(spinnerWindow) = 0 THEN
      gtk_widget_set_visible(spinnerWindow, 1)
   ELSE
      gtk_window_destroy(spinnerWindow);
      spinnerWindow := NIL
   END;
   RETURN spinnerWindow
END DoSpinner;

(* ------------------------------------------------------------------ *)
(* Paned widgets                                                      *)
(* ------------------------------------------------------------------ *)

VAR
   panesWindow: ADDRESS;

PROCEDURE PaneLabel (text: ARRAY OF CHAR) : ADDRESS;
VAR
   label: ADDRESS;
BEGIN
   label := gtk_label_new(text);
   gtk_widget_set_margin_start(label, 4);
   gtk_widget_set_margin_end(label, 4);
   gtk_widget_set_margin_top(label, 4);
   gtk_widget_set_margin_bottom(label, 4);
   gtk_widget_set_hexpand(label, 1);
   gtk_widget_set_vexpand(label, 1);
   RETURN label
END PaneLabel;

PROCEDURE DoPanes (doWidget: ADDRESS) : ADDRESS;
VAR
   frame, hpaned, vpaned, vbox: ADDRESS;
BEGIN
   IF panesWindow = NIL THEN
      panesWindow := gtk_window_new();
      gtk_window_set_title(panesWindow, "Paned Widgets");
      gtk_window_set_default_size(panesWindow, 330, 250);
      gtk_window_set_resizable(panesWindow, 0);

      vbox := gtk_box_new(GtkVertical, 8);
      gtk_widget_set_margin_start(vbox, 8);
      gtk_widget_set_margin_end(vbox, 8);
      gtk_widget_set_margin_top(vbox, 8);
      gtk_widget_set_margin_bottom(vbox, 8);
      gtk_window_set_child(panesWindow, vbox);

      frame := gtk_frame_new("");
      gtk_box_append(vbox, frame);

      vpaned := gtk_paned_new(GtkVertical);
      gtk_frame_set_child(frame, vpaned);

      hpaned := gtk_paned_new(GtkHorizontal);
      gtk_paned_set_start_child(vpaned, hpaned);
      gtk_paned_set_shrink_start_child(vpaned, 0);

      gtk_paned_set_start_child(hpaned, PaneLabel("Hi there"));
      gtk_paned_set_shrink_start_child(hpaned, 0);
      gtk_paned_set_end_child(hpaned, PaneLabel("Hello"));
      gtk_paned_set_shrink_end_child(hpaned, 0);

      gtk_paned_set_end_child(vpaned, PaneLabel("Goodbye"));
      gtk_paned_set_shrink_end_child(vpaned, 0)
   END;

   IF gtk_widget_get_visible(panesWindow) = 0 THEN
      gtk_widget_set_visible(panesWindow, 1)
   ELSE
      gtk_window_destroy(panesWindow);
      panesWindow := NIL
   END;
   RETURN panesWindow
END DoPanes;

(* ------------------------------------------------------------------ *)
(* Interactive Overlay                                                *)
(* ------------------------------------------------------------------ *)

VAR
   overlayWindow: ADDRESS;

(* void do_number(GtkButton *button, GtkEntry *entry) *)
PROCEDURE OnNumber (button: ADDRESS; entry: ADDRESS);
VAR
   buf: ARRAY [0..63] OF CHAR;
BEGIN
   CStrToM2(gtk_button_get_label(button), buf);
   gtk_editable_set_text(entry, buf)
END OnNumber;

PROCEDURE GridButton (entry: ADDRESS; n: INTEGER) : ADDRESS;
VAR
   button: ADDRESS;
   text: ARRAY [0..15] OF CHAR;
BEGIN
   IntToStr(n, text);
   button := gtk_button_new_with_label(text);
   gtk_widget_set_hexpand(button, 1);
   gtk_widget_set_vexpand(button, 1);
   Connect2(button, "clicked", OnNumber, entry);
   RETURN button
END GridButton;

PROCEDURE DoOverlay (doWidget: ADDRESS) : ADDRESS;
VAR
   overlay, grid, button, vbox, label, entry: ADDRESS;
   i, j: INTEGER;
BEGIN
   IF overlayWindow = NIL THEN
      overlayWindow := gtk_window_new();
      gtk_window_set_default_size(overlayWindow, 500, 510);
      gtk_window_set_title(overlayWindow, "Interactive Overlay");

      overlay := gtk_overlay_new();
      grid := gtk_grid_new();
      gtk_overlay_set_child(overlay, grid);

      entry := gtk_entry_new();

      FOR j := 0 TO 4 DO
         FOR i := 0 TO 4 DO
            button := GridButton(entry, 5 * j + i);
            gtk_grid_attach(grid, button, i, j, 1, 1)
         END
      END;

      vbox := gtk_box_new(GtkVertical, 10);
      gtk_widget_set_can_target(vbox, 0);
      gtk_overlay_add_overlay(overlay, vbox);
      gtk_widget_set_halign(vbox, GtkAlignCenter);
      gtk_widget_set_valign(vbox, GtkAlignStart);

      label := gtk_label_new
         ("<span foreground='blue' weight='ultrabold' font='40'>Numbers</span>");
      gtk_label_set_use_markup(label, 1);
      gtk_widget_set_can_target(label, 0);
      gtk_widget_set_margin_top(label, 8);
      gtk_widget_set_margin_bottom(label, 8);
      gtk_box_append(vbox, label);

      vbox := gtk_box_new(GtkVertical, 10);
      gtk_overlay_add_overlay(overlay, vbox);
      gtk_widget_set_halign(vbox, GtkAlignCenter);
      gtk_widget_set_valign(vbox, GtkAlignCenter);

      gtk_entry_set_placeholder_text(entry, "Your Lucky Number");
      gtk_widget_set_margin_top(entry, 8);
      gtk_widget_set_margin_bottom(entry, 8);
      gtk_box_append(vbox, entry);

      gtk_window_set_child(overlayWindow, overlay)
   END;

   IF gtk_widget_get_visible(overlayWindow) = 0 THEN
      gtk_widget_set_visible(overlayWindow, 1)
   ELSE
      gtk_window_destroy(overlayWindow);
      overlayWindow := NIL
   END;
   RETURN overlayWindow
END DoOverlay;

END DemosBasic.