/usr/share/doc/libgtkada-doc/examples/doublebuffer/anim_task.adb is in libgtkada-doc 2.24.4dfsg-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | with Glib; use Glib;
with Double_Buffer; use Double_Buffer;
with Gdk.Color; use Gdk.Color;
with Gdk.Drawable; use Gdk.Drawable;
with Gdk.Threads; use Gdk.Threads;
with Gtk.Drawing_Area; use Gtk.Drawing_Area;
with Gdk.GC; use Gdk.GC;
with Gtk.Window; use Gtk.Window;
with Gtk.Enums; use Gtk.Enums;
with Gtk.Box; use Gtk.Box;
with Gtk.Label; use Gtk.Label;
with Gtk.Widget; use Gtk.Widget;
with Gtk.Main; use Gtk.Main;
with Gtk.Handlers; use Gtk.Handlers;
pragma Elaborate_All (Gtk.Handlers);
with Ada.Text_IO; use Ada.Text_IO;
package body Anim_Task is
White_Gc : Gdk.GC.Gdk_GC;
Black_Gc : Gdk.GC.Gdk_GC;
X_Pos : Gint := 10;
package Void_Cb is new Gtk.Handlers.Callback (Gtk_Window_Record);
Abort_Animations_Tasks : Boolean := False;
pragma Volatile (Abort_Animations_Tasks);
-- This variable should be set to true when we want to abort all the
-- animation tasks. We could of course use a rendez-vous ...
------------------
-- Draw_Complex --
------------------
procedure Draw_Complex (Pixmap : Gdk_Drawable) is
begin
Draw_Rectangle (Pixmap, White_Gc, Filled => True,
X => 0, Y => 0,
Width => 400, Height => 400);
for J in Gint'(1) .. 30 loop
Draw_Rectangle (Pixmap, Black_Gc, Filled => False,
X => X_Pos, Y => 30 + J * 2,
Width => X_Pos + 100, Height => 100);
Draw_Rectangle (Pixmap, Black_Gc, Filled => False,
X => X_Pos + 20, Y => 60 + J * 2,
Width => X_Pos + 60, Height => 80);
Draw_Rectangle (Pixmap, Black_Gc, Filled => False,
X => X_Pos + 30, Y => 50 + J * 2,
Width => X_Pos + 80, Height => 90);
Draw_Rectangle (Pixmap, Black_Gc, Filled => False,
X => X_Pos - 20, Y => 120 + J * 2,
Width => X_Pos + 80, Height => 190);
end loop;
X_Pos := (X_Pos + 1) mod 140;
end Draw_Complex;
----------
-- Quit --
----------
procedure Quit (Win : access Gtk_Window_Record'Class) is
pragma Warnings (Off, Win);
begin
Abort_Animations_Tasks := True;
Gtk.Main.Gtk_Exit (0);
end Quit;
-------------
-- Animate --
-------------
procedure Animate
(Buffer : Gtk_Double_Buffer;
Area : Gtk_Drawing_Area)
is
task Double_Buffer_Task;
task Area_Task;
task body Double_Buffer_Task is
begin
while not Abort_Animations_Tasks loop
Gdk.Threads.Enter;
Draw_Complex (Get_Pixmap (Buffer));
Draw (Buffer);
Gdk.Threads.Leave;
delay 0.01;
end loop;
end Double_Buffer_Task;
task body Area_Task is
begin
while not Abort_Animations_Tasks loop
Gdk.Threads.Enter;
Draw_Complex (Get_Window (Area));
Gdk.Threads.Leave;
delay 0.01;
end loop;
end Area_Task;
begin
Gdk.Threads.Enter;
Gtk.Main.Main;
Gdk.Threads.Leave;
end Animate;
----------
-- Init --
----------
procedure Init is
Win : Gtk_Window;
Area : Gtk_Drawing_Area;
Buffer : Gtk_Double_Buffer;
Vbox,
Hbox : Gtk_Box;
Label : Gtk_Label;
begin
Put_Line ("This demo shows how you can use a Double_Buffer widget");
Put_Line (" to provide flicker-free animations in your applications.");
Put_Line ("The code is almost the same as with a Gtk_Drawing_Area.");
Put_Line (" (the drawing routines are exactly the same in this demo)");
Put_Line (" except that in one case you draw in an off-screen pixmap");
Put_Line (" That you need to copy to the screen when you are ready.");
New_Line;
Put_Line ("The animation is done thanks to two Ada95 tasks");
-- This demo uses multi-tasking
Gdk.Threads.G_Init;
Gdk.Threads.Init;
-- Double buffer demo
Gtk_New (Win, Window_Toplevel);
Set_Title (Win, "Animation demo");
Void_Cb.Connect (Win, "destroy", Void_Cb.To_Marshaller (Quit'Access));
Gtk_New_Hbox (Hbox, Homogeneous => True, Spacing => 10);
Gtk_New_Vbox (Vbox, Homogeneous => False, Spacing => 20);
Gtk_New (Label, "With double-buffering");
Gtk_New (Buffer);
Set_USize (Buffer, 200, 200);
Pack_Start (Vbox, Label, Expand => False);
Pack_Start (Vbox, Buffer);
Pack_Start (Hbox, Vbox);
Gtk_New_Vbox (Vbox, Homogeneous => False, Spacing => 20);
Gtk_New (Label, "No double-buffering");
Gtk_New (Area);
Set_USize (Area, 200, 200);
Pack_Start (Vbox, Label, Expand => False);
Pack_Start (Vbox, Area);
Pack_Start (Hbox, Vbox);
Add (Win, Hbox);
Show_All (Win);
-- The window needs to be created before creating the GCs
Gdk.GC.Gdk_New (White_Gc, Get_Window (Buffer));
Gdk.GC.Set_Foreground
(White_Gc, Gdk.Color.White (Gtk.Widget.Get_Default_Colormap));
Gdk.GC.Gdk_New (Black_Gc, Get_Window (Buffer));
Gdk.GC.Set_Foreground
(Black_Gc, Gdk.Color.Black (Gtk.Widget.Get_Default_Colormap));
Animate (Buffer, Area);
end Init;
end Anim_Task;
|