m2-GTK4/demos/DemosCanvas.mod

IMPLEMENTATION MODULE DemosCanvas ;

(*
   m2-GTK4 - the drawing/canvas gtk-demo demos:
     drawingarea.c -> DoDrawingArea
     gestures.c    -> DoGestures
     mask.c        -> DoMask
     snapping.c    -> DoSnapping

   The gtk-demo contract is: on the first call build the window and store
   it in a module-level variable; on later calls toggle the window's
   visibility, destroying it (and clearing the variable) when it is
   already visible.  Return the window, or NIL once destroyed.

   Only bindings under src/ are used, so a few C facilities are missing and
   those spots are simplified (each marked "SIMPLIFIED" below):
     * gtk_widget_queue_draw() is not bound.  Gesture/scribble state is
       still recorded, but the drawing areas cannot be repainted until GTK
       redraws them for another reason (e.g. an expose or resize).
     * drawingarea's groups_draw uses cairo_surface_create_similar(),
       cairo_get_target() and CAIRO_OPERATOR_DEST_OUT/ADD, none of which
       are bound; the knockout/composite is approximated by a black disc
       with the three coloured sub-discs drawn on top.
     * cairo_image_surface_get_width()/get_height() are not bound, so the
       scribble surface is (re)created on the "resize" signal only.
     * gtk_window_set_display(), the accessible-role/an accessible-relation
       setup and g_object_new(drawing area) are not bound; a plain
       gtk_drawing_area_new() is used.
     * gestures' rotate/zoom visualisation reads the gesture deltas from
       the signal arguments instead of gtk_gesture_*_get_*_delta(), and uses
       the widget centre instead of gtk_gesture_get_bounding_box_center();
       the touchpad 3-finger swipe and gtk_gesture_is_recognized() are not
       reproduced.
     * mask's Demo4Widget is a custom GskMaskNode widget with a Pango
       layout and a frame-clock tick callback; subclassing, GskMaskNode and
       gtk_widget_add_tick_callback() are not bound, so the "123" text is
       filled with a moving 8-stop gradient via Cairo instead.
     * snapping's GtkTiler is a custom GdkPaintable; a GtkDrawingArea is
       used instead, drawing the QR code on a pixel-snapped 43x43 grid with
       linear gradients between differing neighbours (the conic/radial
       corner cases are left white).
*)

FROM SYSTEM IMPORT ADDRESS, ADR;
FROM GtkWindow IMPORT gtk_window_new, gtk_window_set_title,
   gtk_window_set_default_size, 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_set_hexpand,
   gtk_widget_add_css_class, gtk_widget_get_width, gtk_widget_get_height,
   gtk_widget_add_controller;
FROM GtkEnums IMPORT GtkVertical, GtkHorizontal;
FROM GtkBox IMPORT gtk_box_new, gtk_box_append;
FROM GtkLabel IMPORT gtk_label_new;
FROM GtkFrame IMPORT gtk_frame_new, gtk_frame_set_child;
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 GtkGestures IMPORT gtk_gesture_drag_new, gtk_gesture_single_set_button,
   gtk_gesture_swipe_new, gtk_gesture_long_press_new,
   gtk_gesture_rotate_new, gtk_gesture_zoom_new;
FROM GtkEventController IMPORT gtk_event_controller_set_propagation_phase,
   GtkPhaseBubble;
FROM GtkScale IMPORT gtk_scale_new_with_range;
FROM GtkRange IMPORT gtk_range_set_value, gtk_range_get_value;
FROM GObject IMPORT g_signal_connect_data, GConnectDefault;
FROM GtkClosures IMPORT Connect2;
FROM Cairo IMPORT
   cairo_create, cairo_destroy, cairo_set_source_rgb, cairo_paint,
   cairo_set_source_surface, cairo_move_to, cairo_line_to,
   cairo_set_line_width, cairo_set_line_cap, cairo_stroke,
   cairo_save, cairo_restore, cairo_translate, cairo_scale, cairo_rotate,
   cairo_arc,
   cairo_close_path, cairo_rectangle, cairo_fill, cairo_set_source_rgba,
   cairo_surface_destroy, cairo_image_surface_create,
   cairo_pattern_create_linear, cairo_pattern_add_color_stop_rgb,
   cairo_set_source, cairo_pattern_destroy, cairo_select_font_face,
   cairo_set_font_size, cairo_text_path,
   CairoFormatARGB32, CairoLineCapRound,
   CairoFontSlantNormal, CairoFontWeightBold;

CONST
   Pi = 3.14159265358979;

VAR
   (* drawingarea *)
   drawingWindow, drawSurface: ADDRESS;
   dragStartX, dragStartY: REAL;

   (* gestures *)
   gesturesWindow: ADDRESS;
   swipeX, swipeY, rotateDelta, zoomScale: REAL;
   longPressed, hasRotate, hasZoom: BOOLEAN;

   (* mask *)
   maskWindow, maskScale: ADDRESS;
   maskProgress: REAL;

   (* snapping *)
   snappingWindow: ADDRESS;
   qrData: ARRAY [0..20] OF ARRAY [0..20] OF CHAR;

(* ------------------------------------------------------------------ *)
(* small helpers                                                      *)
(* ------------------------------------------------------------------ *)

PROCEDURE IMin (a, b: INTEGER) : INTEGER;
BEGIN
   IF a < b THEN RETURN a ELSE RETURN b END
END IMin;

(* The 21x21 QR matrix of snapping.c, one row per string. *)
PROCEDURE InitQrData;
BEGIN
   qrData[0]  := "000000010111110000000";
   qrData[1]  := "011111011100110111110";
   qrData[2]  := "010001011010010100010";
   qrData[3]  := "010001010011110100010";
   qrData[4]  := "010001010001010100010";
   qrData[5]  := "011111010100110111110";
   qrData[6]  := "000000010101010000000";
   qrData[7]  := "111111110000011111111";
   qrData[8]  := "011101000000100000110";
   qrData[9]  := "111100100000011100011";
   qrData[10] := "110010010110110001001";
   qrData[11] := "111001100101101111100";
   qrData[12] := "101100000011001100110";
   qrData[13] := "111111110011011100011";
   qrData[14] := "000000010011000101001";
   qrData[15] := "011111011000001000100";
   qrData[16] := "010001010010111011101";
   qrData[17] := "010001011001000000100";
   qrData[18] := "010001011010110100011";
   qrData[19] := "011111011001001111111";
   qrData[20] := "000000010100001011110"
END InitQrData;

(* ------------------------------------------------------------------ *)
(* drawing area                                                       *)
(* ------------------------------------------------------------------ *)

PROCEDURE CreateSurface (widget: ADDRESS);
VAR
   cr: ADDRESS;
BEGIN
   IF drawSurface # NIL THEN
      cairo_surface_destroy(drawSurface)
   END;
   drawSurface := cairo_image_surface_create(CairoFormatARGB32,
                    gtk_widget_get_width(widget),
                    gtk_widget_get_height(widget));
   cr := cairo_create(drawSurface);
   cairo_set_source_rgb(cr, 1.0, 1.0, 1.0);
   cairo_paint(cr);
   cairo_destroy(cr)
END CreateSurface;

(* void scribble_resize(GtkWidget *widget, int width, int height, gpointer) *)
PROCEDURE ScribbleResize (widget: ADDRESS; width, height: INTEGER;
                          data: ADDRESS);
BEGIN
   CreateSurface(widget)
END ScribbleResize;

PROCEDURE ScribbleDraw (area: ADDRESS; cr: ADDRESS;
                        width, height: INTEGER; data: ADDRESS);
BEGIN
   IF drawSurface # NIL THEN
      cairo_set_source_surface(cr, drawSurface, 0.0, 0.0);
      cairo_paint(cr)
   END
END ScribbleDraw;

PROCEDURE DrawBrush (widget: ADDRESS; x, y: REAL);
VAR
   cr: ADDRESS;
BEGIN
   IF drawSurface = NIL THEN
      CreateSurface(widget)
   END;

   cr := cairo_create(drawSurface);
   cairo_move_to(cr, x, y);
   cairo_line_to(cr, x, y);
   cairo_set_line_width(cr, 6.0);
   cairo_set_line_cap(cr, CairoLineCapRound);
   cairo_set_source_rgb(cr, 0.0, 0.0, 0.0);
   cairo_stroke(cr);
   cairo_destroy(cr)
   (* gtk_widget_queue_draw(widget) is not bound (see header). *)
END DrawBrush;

PROCEDURE DragBegin (gesture: ADDRESS; x, y: REAL; area: ADDRESS);
BEGIN
   dragStartX := x;
   dragStartY := y;
   DrawBrush(area, x, y)
END DragBegin;

PROCEDURE DragUpdate (gesture: ADDRESS; x, y: REAL; area: ADDRESS);
BEGIN
   DrawBrush(area, dragStartX + x, dragStartY + y)
END DragUpdate;

PROCEDURE DragEnd (gesture: ADDRESS; x, y: REAL; area: ADDRESS);
BEGIN
   DrawBrush(area, dragStartX + x, dragStartY + y)
END DragEnd;

PROCEDURE OvalPath (cr: ADDRESS; xc, yc, xr, yr: REAL);
BEGIN
   cairo_save(cr);
   cairo_translate(cr, xc, yc);
   cairo_scale(cr, 1.0, yr / xr);
   cairo_move_to(cr, xr, 0.0);
   cairo_arc(cr, 0.0, 0.0, xr, 0.0, 2.0 * Pi);
   cairo_close_path(cr);
   cairo_restore(cr)
END OvalPath;

PROCEDURE FillChecks (cr: ADDRESS; x, y, width, height: INTEGER);
CONST
   CheckSize = 16;
VAR
   i, j: INTEGER;
BEGIN
   cairo_rectangle(cr, VAL(REAL, x), VAL(REAL, y),
                   VAL(REAL, width), VAL(REAL, height));
   cairo_set_source_rgb(cr, 0.4, 0.4, 0.4);
   cairo_fill(cr);

   (* x & (-CHECK_SIZE), valid for CHECK_SIZE a power of two. *)
   j := x - (x MOD CheckSize);
   WHILE j < height DO
      i := y - (y MOD CheckSize);
      WHILE i < width DO
         IF ((i DIV CheckSize) + (j DIV CheckSize)) MOD 2 = 0 THEN
            cairo_rectangle(cr, VAL(REAL, i), VAL(REAL, j),
                            VAL(REAL, CheckSize), VAL(REAL, CheckSize))
         END;
         INC(i, CheckSize)
      END;
      INC(j, CheckSize)
   END;

   cairo_set_source_rgb(cr, 0.7, 0.7, 0.7);
   cairo_fill(cr)
END FillChecks;

PROCEDURE Draw3Circles (cr: ADDRESS; xc, yc, radius, alpha: REAL);
CONST
   SubRadius = 0.56666667;      (* 2/3 - 0.1 *)
   Third     = 0.33333333;
   Cos30     = 0.86602540;
VAR
   sr: REAL;
BEGIN
   sr := radius * SubRadius;

   cairo_set_source_rgba(cr, 1.0, 0.0, 0.0, alpha);
   OvalPath(cr, xc, yc - radius * Third, sr, sr);
   cairo_fill(cr);

   cairo_set_source_rgba(cr, 0.0, 1.0, 0.0, alpha);
   OvalPath(cr, xc - radius * Third * Cos30,
                yc + radius * Third * 0.5, sr, sr);
   cairo_fill(cr);

   cairo_set_source_rgba(cr, 0.0, 0.0, 1.0, alpha);
   OvalPath(cr, xc + radius * Third * Cos30,
                yc + radius * Third * 0.5, sr, sr);
   cairo_fill(cr)
END Draw3Circles;

PROCEDURE GroupsDraw (area: ADDRESS; cr: ADDRESS;
                      width, height: INTEGER; data: ADDRESS);
VAR
   radius, xc, yc: REAL;
BEGIN
   radius := 0.5 * VAL(REAL, IMin(width, height)) - 10.0;
   xc := VAL(REAL, width) / 2.0;
   yc := VAL(REAL, height) / 2.0;

   FillChecks(cr, 0, 0, width, height);

   (* SIMPLIFIED: no similar surfaces / DEST_OUT / ADD. *)
   cairo_set_source_rgb(cr, 0.0, 0.0, 0.0);
   OvalPath(cr, xc, yc, radius, radius);
   cairo_fill(cr);

   Draw3Circles(cr, xc, yc, radius, 1.0)
END GroupsDraw;

PROCEDURE OnDrawingDestroy (widget: ADDRESS; data: ADDRESS);
BEGIN
   IF drawSurface # NIL THEN
      cairo_surface_destroy(drawSurface);
      drawSurface := NIL
   END
END OnDrawingDestroy;

PROCEDURE DoDrawingArea (doWidget: ADDRESS) : ADDRESS;
VAR
   vbox, da, label, frame, drag: ADDRESS;
BEGIN
   IF drawingWindow = NIL THEN
      drawingWindow := gtk_window_new();
      gtk_window_set_title(drawingWindow, "Drawing Area");
      gtk_window_set_default_size(drawingWindow, 250, -1);
      Connect2(drawingWindow, "destroy", OnDrawingDestroy, NIL);

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

      (* groups area *)
      label := gtk_label_new("Knockout groups");
      gtk_widget_add_css_class(label, "heading");
      gtk_box_append(vbox, label);

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

      da := gtk_drawing_area_new();
      gtk_frame_set_child(frame, da);
      gtk_drawing_area_set_content_width(da, 100);
      gtk_drawing_area_set_content_height(da, 100);
      gtk_drawing_area_set_draw_func(da, ADR(GroupsDraw), NIL, NIL);

      (* scribble area *)
      label := gtk_label_new("Scribble area");
      gtk_widget_add_css_class(label, "heading");
      gtk_box_append(vbox, label);

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

      da := gtk_drawing_area_new();
      gtk_frame_set_child(frame, da);
      gtk_drawing_area_set_content_width(da, 100);
      gtk_drawing_area_set_content_height(da, 100);
      gtk_drawing_area_set_draw_func(da, ADR(ScribbleDraw), NIL, NIL);
      g_signal_connect_data(da, "resize", ADR(ScribbleResize), NIL, NIL,
                            GConnectDefault);

      drag := gtk_gesture_drag_new();
      gtk_gesture_single_set_button(drag, 0);
      gtk_widget_add_controller(da, drag);
      g_signal_connect_data(drag, "drag-begin", ADR(DragBegin), da, NIL,
                            GConnectDefault);
      g_signal_connect_data(drag, "drag-update", ADR(DragUpdate), da, NIL,
                            GConnectDefault);
      g_signal_connect_data(drag, "drag-end", ADR(DragEnd), da, NIL,
                            GConnectDefault)
   END;

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

(* ------------------------------------------------------------------ *)
(* gestures                                                           *)
(* ------------------------------------------------------------------ *)

PROCEDURE SwipeSwept (gesture: ADDRESS; vx, vy: REAL; widget: ADDRESS);
BEGIN
   swipeX := vx / 10.0;
   swipeY := vy / 10.0
END SwipeSwept;

PROCEDURE LongPressPressed (gesture: ADDRESS; x, y: REAL; widget: ADDRESS);
BEGIN
   longPressed := TRUE
END LongPressPressed;

PROCEDURE LongPressEnd (gesture: ADDRESS; sequence: ADDRESS; widget: ADDRESS);
BEGIN
   longPressed := FALSE
END LongPressEnd;

PROCEDURE RotationChanged (gesture: ADDRESS; angle, delta: REAL;
                           widget: ADDRESS);
BEGIN
   rotateDelta := delta;
   hasRotate := TRUE
END RotationChanged;

PROCEDURE ZoomChanged (gesture: ADDRESS; scale: REAL; widget: ADDRESS);
BEGIN
   zoomScale := scale;
   hasZoom := TRUE
END ZoomChanged;

PROCEDURE GesturesDraw (area: ADDRESS; cr: ADDRESS;
                        width, height: INTEGER; data: ADDRESS);
VAR
   pat: ADDRESS;
   cx, cy: REAL;
BEGIN
   cx := VAL(REAL, width) / 2.0;
   cy := VAL(REAL, height) / 2.0;

   IF (swipeX # 0.0) OR (swipeY # 0.0) THEN
      cairo_save(cr);
      cairo_set_line_width(cr, 6.0);
      cairo_move_to(cr, cx, cy);
      cairo_line_to(cr, cx + swipeX, cy + swipeY);
      cairo_set_source_rgba(cr, 1.0, 0.0, 0.0, 0.5);
      cairo_stroke(cr);
      cairo_restore(cr)
   END;

   IF hasRotate OR hasZoom THEN
      pat := cairo_pattern_create_linear(-100.0, 0.0, 200.0, 0.0);
      cairo_pattern_add_color_stop_rgb(pat, 0.0, 0.0, 0.0, 1.0);
      cairo_pattern_add_color_stop_rgb(pat, 1.0, 1.0, 0.0, 0.0);

      cairo_save(cr);
      cairo_translate(cr, cx, cy);
      IF hasZoom AND (zoomScale > 0.0) THEN
         cairo_scale(cr, zoomScale, zoomScale)
      END;
      IF hasRotate THEN
         cairo_rotate(cr, rotateDelta)
      END;
      cairo_rectangle(cr, -100.0, -100.0, 200.0, 200.0);
      cairo_set_source(cr, pat);
      cairo_fill(cr);
      cairo_restore(cr);

      cairo_pattern_destroy(pat)
   END;

   IF longPressed THEN
      cairo_save(cr);
      cairo_arc(cr, cx, cy, 50.0, 0.0, 2.0 * Pi);
      cairo_set_source_rgba(cr, 0.0, 1.0, 0.0, 0.5);
      cairo_stroke(cr);
      cairo_restore(cr)
   END
END GesturesDraw;

PROCEDURE DoGestures (doWidget: ADDRESS) : ADDRESS;
VAR
   da, gesture: ADDRESS;
BEGIN
   IF gesturesWindow = NIL THEN
      gesturesWindow := gtk_window_new();
      gtk_window_set_title(gesturesWindow, "Gestures");
      gtk_window_set_default_size(gesturesWindow, 400, 400);

      da := gtk_drawing_area_new();
      gtk_window_set_child(gesturesWindow, da);
      gtk_drawing_area_set_draw_func(da, ADR(GesturesDraw), NIL, NIL);

      (* swipe *)
      gesture := gtk_gesture_swipe_new();
      g_signal_connect_data(gesture, "swipe", ADR(SwipeSwept), da, NIL,
                            GConnectDefault);
      gtk_event_controller_set_propagation_phase(gesture, GtkPhaseBubble);
      gtk_widget_add_controller(da, gesture);

      (* long press *)
      gesture := gtk_gesture_long_press_new();
      g_signal_connect_data(gesture, "pressed", ADR(LongPressPressed), da,
                            NIL, GConnectDefault);
      g_signal_connect_data(gesture, "end", ADR(LongPressEnd), da, NIL,
                            GConnectDefault);
      gtk_event_controller_set_propagation_phase(gesture, GtkPhaseBubble);
      gtk_widget_add_controller(da, gesture);

      (* rotate *)
      gesture := gtk_gesture_rotate_new();
      g_signal_connect_data(gesture, "angle-changed", ADR(RotationChanged),
                            da, NIL, GConnectDefault);
      gtk_event_controller_set_propagation_phase(gesture, GtkPhaseBubble);
      gtk_widget_add_controller(da, gesture);

      (* zoom *)
      gesture := gtk_gesture_zoom_new();
      g_signal_connect_data(gesture, "scale-changed", ADR(ZoomChanged), da,
                            NIL, GConnectDefault);
      gtk_event_controller_set_propagation_phase(gesture, GtkPhaseBubble);
      gtk_widget_add_controller(da, gesture)
   END;

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

(* ------------------------------------------------------------------ *)
(* masking                                                            *)
(* ------------------------------------------------------------------ *)

PROCEDURE OnMaskChanged (range: ADDRESS; data: ADDRESS);
BEGIN
   maskProgress := gtk_range_get_value(range)
END OnMaskChanged;

PROCEDURE MaskDraw (area: ADDRESS; cr: ADDRESS;
                    width, height: INTEGER; data: ADDRESS);
VAR
   pat: ADDRESS;
   w, h, x0, y0: REAL;
BEGIN
   w := VAL(REAL, width);
   h := VAL(REAL, height);

   cairo_set_source_rgb(cr, 0.08, 0.08, 0.10);
   cairo_rectangle(cr, 0.0, 0.0, w, h);
   cairo_fill(cr);

   (* SIMPLIFIED: fill the "123" glyphs with a moving gradient in place of
      the GskMaskNode composition. *)
   cairo_select_font_face(cr, "sans", CairoFontSlantNormal,
                          CairoFontWeightBold);
   cairo_set_font_size(cr, 200.0);
   x0 := w / 2.0 - 165.0;
   y0 := h / 2.0 + 70.0;
   cairo_move_to(cr, x0, y0);
   cairo_text_path(cr, "123");

   pat := cairo_pattern_create_linear(maskProgress * w - w, 0.0,
                                      maskProgress * w, h);
   cairo_pattern_add_color_stop_rgb(pat, 0.0,        1.0, 0.0, 0.0);
   cairo_pattern_add_color_stop_rgb(pat, 1.0 / 7.0,  1.0, 0.5, 0.0);
   cairo_pattern_add_color_stop_rgb(pat, 2.0 / 7.0,  1.0, 1.0, 0.0);
   cairo_pattern_add_color_stop_rgb(pat, 3.0 / 7.0,  0.0, 1.0, 0.0);
   cairo_pattern_add_color_stop_rgb(pat, 4.0 / 7.0,  0.0, 1.0, 1.0);
   cairo_pattern_add_color_stop_rgb(pat, 5.0 / 7.0,  0.0, 0.0, 1.0);
   cairo_pattern_add_color_stop_rgb(pat, 6.0 / 7.0,  0.6, 0.0, 1.0);
   cairo_pattern_add_color_stop_rgb(pat, 1.0,        1.0, 0.0, 1.0);
   cairo_set_source(cr, pat);
   cairo_fill(cr);
   cairo_pattern_destroy(pat)
END MaskDraw;

PROCEDURE DoMask (doWidget: ADDRESS) : ADDRESS;
VAR
   box, da: ADDRESS;
BEGIN
   IF maskWindow = NIL THEN
      maskWindow := gtk_window_new();
      gtk_window_set_title(maskWindow, "Mask Nodes");
      gtk_window_set_default_size(maskWindow, 600, 400);

      box := gtk_box_new(GtkVertical, 0);
      gtk_window_set_child(maskWindow, box);

      da := gtk_drawing_area_new();
      gtk_widget_set_hexpand(da, 1);
      gtk_widget_set_vexpand(da, 1);
      gtk_drawing_area_set_draw_func(da, ADR(MaskDraw), NIL, NIL);
      gtk_box_append(box, da);

      maskScale := gtk_scale_new_with_range(GtkHorizontal, 0.0, 1.0, 0.1);
      gtk_range_set_value(maskScale, 0.5);
      maskProgress := 0.5;
      Connect2(maskScale, "value-changed", OnMaskChanged, NIL);
      gtk_box_append(box, maskScale)
   END;

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

(* ------------------------------------------------------------------ *)
(* snapping                                                           *)
(* ------------------------------------------------------------------ *)

PROCEDURE QrOn (x, y: INTEGER) : BOOLEAN;
BEGIN
   RETURN qrData[y][x] = '1'
END QrOn;

PROCEDURE SetOnColor (cr: ADDRESS; on: BOOLEAN);
BEGIN
   IF on THEN
      cairo_set_source_rgb(cr, 0.2, 0.6, 1.0)      (* ON      *)
   ELSE
      cairo_set_source_rgb(cr, 1.0, 0.95, 0.7)     (* OFF     *)
   END
END SetOnColor;

(* A 1x1 tile with a horizontal gradient between differing neighbours. *)
PROCEDURE HBetween (cr: ADDRESS; x, y: REAL; a, b: BOOLEAN);
VAR
   pat: ADDRESS;
BEGIN
   IF a = b THEN
      SetOnColor(cr, a)
   ELSE
      pat := cairo_pattern_create_linear(x, y, x + 1.0, y);
      IF a THEN
         cairo_pattern_add_color_stop_rgb(pat, 0.3, 0.2, 0.6, 1.0);
         cairo_pattern_add_color_stop_rgb(pat, 0.5, 1.0, 1.0, 1.0);
         cairo_pattern_add_color_stop_rgb(pat, 0.7, 1.0, 0.95, 0.7)
      ELSE
         cairo_pattern_add_color_stop_rgb(pat, 0.3, 1.0, 0.95, 0.7);
         cairo_pattern_add_color_stop_rgb(pat, 0.5, 1.0, 1.0, 1.0);
         cairo_pattern_add_color_stop_rgb(pat, 0.7, 0.2, 0.6, 1.0)
      END;
      cairo_set_source(cr, pat)
   END;

   cairo_rectangle(cr, x, y, 1.0, 1.0);
   cairo_fill(cr);

   IF a # b THEN
      cairo_pattern_destroy(pat)
   END
END HBetween;

(* A 1x1 tile with a vertical gradient between differing neighbours. *)
PROCEDURE VBetween (cr: ADDRESS; x, y: REAL; a, b: BOOLEAN);
VAR
   pat: ADDRESS;
BEGIN
   IF a = b THEN
      SetOnColor(cr, a)
   ELSE
      pat := cairo_pattern_create_linear(x, y, x, y + 1.0);
      IF a THEN
         cairo_pattern_add_color_stop_rgb(pat, 0.3, 0.2, 0.6, 1.0);
         cairo_pattern_add_color_stop_rgb(pat, 0.5, 1.0, 1.0, 1.0);
         cairo_pattern_add_color_stop_rgb(pat, 0.7, 1.0, 0.95, 0.7)
      ELSE
         cairo_pattern_add_color_stop_rgb(pat, 0.3, 1.0, 0.95, 0.7);
         cairo_pattern_add_color_stop_rgb(pat, 0.5, 1.0, 1.0, 1.0);
         cairo_pattern_add_color_stop_rgb(pat, 0.7, 0.2, 0.6, 1.0)
      END;
      cairo_set_source(cr, pat)
   END;

   cairo_rectangle(cr, x, y, 1.0, 1.0);
   cairo_fill(cr);

   IF a # b THEN
      cairo_pattern_destroy(pat)
   END
END VBetween;

PROCEDURE SnappingDraw (area: ADDRESS; cr: ADDRESS;
                        width, height: INTEGER; data: ADDRESS);
VAR
   cell, ox, oy, x, y: INTEGER;
BEGIN
   (* 21 tiles plus 21 gaps make 43 units; snap to whole device pixels. *)
   cell := IMin(width, height) DIV 43;
   IF cell < 1 THEN cell := 1 END;
   ox := (width - 43 * cell) DIV 2;
   oy := (height - 43 * cell) DIV 2;

   cairo_save(cr);
   cairo_translate(cr, VAL(REAL, ox), VAL(REAL, oy));
   cairo_scale(cr, VAL(REAL, cell), VAL(REAL, cell));

   cairo_set_source_rgb(cr, 1.0, 1.0, 1.0);
   cairo_rectangle(cr, 0.0, 0.0, 43.0, 43.0);
   cairo_fill(cr);

   (* tile centres at odd coordinates 1, 3, ..., 41 *)
   FOR y := 0 TO 20 DO
      FOR x := 0 TO 20 DO
         SetOnColor(cr, QrOn(x, y));
         cairo_rectangle(cr, VAL(REAL, 2 * x + 1), VAL(REAL, 2 * y + 1),
                         1.0, 1.0);
         cairo_fill(cr)
      END
   END;

   (* horizontal gaps between columns *)
   FOR y := 0 TO 20 DO
      FOR x := 0 TO 19 DO
         HBetween(cr, VAL(REAL, 2 * x + 2), VAL(REAL, 2 * y + 1),
                  QrOn(x, y), QrOn(x + 1, y))
      END
   END;

   (* vertical gaps between rows *)
   FOR y := 0 TO 19 DO
      FOR x := 0 TO 20 DO
         VBetween(cr, VAL(REAL, 2 * x + 1), VAL(REAL, 2 * y + 2),
                  QrOn(x, y), QrOn(x, y + 1))
      END
   END;

   cairo_restore(cr)
END SnappingDraw;

PROCEDURE DoSnapping (doWidget: ADDRESS) : ADDRESS;
VAR
   da: ADDRESS;
BEGIN
   IF snappingWindow = NIL THEN
      snappingWindow := gtk_window_new();
      gtk_window_set_title(snappingWindow, "Snapping");
      gtk_window_set_default_size(snappingWindow, 600, 400);

      da := gtk_drawing_area_new();
      gtk_window_set_child(snappingWindow, da);
      gtk_drawing_area_set_draw_func(da, ADR(SnappingDraw), NIL, NIL)
   END;

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

BEGIN
   drawingWindow := NIL;
   drawSurface := NIL;
   dragStartX := 0.0;
   dragStartY := 0.0;

   gesturesWindow := NIL;
   swipeX := 0.0;
   swipeY := 0.0;
   rotateDelta := 0.0;
   zoomScale := 1.0;
   longPressed := FALSE;
   hasRotate := FALSE;
   hasZoom := FALSE;

   maskWindow := NIL;
   maskScale := NIL;
   maskProgress := 0.5;

   snappingWindow := NIL;
   InitQrData
END DemosCanvas.