Testgtk source code
This code is part of testgtk, a demo application packaged with GtkAda. Testgtk demonstrates the various widgets of GtkAda
-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for the Gimp Toolkit --
-- --
-- Copyright (C) 2001 --
-- Emmanuel Briot, Joel Brobecker and Arnaud Charlet --
-- Copyright (C) 2003-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. --
-- --
--
--
--
--
--
--
--
-----------------------------------------------------------------------
with Gdk.Color;
use Gdk.Color;
with Gdk.GC;
use Gdk.GC;
with Gdk.Rectangle;
use Gdk.Rectangle;
with Glib;
use Glib;
with Gtk.Enums;
use Gtk.Enums;
with Gtk.Extra.Plot;
use Gtk.Extra.Plot;
with Gtk.Extra.Plot_Data;
use Gtk.Extra.Plot_Data;
with Gtk.Extra.Plot_Canvas;
use Gtk.Extra.Plot_Canvas;
with Gtk.Extra.Plot_Canvas.Plot;
use Gtk.Extra.Plot_Canvas.Plot;
with Gtk.Extra.Plot_Canvas.Text;
use Gtk.Extra.Plot_Canvas.Text;
with Gtk.Frame;
use Gtk.Frame;
with Glib.Main;
use Glib.Main;
with Gtk.Scrolled_Window;
use Gtk.Scrolled_Window;
with Gtk.Widget;
use Gtk.Widget;
with Gtkada.Handlers;
use Gtkada.Handlers;
with Unchecked_Deallocation;
with Ada.Numerics.Float_Random;
use Ada.Numerics.Float_Random;
package body Create_Plot_Realtime
is
Timer : G_Source_Id;
Random_Generator : Ada.Numerics.Float_Random.Generator;
type Timeout_Data
is record
Canvas : Gtk_Plot_Canvas;
Plot : Gtk_Plot;
Dataset : Gtk_Plot_Data;
X : Gdouble_Array_Access;
Y : Gdouble_Array_Access;
end record;
type Timeout_Data_Access
is access Timeout_Data;
package Plot_Timeout
is new Glib.Main.Generic_Sources (Timeout_Data_Access);
use Plot_Timeout;
procedure Free
is new Unchecked_Deallocation
(Gdouble_Array, Gdouble_Array_Access);
procedure Destroy (Widget :
access Gtk_Widget_Record'Class);
-- Called when the widget is destroyed, removes the timeout
function Update (Data : Timeout_Data_Access)
return Boolean;
-- Update the contents of the widget periodically
----------
-- Help --
----------
function Help
return String
is
begin
return "This demo shows how a plot can be updated periodically to"
& " show
new data.";
end Help;
-------------
-- Destroy --
-------------
procedure Destroy (Widget :
access Gtk_Widget_Record'Class)
is
pragma Warnings (Off, Widget);
begin
Remove (Timer);
end Destroy;
------------
-- Update --
------------
function Update (Data : Timeout_Data_Access)
return Boolean
is
X, Y : Gdouble_Array_Access;
Xmin, Xmax : Gdouble;
Length : Natural := 1;
begin
if Data.X /=
null then
Length := Data.X'Length + 1;
end if;
X :=
new Gdouble_Array (1 .. Length);
Y :=
new Gdouble_Array (1 .. Length);
if Length /= 1
then
X (1 .. Length - 1) := Data.X.
all;
Y (1 .. Length - 1) := Data.Y.
all;
X (Length) := X (Length - 1) + 1.0;
else
X (Length) := 1.0;
end if;
Y (Length) := Gdouble (Random (Random_Generator));
Free (Data.X);
Free (Data.Y);
Data.X := X;
Data.Y := Y;
Set_Numpoints (Data.Dataset, Gint (Length));
Set_X (Data.Dataset, X);
Set_Y (Data.Dataset, Y);
Get_Xrange (Data.Plot, Xmin, Xmax);
if X (Length) > Xmax
then
Set_Xrange (Data.Plot, Xmin + 5.0, Xmax + 5.0);
Paint (Data.Canvas);
Queue_Draw (Data.Canvas);
else
-- Draw only the last point added
Draw_Points (Data.Dataset, 1);
Refresh (Data.Plot, Full_Area);
end if;
return True;
end Update;
---------
-- Run --
---------
procedure Run (Frame :
access Gtk.Frame.Gtk_Frame_Record'Class)
is
Scrollw1 : Gtk_Scrolled_Window;
Canvas : Gtk_Plot_Canvas;
Color : Gdk_Color;
Active_Plot : Gtk_Plot;
Dataset : Gtk_Plot_Data;
Plot_Child : Gtk_Plot_Canvas_Plot;
Text_Child : Gtk_Plot_Canvas_Text;
begin
Set_Label (Frame, "gtk_plot realtime");
-- Put the Plot in a scrolled window, in case it is too big for
-- the screen
Gtk_New (Scrollw1);
Set_Border_Width (Scrollw1, 0);
Set_Policy (Scrollw1, Policy_Always, Policy_Always);
Add (Frame, Scrollw1);
-- Create the canvas in which the plot will be drawn
Gtk_New (Canvas, Gint (Get_Allocation_Width (Frame) - 10),
Gint (Get_Allocation_Height (Frame) - 10), 1.0);
Plot_Canvas_Unset_Flags (Canvas, Dnd_Flags);
Add_With_Viewport (Scrollw1, Canvas);
Widget_Callback.Connect
(Canvas, "destroy", Widget_Callback.To_Marshaller (Destroy'Access));
Color := Parse ("light blue");
Alloc (Get_Default_Colormap, Color);
Set_Background (Canvas, Color);
Show (Canvas);
-- Create the plot, the axis and legends
Gtk_New (Active_Plot, 0.65, 0.45);
Color := Parse ("light yellow");
Alloc (Get_Default_Colormap, Color);
Set_Background (Active_Plot, Color);
Color := Parse ("white");
Alloc (Get_Default_Colormap, Color);
Set_Legends_Border (Active_Plot, Border_Shadow, 3);
Legends_Move (Active_Plot, 0.6, 0.1);
Set_Range (Active_Plot, 0.0, 20.0, 0.0, 1.0);
Set_Ticks (Active_Plot, Axis_X, 2.0, 1);
Set_Ticks (Active_Plot, Axis_Y, 0.1, 1);
Axis_Set_Visible (Get_Axis (Active_Plot, Axis_Top), True);
Axis_Set_Visible (Get_Axis (Active_Plot, Axis_Right), True);
Grids_Set_Visible (Active_Plot, True, True, True, True);
Axis_Hide_Title (Get_Axis (Active_Plot, Axis_Top));
Axis_Hide_Title (Get_Axis (Active_Plot, Axis_Right));
Axis_Set_Title (Get_Axis (Active_Plot, Axis_Left), "Intensity");
Axis_Set_Title (Get_Axis (Active_Plot, Axis_Bottom), "Time");
Grids_Set_Visible (Active_Plot, True, True, True, True);
Gtk_New (Plot_Child, Active_Plot);
Put_Child (Canvas, Plot_Child, 0.15, 0.15, 0.9, 0.9);
Show (Active_Plot);
Gtk_New (Text_Child,
Font => "Times-BoldItalic",
Height => 10,
Text => "Real Time Demo");
Put_Child (Canvas, Text_Child, 0.45, 0.05, 0.85, 0.9);
-- Create the data
Gtk_New (Dataset);
Add_Data (Active_Plot, Dataset);
Show (Dataset);
Color := Parse ("red");
Alloc (Get_Default_Colormap, Color);
Set_Legend (Dataset, "Random Pulse");
Set_Symbol (Dataset,
Symbol_Diamond,
Symbol_Opaque,
10, 2.0, Color, Color);
Set_Line_Attributes
(Dataset, Line_Solid, Cap_Not_Last, Join_Miter, 1.0, Color);
-- Paint everything
Paint (Canvas);
Refresh (Canvas);
-- Register the periodic timer
Timer := Plot_Timeout.Timeout_Add
(300,
Update'Access,
new Timeout_Data'(Canvas => Canvas,
Plot => Active_Plot,
Dataset => Dataset,
X =>
null,
Y =>
null));
Show_All (Frame);
end Run;
end Create_Plot_Realtime;