File: gtkada-canvas.ads

package info (click to toggle)
libgtkada2 2.8.1-6lenny3
  • links: PTS, VCS
  • area: main
  • in suites: lenny
  • size: 13,496 kB
  • ctags: 3,886
  • sloc: ada: 103,189; ansic: 45,411; perl: 5,500; sh: 2,812; makefile: 1,169; xml: 19
file content (1151 lines) | stat: -rw-r--r-- 49,235 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
-----------------------------------------------------------------------
--               GtkAda - Ada95 binding for Gtk+/Gnome               --
--                                                                   --
--   Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet   --
--                Copyright (C) 2000-2006 AdaCore                    --
--                                                                   --
-- This library is free software; you can redistribute it and/or     --
-- modify it under the terms of the GNU General Public               --
-- License as published by the Free Software Foundation; either      --
-- version 2 of the License, or (at your option) any later version.  --
--                                                                   --
-- This library is distributed in the hope that it will be useful,   --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of    --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
-- General Public License for more details.                          --
--                                                                   --
-- You should have received a copy of the GNU General Public         --
-- License along with this library; if not, write to the             --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330,      --
-- Boston, MA 02111-1307, USA.                                       --
--                                                                   --
-----------------------------------------------------------------------

--  <description>
--  This package provides an interactive canvas, on which the user can put
--  items, move them with the mouse, etc. The items can be connected together,
--  and the connections remain active while the items are moved.
--
--  It also supports scrolling if put in a Gtk_Scrolled_Window.
--  The canvas will be scrolled (and the selected items moved) if an item is
--  selected and the mouse is dragged on a small area on the side of the canvas
--  or even directly outside of the canvas. Scrolling will continue until the
--  mouse is either released or moved back inside the canvas.
--
--  The scrolling speed will slightly increase over time if the mouse is kept
--  outside of the canvas. This makes the canvas much more comfortable to use
--  for the user.
--
--  All items put in this canvas must inherit from the type Canvas_Item_Record.
--  However, it is your responsability, as a programmer, to provide drawing
--  routines. In fact, all these items should draw in a pixmap, which is then
--  copied automatically to the screen whenever the canvas needs to redraw
--  itself.
--
--  The items can also react to mouse events: mouse clicks are transmitted to
--  the item if the mouse did not move more than a given amount of pixels.
--  To decide what their reaction should be, you should override the
--  On_Button_Click subprogram.
--
--  This canvas is not intended for cases where you want to put hundreds of
--  items on the screen. For instance, it does not provide any smart
--  double-buffering other than the one provided by gtk+ itself, and thus you
--  would get some flicker if there are too many items.
--
--  There are three coordinate systems used by widget. All the subprograms
--  expect a specific coordinate system as input or output. Here are the three
--  systems:
--    - World coordinates
--      The position of an item is reported in pixels, as if the canvas
--      currently had a zoom level of 100%. This is fully independent, at any
--      time, from the current zoom level of the canvas.
--      Since the canvas is considered to expand ad infinitum, the top-left
--      corner doesn't have any specific fixed coordinates. It can be known by
--      checking the current lower value of the adjustments (aka scrollbars).
--
--    - Canvas coordinates
--      This is similar to world coordinates, except these depend on the
--      current zoom level of the canvas. This also affect the width and height
--      of the objects in the canvas.
--      The subprograms To_Canvas_Coordinates and To_World_Coordinates can be
--      used to convert lengths from world to canvas coordinates.
--      The same behavior as world coordinates applies for the top-left corner.
--      All drawing to the screen, in particular for Draw_Background, must be
--      done using this coordinate systems
--
--    - Item coordinates
--      The position of a point is relative to the top-left corner of the
--      current item. This corner therefore has coordinates (0, 0).
--      This coordinate systems assumes a zoom-level of 100%
--
--  Items are selected automatically when they are clicked. If Control is
--  pressed at the same time, multiple items can be selected.
--  If the background is clicked (and control is not pressed), then all items
--  are unselected.
--  Pressing and dragging the mouse in the backgroudn draws a virtual box on
--  the screen. All the items fully included in this box when it is released
--  will be selected (this will replace the current selection if Control was
--  not pressed).
--
--  </description>
--  <group>Drawing</group>
--  <testgtk>create_canvas.adb</testgtk>
--  <screenshot>gtkada-canvas</screenshot>

with Gdk.Event;
with Gdk.GC;
with Gdk.Pixbuf;
with Gdk.Pixmap;
with Gdk.Rectangle;
with Gdk.Window;

with Glib;
with Glib.Graphs;
with Glib.Main;

with Gtk.Adjustment;
with Gtk.Drawing_Area;

with Pango.Font;
with Pango.Layout;

package Gtkada.Canvas is

   type Interactive_Canvas_Record is new
     Gtk.Drawing_Area.Gtk_Drawing_Area_Record with private;
   type Interactive_Canvas is access all Interactive_Canvas_Record'Class;
   --  A canvas on which items are put.
   --  Each item can be moved interactively by the user, and links can be
   --  drawn automatically from an item to another.
   --  This widget can be inserted directly in a scrolled window to provide
   --  support for scrolling.

   type Canvas_Item_Record is abstract new Glib.Graphs.Vertex with private;
   type Canvas_Item is access all Canvas_Item_Record'Class;
   --  An item that can be put on the canvas.
   --  This is an abstract type, as it does not provide any default drawing
   --  routine. You must override the abstract Draw subprogram.

   type Canvas_Link_Record is new Glib.Graphs.Edge with private;
   type Canvas_Link is access all Canvas_Link_Record'Class;
   type Canvas_Link_Access is access all Canvas_Link_Record;
   --  A link between two items in the canvas.
   --  The implementation provided in this package provides links that can
   --  be either straight links or curved links.
   --  This type is provided as a tagged type so that you can associated your
   --  own user data with it.

   -------------------
   -- Customization --
   -------------------
   --  These are the default configuration values for the canvas. All the
   --  values can be changed by the Configure subprogram.

   Default_Annotation_Font  : constant String := "Helvetica 8";
   --  Font used when displaying link annotation. See Pango.Font for the
   --  format.

   Default_Grid_Size        : constant := 15;
   --  Number of pixels between two dots on the grid.
   --  This is used for both horizontal and vertical orientation.

   Default_Arc_Link_Offset  : constant := 25;
   --  Distance between two parallel arcs for two links. This is not the exact
   --  distance, and it only used to compute the control points for the bezier
   --  curves.

   Default_Arrow_Angle      : constant := 30;
   --  Half angle for the arrows in degres

   Default_Arrow_Length     : constant := 6;
   --  Length of the arrows in pixels.

   Default_Motion_Threshold : constant := 4;
   --  Mimimum motion the mouse must have before we start moving the selected
   --  item. If the mouse has moved less than that amount of pixels in any
   --  direction, then the mouse click is considered as being a selection
   --  only and is transfered to the item itself.

   ----------------
   -- Enum types --
   ----------------

   type Arrow_Type is
     (No_Arrow,
      --  the link does not have an arrow

      Start_Arrow,
      --  the link has an arrow at its beginning

      End_Arrow,
      --  the link has an arrow at the end

      Both_Arrow
      --  the link has an arrow on both sides
     );
   --  Indicate whether the links have an arrow or not.

   -----------------------
   -- Creating a canvas --
   -----------------------

   procedure Gtk_New
     (Canvas : out Interactive_Canvas; Auto_Layout : Boolean := True);
   --  Create a new empty Canvas.
   --  If Auto_Layout is True, then the items are automatically positioned as
   --  they are put in the canvas, if no coordinates are specified.

   procedure Initialize
     (Canvas      : access Interactive_Canvas_Record'Class;
      Auto_Layout : Boolean := True);
   --  Internal function used to initialize the canvas.

   procedure Configure
     (Canvas : access Interactive_Canvas_Record;
      Grid_Size        : Glib.Guint := Default_Grid_Size;
      Annotation_Font  : Pango.Font.Pango_Font_Description :=
                           Pango.Font.From_String (Default_Annotation_Font);
      Arc_Link_Offset  : Glib.Gint := Default_Arc_Link_Offset;
      Arrow_Angle      : Glib.Gint := Default_Arrow_Angle;
      Arrow_Length     : Glib.Gint := Default_Arrow_Length;
      Motion_Threshold : Glib.Gint := Default_Motion_Threshold);
   --  Change the parameters for the canvas.
   --  A Grid_Size of 0 means than no grid should be drawn in the background of
   --  canvas. Note that in that case you can never activate Align_On_Grid.
   --  This setting doesn't apply if you have redefined Draw_Background, which
   --  may not draw a grid.

   function Get_Vadj
     (Canvas : access Interactive_Canvas_Record'Class)
      return Gtk.Adjustment.Gtk_Adjustment;
   --  Return the vertical adjustment associated with Canvas

   function Get_Hadj
     (Canvas : access Interactive_Canvas_Record'Class)
      return Gtk.Adjustment.Gtk_Adjustment;
   --  Return the horizontal adjustment associated with Canvas

   procedure Draw_Area
     (Canvas : access Interactive_Canvas_Record'Class;
      Rect   : Gdk.Rectangle.Gdk_Rectangle);
   --  Draw in Canvas the specified area.

   procedure Draw_Background
     (Canvas      : access Interactive_Canvas_Record;
      Screen_Rect : Gdk.Rectangle.Gdk_Rectangle);
   --  Draw the background of the canvas. This procedure should be overriden if
   --  you want to draw something else on the background. It must first clear
   --  the area on the screen.
   --
   --  Screen_Rect is the rectangle on the screen that needs to be
   --  refreshed. These are canvas coordinates, therefore you must take into
   --  account the current zoom level while drawing.
   --
   --  The default implementation draws a grid.
   --
   --  An example implementation that draws a background image is shown at the
   --  end of this file.

   procedure Draw_Grid
     (Canvas      : access Interactive_Canvas_Record;
      GC          : Gdk.GC.Gdk_GC;
      Screen_Rect : Gdk.Rectangle.Gdk_Rectangle);
   --  Helper function that can be called from Draw_Background. It cannot be
   --  used directly as Draw_Background, since it doesn't clear the area first.

   procedure Set_Orthogonal_Links
     (Canvas : access Interactive_Canvas_Record;
      Orthogonal : Boolean);
   --  If Orthogonal is True, then all the links will be drawn only with
   --  vertical and horizontal lines. This is not applied for the second or
   --  more link between two items.

   function Get_Orthogonal_Links
     (Canvas : access Interactive_Canvas_Record) return Boolean;
   --  Return True if the links are only drawn horizontally and vertically.

   procedure Align_On_Grid
     (Canvas : access Interactive_Canvas_Record;
      Align  : Boolean := True);
   --  Choose whether the items should be aligned on the grid when moved.
   --  Existing items are not moved even if you set this parameter to True,
   --  this will only take effect the next time the items are moved.

   function Get_Align_On_Grid
     (Canvas : access Interactive_Canvas_Record) return Boolean;
   --  Return True if items are currently aligned on grid.

   procedure Move_To
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class;
      X, Y   : Glib.Gint := Glib.Gint'First);
   --  Move the item in the canvas, to world coordinates (X, Y).
   --  Item is assumed to be already in the canvas.
   --  If you leave both coordinates X and Y to their default value, then the
   --  item's location will be automatically computed when you layout the
   --  canvas (it is your responsability to call Layout).

   procedure Set_Items
     (Canvas : access Interactive_Canvas_Record;
      Items  : Glib.Graphs.Graph);
   --  Set the items and links to display in the canvas from Items.
   --  All items previously in the canvas are removed, and replaced by the
   --  vertices in Items.
   --  Note that the vertices in Items must be in Canvas_Item_Record'Class, and
   --  the links must be in Canvas_Link_Record'Class.
   --  If you do not have an automatic layout set up in Canvas, you need to set
   --  the coordinates of all the vertices by calling Move_To separately.
   --
   --  You mustn't destroy items yourself, this is done automatically when the
   --  canvas is destroyed.

   procedure Put
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class;
      X, Y   : Glib.Gint := Glib.Gint'First);
   --  Add a new item to the canvas, at world coordinates (X, Y).
   --  The item is added at a specific location.
   --  If you leave both X and Y to their default value, the item's location
   --  will be computed automatically when you call Layout on the canvas,
   --  unless Auto_Layout has been set, in which case the position will be
   --  computed immediately.

   function Item_At_Coordinates
     (Canvas : access Interactive_Canvas_Record;
      X, Y : Glib.Gint) return Canvas_Item;
   --  Return the item at world coordinates (X, Y) which is on top of all
   --  others.
   --  null is returned if there is no such item.

   function Item_At_Coordinates
     (Canvas : access Interactive_Canvas_Record; Event : Gdk.Event.Gdk_Event)
      return Canvas_Item;
   --  Same as above, but using the canvas coordinates of the event, taking
   --  into account the current zoom level and current scrolling

   procedure Clear (Canvas : access Interactive_Canvas_Record);
   --  Remove all items from the canvas

   procedure Remove
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class);
   --  Remove an item and all the links to and from it from the canvas.
   --  The item itself is not freed, but the links are.
   --  Nothing is done if the item is not part of the canvas.

   procedure Item_Updated
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class);
   --  This should be called when Item has changed the contents of its
   --  pixmap, and thus the Canvas should be updated.

   procedure Refresh_Canvas (Canvas : access Interactive_Canvas_Record);
   --  Redraw the whole canvas (both in the double buffer and on the screen).

   procedure Raise_Item
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class);
   --  Raise the item so that it is displayed on top of all the others
   --  The canvas is refreshed as needed to reflect the change.
   --  Nothing happens if Item is not part of the canvas.

   procedure Lower_Item
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class);
   --  Lower the item so that it is displayed below all the others.
   --  The canvas is refreshed as needed to reflect the change.
   --  Nothing happens if Item is not part of the canvas.

   function Is_On_Top
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class) return Boolean;
   --  Return True if Item is displayed on top of all the others in the canvas.

   procedure Show_Item
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class);
   --  Scroll the canvas so that Item is visible. Nothing is done if the item
   --  is already visible

   procedure Align_Item
     (Canvas  : access Interactive_Canvas_Record;
      Item    : access Canvas_Item_Record'Class;
      X_Align : Float := 0.5;
      Y_Align : Float := 0.5);
   --  Scroll the canvas so that the Item appears at the given location in the
   --  canvas. If X_Align is 0.0, the item is align on the left. With 0.5, it
   --  is centered horizontally. If 1.0, it is aligned on the right.

   function Get_Arrow_Angle
     (Canvas : access Interactive_Canvas_Record'Class) return Float;
   --  Return the angle of arrows in the canvas.

   function Get_Arrow_Length
     (Canvas : access Interactive_Canvas_Record'Class) return Glib.Gint;
   --  Return the length of arrows in the canvas.

   --------------------------
   -- Iterating over items --
   --------------------------

   type Item_Processor is access function
     (Canvas : access Interactive_Canvas_Record'Class;
      Item   : access Canvas_Item_Record'Class) return Boolean;

   procedure For_Each_Item
     (Canvas            : access Interactive_Canvas_Record;
      Execute           : Item_Processor;
      Linked_From_Or_To : Canvas_Item := null);
   --  Execute an action on each of the items contained in the canvas.
   --  If Execute returns False, we stop traversing the list of children.
   --  It is safe to remove the items in Item_Processor.
   --
   --  If Linked_From_Or_To is not null, then only the items linked to this one
   --  will be processed. It is possible that a given item will be returned
   --  twice, if it is both linked to and from the item.

   type Item_Iterator is private;

   function Start
     (Canvas            : access Interactive_Canvas_Record;
      Linked_From_Or_To : Canvas_Item := null) return Item_Iterator;
   --  Return the first item in the canvas.
   --  The same restriction as above applies if Linked_From_Or_To is not null.

   procedure Next (Iter : in out Item_Iterator);
   --  Move the iterator to the next item.
   --  All items will eventually be returned if you do not add new items during
   --  the iteration and none are removed. However, it is safe to remove items
   --  at any time, except the current item

   function Get (Iter : Item_Iterator) return Canvas_Item;
   --  Return the item pointed to by the iterator.
   --  null is returned when there are no more item in the canvas.

   function Is_Linked_From (Iter : Item_Iterator) return Boolean;
   --  Return True if there is a link from:
   --     Get (Iter) -> Linked_From_Or_To
   --  Linked_From_Or_To is the item passed to Start. False is returned if this
   --  item was null.

   -------------
   -- Zooming --
   -------------

   procedure Zoom
     (Canvas  : access Interactive_Canvas_Record;
      Percent : Glib.Guint := 100;
      Steps   : Glib.Guint := 1);
   --  Zoom in or out in the canvas.
   --
   --  Steps is the number of successive zooms that will be done to provide
   --  smooth scrolling.
   --
   --  Note that one possible use for this function is to refresh the canvas
   --  and emit the "zoomed" signal, which might redraw all the items. This can
   --  be accomplished by keeping the default 100 value for Percent.

   function Get_Zoom
     (Canvas : access Interactive_Canvas_Record) return Glib.Guint;
   --  Return the current zoom level

   function To_Canvas_Coordinates
     (Canvas : access Interactive_Canvas_Record'Class;
      X      : Glib.Gint) return Glib.Gint;
   --  Scale the scalar X depending by the zoom level (map from world
   --  coordinates to canvas coordinates).
   --  Substract the coordinates of the top-left corner if you are converting
   --  coordinates instead of lengths.

   function Top_World_Coordinates
     (Canvas : access Interactive_Canvas_Record'Class) return Glib.Gint;
   --  Return the world coordinates for the y=0 canvas coordinates (ie for the
   --  upper-left corner).

   function Left_World_Coordinates
     (Canvas : access Interactive_Canvas_Record'Class) return Glib.Gint;
   --  Return the world coordinates for the x=0 canvas coordinates (ie for the
   --  upper-left corner).

   function To_World_Coordinates
     (Canvas : access Interactive_Canvas_Record'Class;
      X      : Glib.Gint) return Glib.Gint;
   --  Scale the scalar X depending by the zoom level (map from canvas
   --  coordinates to world coordinates)

   procedure Get_World_Coordinates
     (Canvas : access Interactive_Canvas_Record'Class;
      X, Y   : out Glib.Gint;
      Width  : out Glib.Gint;
      Height : out Glib.Gint);
   --  Return the world coordinates of Canvas.

   ---------------------
   -- Layout of items --
   ---------------------

   type Layout_Algorithm is access procedure
     (Canvas          : access Interactive_Canvas_Record'Class;
      Graph           : Glib.Graphs.Graph;
      Force           : Boolean;
      Vertical_Layout : Boolean);
   --  A general layout algorithm. It should compute the position of all the
   --  vertices of the graph, and set them directly in the graph itself.
   --  Note: all the vertices in the graph are of type Canvas_Item_Record'Class
   --  and you should use that to set the coordinates through a call to
   --  Move_To.
   --
   --  Algorithms are encouraged to preserve the current layout as much as
   --  possible, taking into account items that have been moved manually by
   --  the user, so that the latter can preserver his mental map of the graph.
   --  However, if Force is set to True, then the whole layout should be
   --  recomputed as if all items had just been inserted.
   --
   --  Items that have just been inserted in the graph, but whose position has
   --  never been computed, are set at coordinates (Gint'First, Gint'First).
   --  Check the result of Get_Coord.
   --
   --  This function doesn't need to align items, this is done automatically by
   --  the canvas if necessary.

   procedure Set_Layout_Algorithm
     (Canvas    : access Interactive_Canvas_Record;
      Algorithm : Layout_Algorithm);
   --  Set the layout algorithm to use to compute the position of the items.
   --  Algorithm mustn't be null.

   procedure Default_Layout_Algorithm
     (Canvas          : access Interactive_Canvas_Record'Class;
      Graph           : Glib.Graphs.Graph;
      Force           : Boolean;
      Vertical_Layout : Boolean);
   --  The default algorithm used in the canvas.
   --  Basically, items are put next to each other, unless there is a link
   --  between two items. In that case, the second item is put below the first,
   --  as space allows.

   procedure Set_Auto_Layout
     (Canvas      : access Interactive_Canvas_Record;
      Auto_Layout : Boolean);
   --  If Auto_Layout is true, then every time an item is inserted in the
   --  canvas, the layout algorithm is called. If set to False, it is the
   --  responsability of the caller to call Layout below to force a
   --  recomputation of the layout, preferably after inserting a number of
   --  items.

   procedure Set_Layout_Orientation
     (Canvas          : access Interactive_Canvas_Record;
      Vertical_Layout : Boolean := False);
   --  Specify the layout orientation to use for this canvas. The setting is
   --  passed as a parameter to the layout algorithm

   procedure Layout
     (Canvas : access Interactive_Canvas_Record;
      Force  : Boolean := False);
   --  Recompute the layout of the canvas.
   --  Force can be used to control the layout algorithm, as described above
   --  for Layout_Algorithm.

   -----------
   -- Links --
   -----------

   procedure Configure
     (Link  : access Canvas_Link_Record;
      Arrow : in Arrow_Type := End_Arrow;
      Descr : in Glib.UTF8_String := "");
   --  Configure a link.
   --  The link is an oriented bound between two items on the canvas.
   --  If Descr is not the empty string, it will be displayed in the middle
   --  of the link, and should indicate what the link means.
   --  Arrow indicates whether some arrows should be printed as well.

   function Get_Descr
     (Link : access Canvas_Link_Record) return Glib.UTF8_String;
   --  Return the description for the link, or "" if there is none

   function Get_Arrow_Type
     (Link : access Canvas_Link_Record) return Arrow_Type;
   --  Return the location of the arrows on Link

   procedure Set_Src_Pos
     (Link : access Canvas_Link_Record; X_Pos, Y_Pos : Glib.Gfloat := 0.5);
   --  Set the position of the link's attachment in its source item.
   --  X_Pos and Y_Pos should be given between 0.0 and 1.0 (from left to right
   --  or top to bottom)..
   --  By default, all links are considered to be attached to the center of
   --  items. However, in some cases it is more convenient to attach it to a
   --  specific part of the item. For instance, you can force a link to always
   --  start from the top of the item by setting Y_Pos to 0.0.

   procedure Set_Dest_Pos
     (Link : access Canvas_Link_Record; X_Pos, Y_Pos : Glib.Gfloat := 0.5);
   --  Same as Set_Src_Pos for the destination item

   procedure Get_Src_Pos
     (Link : access Canvas_Link_Record; X, Y : out Glib.Gfloat);
   --  Return the attachment position of the link along its source item

   procedure Get_Dest_Pos
     (Link : access Canvas_Link_Record; X, Y : out Glib.Gfloat);
   --  Return the attachment position of the link along its destination item

   function Has_Link
     (Canvas   : access Interactive_Canvas_Record;
      From, To : access Canvas_Item_Record'Class;
      Name     : Glib.UTF8_String := "") return Boolean;
   --  Test whether there is a link from From to To, with the same name.
   --  If Name is the empty string "", then no check is done on the name,
   --  and True if returned if there is any link between the two items.

   procedure Add_Link
     (Canvas : access Interactive_Canvas_Record;
      Link   : access Canvas_Link_Record'Class;
      Src    : access Canvas_Item_Record'Class;
      Dest   : access Canvas_Item_Record'Class;
      Arrow  : in Arrow_Type := End_Arrow;
      Descr  : in Glib.UTF8_String := "");
   --  Add Link in the canvas. This connects the two items Src and Dest.
   --  Simpler procedure to add a standard link.
   --  This takes care of memory allocation, as well as adding the link to
   --  the canvas.

   procedure Remove_Link
     (Canvas : access Interactive_Canvas_Record;
      Link   : access Canvas_Link_Record'Class);
   --  Remove a link from the canvas.
   --  It also destroys the link itself, and free the memory allocated to it.
   --  Nothing is done if Link does not belong to canvas.

   type Link_Processor is access function
     (Canvas : access Interactive_Canvas_Record'Class;
      Link   : access Canvas_Link_Record'Class) return Boolean;

   procedure For_Each_Link
     (Canvas   : access Interactive_Canvas_Record;
      Execute  : Link_Processor;
      From, To : Canvas_Item := null);
   --  Execute an action on each of the links contained in the canvas.
   --  If Execute returns False, we stop traversing the list of links.
   --  It is safe to remove the link from the list in Link_Processor.
   --
   --  (From, To) can be used to limit what links are looked for.
   --
   --  ??? Would be nicer to give direct access to the Graph iterators

   procedure Destroy (Link : in out Canvas_Link_Record);
   --  Method called every time a link is destroyed. You should override this
   --  if you define your own link types.
   --  Note that the link might already have been removed from the canvas
   --  when this subprogram is called.
   --  This shouldn't free the link itself, only its fields.

   -------------------
   -- Drawing links --
   -------------------
   --  Drawing of links can be controlled at several levels:
   --    - Redefining Update_Links gives control at the canvas level. This can
   --      be used to implement routing algorithms for the links where the
   --      routes must be computed before any link is actually drawn (otherwise
   --      it is better to redefine Draw_Link). It can also be used to control
   --      in what order the links should be drawn.
   --    - Redefining Draw_Link gives the opportunity to draw links any way you
   --      need (several bends, ...). It can be used to control the routing of
   --      this specific link, for routing algorithms that only rely on the
   --      items layout and not on other links. Otherwise see Update_Links.
   --    - Redefining Draw_Straight_Line if slightly lower-level. This is
   --      called by the default Draw_Link procedure, once the ends of the
   --      links have been computed.

   procedure Update_Links
     (Canvas         : access Interactive_Canvas_Record;
      GC             : Gdk.GC.Gdk_GC;
      Invert_Mode    : Boolean;
      From_Selection : Boolean);
   --  Redraw all the links in the canvas, after the items have been laid out.
   --  GC is a default graphic context that can be used for drawing. However,
   --  any other graphic context will do. If Invert_Mode is true, this graphic
   --  context must draw in xor mode.
   --  If From_Selection is true, then only the links to or from one of the
   --  selected items need to be drawn.

   procedure Draw_Link
     (Canvas      : access Interactive_Canvas_Record'Class;
      Link        : access Canvas_Link_Record;
      Invert_Mode : Boolean;
      GC          : Gdk.GC.Gdk_GC;
      Edge_Number : Glib.Gint);
   --  Redraw the link on the canvas.
   --  Note that this is a primitive procedure of Link, not of Canvas, and thus
   --  can easily be overrided for specific links. The default version draws
   --  either straight or arc links (the latter when there are multiple links
   --  between two given items).
   --  This function shouldn't be called if one of the two ends of the link is
   --  invisible.
   --
   --  The link should be drawn directly in Get_Window (Canvas).
   --
   --  GC is a possible graphic context that could be used to draw the
   --  link. You shouldn't destroy it or modify its attributes. However, you
   --  can use any other graphic context specific to your application, for
   --  instance if you want to draw the link in various colors or shapes. The
   --  graphic context you use must be in Invert mode (see Gdk.GC.Set_Function)
   --  if and only if Invert_Mode is true, so that when items are moved on the
   --  canvas, the links properly follow the items they are attached to.
   --  This graphic context is only used to draw links, so you don't need to
   --  restore it on exit if your Draw_Link function always sets it at the
   --  beginning.
   --
   --  Edge_Number indicates the index of link in the list of links that join
   --  the same source to the same destination. It should be used so that two
   --  links do not overlap (for instance, the default is to draw the first
   --  link straight, and the others as arcs).

   type Item_Side is (East, West, North, South);
   --  Each side of an item, along its rectangle bounding box

   procedure Clip_Line
     (Src   : access Canvas_Item_Record;
      To_X  : Glib.Gint;
      To_Y  : Glib.Gint;
      X_Pos : Glib.Gfloat;
      Y_Pos : Glib.Gfloat;
      Side  : out Item_Side;
      X_Out : out Glib.Gint;
      Y_Out : out Glib.Gint);
   --  Clip the line that goes from Src at pos (X_Pos, Y_Pos) to (To_X, To_Y)
   --  in world coordinates.
   --  The intersection between that line and the border of Rect is returned
   --  in (X_Out, Y_Out). The result should be in world coordinates.
   --  X_Pos and Y_Pos have the same meaning as Src_X_Pos and Src_Y_Pos in the
   --  link record.
   --  This procedure is called when computing the position for the links
   --  within the default Draw_Link procedure. The default implementation only
   --  works with rectangular items. The computed coordinates are then passed
   --  on directly to Draw_Straight_Line.

   procedure Draw_Straight_Line
     (Link      : access Canvas_Link_Record;
      Window    : Gdk.Window.Gdk_Window;
      GC        : Gdk.GC.Gdk_GC;
      Src_Side  : Item_Side;
      X1, Y1    : Glib.Gint;
      Dest_Side : Item_Side;
      X2, Y2    : Glib.Gint);
   --  Draw a straight link between two points. This could be overriden if you
   --  need to draw an something along the link.
   --  The links goes from (Src, X1, Y1) to (Dest, X2, Y2), in canvas
   --  coordinates. The coordinates have already been clipped so that they do
   --  not override the item.

   ---------------
   -- Selection --
   ---------------

   procedure Clear_Selection (Canvas : access Interactive_Canvas_Record);
   --  Clear the list of currently selected items.

   procedure Add_To_Selection
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class);
   --  Add Item to the selection.  This is only meaningful during a drag
   --  operation (ie during a button press and the matching button
   --  release). Item will be moved at the same time that the selection is
   --  moved.
   --  Item is not added again if it is already in the selection.
   --  This function can be called from the Button_Click subprogram to force
   --  moving items.
   --  This emits the "item_selected" signal.

   procedure Remove_From_Selection
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class);
   --  Remove Item from the selection.
   --  This emits the "item_unselected" signal.

   procedure Select_All (Canvas : access Interactive_Canvas_Record);
   --  Select all the Item in the canvas.

   function Is_Selected
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class) return Boolean;
   --  Return True if the item is currently selected

   type Selection_Iterator is private;

   function Start (Canvas : access Interactive_Canvas_Record)
      return Selection_Iterator;
   --  Return the first selected item

   function Next (Iterator : Selection_Iterator)
      return Selection_Iterator;
   --  Move to the next selected item

   function Get (Iterator : Selection_Iterator) return Canvas_Item;
   --  Return the current item, or null if there is no more selected item.

   ------------------------
   -- Items manipulation --
   ------------------------

   procedure Selected
     (Item        : access Canvas_Item_Record;
      Canvas      : access Interactive_Canvas_Record'Class;
      Is_Selected : Boolean);
   --  Called when the item is selected or unselected.
   --  The default is to do nothing.

   function Point_In_Item
     (Item : access Canvas_Item_Record;
      X, Y : Glib.Gint) return Boolean;
   --  This function should return True if (X, Y) is inside the item. X and Y
   --  are in world coordinates.
   --  This function is meant to be overriden for non-rectangular items, since
   --  the default behavior works for rectangular items.
   --  This function is never called for invisible items

   procedure Set_Screen_Size
     (Item   : access Canvas_Item_Record;
      Width  : Glib.Gint;
      Height : Glib.Gint);
   --  Set the size of bounding box for the item in world coordinates.
   --  The item itself needn't occupy the whole area of this bounding box,
   --  see Point_In_Item.
   --  You need to redraw the item, and call Item_Updated to force the canvas
   --  to refresh the screen.

   procedure Draw
     (Item         : access Canvas_Item_Record;
      Canvas       : access Interactive_Canvas_Record'Class;
      GC           : Gdk.GC.Gdk_GC;
      Xdest, Ydest : Glib.Gint) is abstract;
   --  This subprogram, that must be overridden, should draw the item on
   --  Get_Pixmap (Canvas), at the specific location (Xdest, Ydest). The item
   --  must also be drawn at the appropriate zoom level.
   --  If you need to change the contents of the item, you should call
   --  Item_Updated after having done the drawing.

   procedure Destroy (Item : in out Canvas_Item_Record);
   --  Free the memory occupied by the item (not the item itself). You should
   --  override this function if you define your own widget type, but always
   --  call the parent's Destroy subprogram.

   procedure On_Button_Click
     (Item  : access Canvas_Item_Record;
      Event : Gdk.Event.Gdk_Event_Button);
   --  Function called whenever the item was clicked on.
   --  Note that this function is not called when the item is moved, and thus
   --  is only called when the click was short.
   --  The coordinates (X, Y) in the Event are relative to the top-left corner
   --  of Item.

   function Get_Coord
     (Item : access Canvas_Item_Record) return Gdk.Rectangle.Gdk_Rectangle;
   --  Return the coordinates and size of the bounding box for item, in world
   --  coordinates.
   --  If the item has never been resized, it initially has a width and height
   --  of 1.

   procedure Set_Visibility
     (Item    : access Canvas_Item_Record;
      Visible : Boolean);
   --  Set the visibility status of the item. An invisible item will not be
   --  visible on the screen, and will not take part in the computation of the
   --  the scrollbars for the canvas.
   --  The canvas is not refreshed (this is your responsibility to do it after
   --  you have finished doing all the modifications).

   function Is_Visible (Item : access Canvas_Item_Record) return Boolean;
   --  Return True if the item is currently visible

   function Is_From_Auto_Layout
     (Item : access Canvas_Item_Record) return Boolean;
   --  Return True if the current location of the item is the result from the
   --  auto layout algorithm.
   --  False is returned if the item was moved manually by the user.

   --------------------
   -- Buffered items --
   --------------------

   type Buffered_Item_Record is new Canvas_Item_Record with private;
   type Buffered_Item is access all Buffered_Item_Record'Class;
   --  A widget that has a double-buffer associated. You should use this one
   --  when drawing items can take a long time, or you do not want to handle
   --  the zoom yourself.
   --  You only need to update the contents of the double pixmap when the
   --  contents of the item changes, since all the drawing and zooming is
   --  taken care of automatically. Once the drawing is done, call Item_Updated
   --  to force the canvas to refresh the screen.
   --  This buffered_item is meant to handle rectangular items. However, it can
   --  be used for polygonal items by overriding Draw. The new version should
   --  set the clip mask for the GC, then call Draw for the buffered item, and
   --  finally reset the clip mask. The clip mask must take into account the
   --  current zoom level.

   function Pixmap (Item : access Buffered_Item_Record)
      return Gdk.Pixmap.Gdk_Pixmap;
   --  Return the double-buffer.
   --  All the drawing on this pixmap must be done at zoom level 100%.

   -------------
   -- Signals --
   -------------

   --  <signals>
   --  The following new signals are defined for this widget:
   --
   --  - "background_click"
   --  procedure Handler (Canvas : access Interactive_Canvas_Record'Class;
   --                     Event  : Gdk.Event.Gdk_Event);
   --
   --  Called every time the user clicks in the background (ie not on an item,
   --  or On_Button_Click would be called).
   --  This is called both on Button_Release and Button_Press events.
   --  The coordinates (X, Y) in the Event are relative to the top-left corner
   --  of Canvas.
   --
   --  - "item_selected"
   --  procedure Handler (Canvas : access Interactive_Canvas_Record'Class;
   --                     Item   : Canvas_Item);
   --
   --  Emitted when the user has clicked on an item to select it, ie before any
   --  drag even has occured. This is a good time to add other items to the
   --  selection if you need. At thee same time, the primitive operation
   --  Selected is called for the item.
   --
   --  - "item_unselected"
   --  procedure Handler (Canvas : access Interactive_Canvas_Record'Class;
   --                     Item   : Canvas_Item);
   --
   --  Emitted when the Item was unselected. At the same time, the primitive
   --  operation Selected is called for the item.
   --
   --  - "item_moved"
   --  procedure Handler (Canvas : access Interactive_Canvas_Record'Class;
   --                     Item   : Canvas_Item);
   --
   --  Emitted when Item has been moved. New coordinates have been assigned to
   --  Item. However, the canvas hasn't been refreshed yet. This signal might
   --  be called multiple time when the user finishes a drag action, in case
   --  there were several selected items.
   --
   --  - "zoomed"
   --  procedure Handler (Canvas : access Interactive_Canvas_Record'Class);
   --
   --  Emitted when the canvas has been zoomed in or out. You do not need to
   --  redraw the items yourself, since this will be handled by calls to Draw
   --
   --  </signals>

private

   type String_Access is access Glib.UTF8_String;

   type Canvas_Link_Record is new Glib.Graphs.Edge with record
      Descr  : String_Access;
      Arrow  : Arrow_Type := End_Arrow;

      Pixbuf : Gdk.Pixbuf.Gdk_Pixbuf := Gdk.Pixbuf.Null_Pixbuf;
      --  The pixmap in which the text is displayed. This is required to
      --  properly implement zooming through pixmaps. The text is drawn at zoom
      --  level 100%.

      Src_X_Pos  : Glib.Gfloat := 0.5;
      Src_Y_Pos  : Glib.Gfloat := 0.5;
      Dest_X_Pos : Glib.Gfloat := 0.5;
      Dest_Y_Pos : Glib.Gfloat := 0.5;
      --  Position of the link's attachment in each of the src and dest items.
   end record;

   type Item_Selection_List_Record;
   type Item_Selection_List is access all Item_Selection_List_Record;
   type Item_Selection_List_Record is record
      Item : Canvas_Item;
      X, Y : Glib.Gint;
      Next : Item_Selection_List;
   end record;
   --  A list of items, but this also memorizes the position of the items (used
   --  for selected widgets while they are being moved, so that we do not
   --  change the coordinates of the item itself until the mouse is released
   --  (and thus provide correct scrolling).

   type Selection_Iterator is new Item_Selection_List;

   type Interactive_Canvas_Record is new
     Gtk.Drawing_Area.Gtk_Drawing_Area_Record
   with record
      Children          : Glib.Graphs.Graph;

      Layout            : Layout_Algorithm := Default_Layout_Algorithm'Access;
      Auto_Layout       : Boolean := True;
      Vertical_Layout   : Boolean := False;
      --  The algorithm to use when laying out items on the canvas.

      Selection         : Item_Selection_List := null;
      --  List of currently selected items that will be moved when the mouse
      --  is dragged

      Last_X_Event      : Glib.Gint;
      Last_Y_Event      : Glib.Gint;
      --  Last position where the mouse was pressed or moved in the canvas.

      Bg_Selection_Width  : Glib.Gint;
      Bg_Selection_Height : Glib.Gint;
      --  The current dimension of the background selection rectangle. These
      --  can be negative.

      Mouse_Has_Moved   : Boolean;
      --  True if mouse has moved while the button was clicked. This is used
      --  to distinguish between item motion and item selection.

      Event_Press       : Gdk.Event.Gdk_Event;
      --  Save the event that was sent when the item was clicked on. This
      --  event will be sent to the application if the item was not moved.

      Show_Item                    : Canvas_Item;
      Show_X, Show_Y               : Glib.Gint;
      Show_Canvas_X, Show_Canvas_Y : Glib.Gdouble;
      --  The item that should be made visible when the canvas is resized.
      --  This is required since the canvas doesn't necessarily have a size yet
      --  when Show_Item() is called the first time. Show_X and Show_Y are
      --  used to save the other parameters to Show_Item

      Grid_Size         : Glib.Guint := Default_Grid_Size;
      --  The current number of pixels between each dot of the grid. If this
      --  is strictly below 2, the grid is not drawn.

      Arc_Link_Offset   : Glib.Gint := Default_Arc_Link_Offset;
      Arrow_Angle       : Float;
      Arrow_Length      : Glib.Gint := Default_Arrow_Length;
      Motion_Threshold  : Glib.Gint := Default_Motion_Threshold;
      Align_On_Grid     : Boolean := False;

      --  The following variables are initialized as soon as a Gdk_Window
      --  has been created for the canvas, in the Realized subprograms.

      Clear_GC        : Gdk.GC.Gdk_GC := Gdk.GC.Null_GC;
      Black_GC        : Gdk.GC.Gdk_GC := Gdk.GC.Null_GC;
      Link_GC         : Gdk.GC.Gdk_GC := Gdk.GC.Null_GC;
      Anim_GC         : Gdk.GC.Gdk_GC := Gdk.GC.Null_GC;

      Annotation_Layout : Pango.Layout.Pango_Layout;
      --  Layout used to draw the annotations

      Hadj, Vadj : Gtk.Adjustment.Gtk_Adjustment;
      Scrolling_Timeout_Id : Glib.Main.G_Source_Id := 0;
      Dashed_Line_Visible : Boolean := False;

      Orthogonal_Links : Boolean := False;
      --  True if the links should be orthogonal

      Surround_Box_Scroll : Glib.Gfloat;
      --  Amount of scrolling for each step while the cursor is left in the
      --  surrounding box.

      Zoom : Glib.Guint := 100;
      --  Zoom level in percent (100% is normal size)

      Target_Zoom : Glib.Guint := 100;
      Zoom_Step : Glib.Gint;
      --  Variables used while smooth-scrolling the canvas
   end record;

   type Canvas_Item_Record is abstract new Glib.Graphs.Vertex with record
      Coord            : Gdk.Rectangle.Gdk_Rectangle := (0, 0, 1, 1);
      --  Change doc for Get_Coord if you ever change default values.
      --  This is the bounding box of the item

      Visible          : Boolean := True;

      From_Auto_Layout : Boolean := True;
      --  True if the item's current location is the result of the automatic
      --  layout algorithm.
   end record;

   procedure Set_Screen_Size
     (Item   : access Buffered_Item_Record;
      Width, Height  : Glib.Gint);
   --  See documentation from inherited subprogram

   procedure Draw
     (Item         : access Buffered_Item_Record;
      Canvas       : access Interactive_Canvas_Record'Class;
      GC           : Gdk.GC.Gdk_GC;
      Xdest, Ydest : Glib.Gint);
   --  Draw the item's double-buffer onto Dest.

   procedure Destroy (Item : in out Buffered_Item_Record);
   --  Free the double-buffer allocated for the item

   type Buffered_Item_Record is new Canvas_Item_Record with record
      Pixmap : Gdk.Pixmap.Gdk_Pixmap;
   end record;

   type Item_Iterator is record
      Vertex            : Glib.Graphs.Vertex_Iterator;
      Edge              : Glib.Graphs.Edge_Iterator;
      Linked_From_Or_To : Canvas_Item;
   end record;

   pragma Inline (To_Canvas_Coordinates);
   pragma Inline (To_World_Coordinates);
   pragma Inline (Get_Arrow_Type);
   pragma Inline (Pixmap);
end Gtkada.Canvas;

--  <example>
--  --  The following example shows a possible Draw_Background procedure,
--  --  that draws a background image on the canvas's background. It fully
--  --  handles zooming and tiling of the image. Note that drawing a large
--  --  image will dramatically slow down the performances.
--
--  Background : Gdk.Pixbuf.Gdk_Pixbuf := ...;
--
--  procedure Draw_Background
--    (Canvas        : access Image_Canvas_Record;
--     Screen_Rect   : Gdk.Rectangle.Gdk_Rectangle)
--  is
--     X_Left : constant Glib.Gint := Left_World_Coordinates (Canvas);
--     Y_Top  : constant Glib.Gint := Top_World_Coordinates (Canvas);
--     X, Y, W, H, Ys : Gint;
--     Xs : Gint := Screen_Rect.X;
--     Bw : constant Gint := Get_Width (Background)
--       * Gint (Get_Zoom (Canvas)) / 100;
--     Bh : constant Gint := Get_Height (Background)
--       * Gint (Get_Zoom (Canvas)) / 100;
--     Scaled : Gdk_Pixbuf := Background;
--  begin
--     if Get_Zoom (Canvas) /= 100 then
--        Scaled := Scale_Simple (Background, Bw, Bh);
--     end if;
--
--     while Xs < Screen_Rect.X + Screen_Rect.Width loop
--        Ys := Screen_Rect.Y;
--        X := (X_Left + Xs) mod Bw;
--        W := Gint'Min (Screen_Rect.Width + Screen_Rect.X- Xs, Bw - X);

--        while Ys < Screen_Rect.Y + Screen_Rect.Height loop
--           Y := (Y_Top  + Ys) mod Bh;
--           H := Gint'Min
--             (Screen_Rect.Height + Screen_Rect.Y - Ys, Bh - Y);
--           Render_To_Drawable
--             (Pixbuf       => Scaled,
--              Drawable     => Get_Window (Canvas),
--              Gc           => Get_Black_GC (Get_Style (Canvas)),
--              Src_X        => X,
--              Src_Y        => Y,
--              Dest_X       => Xs,
--              Dest_Y       => Ys,
--              Width        => W,
--              Height       => H);
--           Ys := Ys + H;
--        end loop;
--        Xs := Xs + W;
--     end loop;
--
--     if Get_Zoom (Canvas) /= 100 then
--        Unref (Scaled);
--     end if;
--  end Draw_Background;
--  </example>