with Gtk.Main;
with Gtk.Rc;
with Gtk.Enums; use Gtk.Enums;
with Gtk.Dialog; use Gtk.Dialog;
with Gtk.Stock; use Gtk.Stock;
with Gtk.Widget; use Gtk.Widget;
with Gtk.Handlers; use Gtk.Handlers;
with Gdk.Rectangle; use Gdk.Rectangle;
with Glib; use Glib;
with Gtk.Style; use Gtk.Style;
with Gdk.Drawable; use Gdk.Drawable;
with Glib.Error; use Glib.Error;
with Dates; use Dates;
pragma Elaborate_All (Gtk.Handlers);
package body Idl.Main_Window is
-- Main quit Callback
procedure Main_Quit
(widget : access Gtk_Widget_Record'class;
Main_Window : in Main_Window_Access) is
Dialog : Gtk.Dialog.Gtk_Dialog;
Yes : Gtk.Widget.Gtk_Widget;
No : Gtk.Widget.Gtk_Widget;
Help : Gtk.Widget.Gtk_Widget;
begin
loop
Gtk.Dialog.Gtk_New(Dialog, "Quit ?", Main_Window.Master, Gtk.dialog.modal);
Yes := Gtk.Dialog.Add_Button(Dialog, "Yes", Gtk.Dialog.Gtk_Response_Yes);
No := Gtk.Dialog.Add_Button(Dialog, "No", Gtk.Dialog.Gtk_Response_No);
Help := Gtk.Dialog.Add_Button(Dialog, "Help", Gtk.Dialog.Gtk_Response_Help);
case Gtk.Dialog.Run(Dialog) is
when Gtk.Dialog.Gtk_Response_Yes =>
Main_Window.Idl.Halt;
Gtk.Dialog.Destroy(Dialog);
Gtk.Main.Gtk_Exit (0);
exit;
when Gtk.Dialog.Gtk_Response_No =>
Gtk.Dialog.Destroy(Dialog);
exit;
when Gtk.Dialog.Gtk_Response_Help =>
Gtk.Dialog.Destroy(Dialog);
when others =>
Gtk.Dialog.Destroy(Dialog);
end case;
end loop;
end Main_Quit;
-- Main drestroy Callback
function Main_Destroy
(widget : access Gtk_Widget_Record'class;
Main_Window : in Main_Window_Access) return Boolean is
Dialog : Gtk.Dialog.Gtk_Dialog;
Yes : Gtk.Widget.Gtk_Widget;
No : Gtk.Widget.Gtk_Widget;
Help : Gtk.Widget.Gtk_Widget;
begin
loop
Gtk.Dialog.Gtk_New(Dialog, "Quit ?", Main_Window.Master, Gtk.dialog.modal);
Yes := Gtk.Dialog.Add_Button(Dialog, "Yes", Gtk.Dialog.Gtk_Response_Yes);
No := Gtk.Dialog.Add_Button(Dialog, "No", Gtk.Dialog.Gtk_Response_No);
Help := Gtk.Dialog.Add_Button(Dialog, "Help", Gtk.Dialog.Gtk_Response_Help);
case Gtk.Dialog.Run(Dialog) is
when Gtk.Dialog.Gtk_Response_Yes =>
Gtk.Dialog.Destroy(Dialog);
Main_Window.Idl.Halt;
Gtk.Main.Gtk_Exit (0);
return False;
when Gtk.Dialog.Gtk_Response_No =>
Gtk.Dialog.Destroy(Dialog);
return True;
when Gtk.Dialog.Gtk_Response_Help =>
Gtk.Dialog.Destroy(Dialog);
when others =>
Gtk.Dialog.Destroy(Dialog);
end case;
end loop;
end Main_Destroy;
task body Idl_Process is
Status, End_Of_Task : Boolean := False;
begin
while not End_Of_Task loop
select
accept Halt do
End_Of_Task := True;
end Halt;
else
null;
end select;
end loop;
end Idl_Process;
function UpDate(Main_Window : Main_Window_Access) return Boolean is
begin
Set_Label(Main_Window.Date, Long_Time2string(clock));
Queue_draw(Main_Window.date);
return True;
end UpDate;
procedure Draw_Background
(Main_Window : in Main_Window_access;
Screen_Rect : Gdk.Rectangle.Gdk_Rectangle)
is
X_Left : constant Glib.Gint := Left_World_Coordinates (Main_Window.Canvas);
Y_Top : constant Glib.Gint := Top_World_Coordinates (Main_Window.Canvas);
begin
if Main_Window.Background /= null then
-- This is slightly complex, since we need to properly handle zooming
-- and tiling.
declare
X, Y, W, H, Ys : Gint;
Xs : Gint := Screen_Rect.X;
Bw : constant Gint := Get_Width (Main_Window.Background)
* Gint (Get_Zoom (Main_Window.Canvas)) / 100;
Bh : constant Gint := Get_Height (Main_Window.Background)
* Gint (Get_Zoom (Main_Window.Canvas)) / 100;
Scaled : Gdk_Pixbuf := Main_Window.Background;
begin
-- A real application would cache this scaled pixmap, and update
-- the cache when the "zoomed" signal is emitted.
if Get_Zoom (Main_Window.Canvas) /= 100 then
Scaled := Scale_Simple (Main_Window.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 (Main_Window.Canvas),
Gc => Get_Black_GC (Get_Style (Main_Window.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 (Main_Window.Canvas) /= 100 then
Unref (Scaled);
end if;
end;
else
Draw_Rectangle
(Get_Window (Main_Window.Canvas),
Get_Background_GC (Get_Style (Main_Window.Canvas), State_Normal),
Filled => True,
X => Screen_Rect.X,
Y => Screen_Rect.Y,
Width => Gint (Screen_Rect.Width),
Height => Gint (Screen_Rect.Height));
end if;
end Draw_Background;
procedure Set_Background(Widget : access Gtk_Widget_Record'Class;
Main_window : Main_Window_access)
is
Error : GError;
begin
Gdk_New_From_File
(Main_Window.Background,
Filename => "background.jpg",
Error => Error);
--Canvas.Grid_GC := Get_White_GC (Get_Style (Canvas));
Refresh_Canvas (Main_Window.Canvas);
end Set_Background;
procedure Unset_Background(Widget : access Gtk_Widget_Record'Class;
Main_window : Main_Window_access)
is
begin
if Main_window.Background /= null then
Unref (Main_window.Background);
Main_window.Background := null;
end if;
--Canvas.Grid_GC := Get_Black_GC (Get_Style (Canvas));
Refresh_Canvas (Main_Window.Canvas);
end Unset_Background;
package Main_Handlers is new Gtk.Handlers.User_Callback(Gtk.Widget.Gtk_Widget_Record, Main_Window_Access);
package Main_Return_Handlers is new Gtk.Handlers.User_Return_Callback(Gtk.Widget.Gtk_Widget_Record, Boolean,Main_Window_Access);
package Date_Timeout is new Gtk.Main.Timeout(Main_Window_Access);
procedure Initialize(Main_Window : in out Main_Window_Access) is
Timeout_Id : Gtk.Main.Timeout_Handler_Id;
begin
-- Initialize main window.
Main_Window := new Main_Window_Type;
Gtk_New(Main_Window.Master);
Set_Default_Size(Main_Window.Master, 1024, 768);
Set_Title(Main_Window.Master,"Idl-Project 2012" );
Set_Position(Main_Window.Master, Win_Pos_Center);
-- Initialize main menu.
Gtk_New_Hbox(Main_Window.Menu_Hbox);
Gtk_New(Main_Window.Main_Menu_Bar);
Gtk_New(Main_Window.File_Menu);
Gtk_New(Main_Window.File_Menu_Item, "Fichier" );
Gtk_New(Main_Window.Exit_Menu_Item, "Quitter" );
-- Initialize Background menu.
Gtk_New(Main_Window.background_Menu);
Gtk_New(Main_Window.Background_Menu_Item, "Carte" );
Gtk_New(Main_Window.Set_background, "Afficher" );
Gtk_New(Main_Window.Unset_background, "Effacer" );
-- Initialize date label.
Gtk_New(Main_Window.Date, "no clock" );
-- Assembling Main Menu.
Set_Submenu(Main_Window.File_Menu_Item, Main_Window.File_Menu);
Append(Main_Window.File_Menu, Main_Window.Exit_Menu_Item);
Append(Main_Window.Main_Menu_Bar, Main_Window.File_Menu_Item);
Set_Submenu(Main_Window.Background_Menu_Item, Main_Window.Background_Menu);
Append(Main_Window.Background_Menu, Main_Window.Set_background);
Append(Main_Window.Background_Menu, Main_Window.Unset_background);
Append(Main_Window.Main_Menu_Bar, Main_Window.Background_Menu_item);
Pack_Start(Main_Window.Menu_Hbox, Main_Window.Main_Menu_Bar, False, False, 0);
-- Assembing Date label
Pack_Start(Main_Window.Menu_Hbox, Main_Window.Date, True, False, 0);
-- initialize Main Vbox.
Gtk_New_Vbox(Main_Window.Main_Vbox);
-- Initialize Main Frame.
Gtk_New(Main_Window.Main_Frame);
-- Initialize Scrolled Window
Gtk_New(Main_Window.Scrolled);
-- Initialize Canvas
Gtk_New(Main_Window.Canvas);
-- Initialize background.
Main_handlers.Connect(Main_Window.Set_Background, "activate",
Main_handlers.To_Marshaller (Set_Background'Access),
Main_window);
Main_handlers.Connect(Main_Window.Unset_Background, "activate",
Main_handlers.To_Marshaller (Unset_Background'Access),
Main_window);
Align_On_Grid (Main_Window.Canvas, False);
-- Assembling Canvas to Main frame with scrolled.
Add (Main_Window.Scrolled, Main_Window.Canvas);
Add(Main_Window.Main_Frame, Main_Window.Scrolled);
-- Initialize Status Bar.
Gtk_New(Main_Window.Status_Bar);
-- Asembling Main Vbox.
Pack_Start(Main_Window.Main_Vbox, Main_Window.Menu_Hbox, False, False, 0);
Pack_Start(Main_Window.Main_Vbox, Main_Window.Main_Frame, True, True, 0);
Pack_Start(Main_Window.Main_Vbox, Main_Window.Status_Bar, False, False, 0);
-- Add Vbox to Main Window.
Add(Main_Window.Master, Main_Window.Main_Vbox);
-- Realize Canvas.
Realize (Main_Window.Canvas);
-- Gtimer_Add date label.
Timeout_Id := Date_Timeout.Add(1000, Update'Access, Main_Window);
-- Attach Callback.
Main_handlers.Connect
(Main_Window.Exit_Menu_Item, "activate", Main_handlers.To_Marshaller (Main_Quit'access), Main_Window);
Main_Return_Handlers.Connect
(Main_Window.Master, "delete_event", Main_Return_Handlers.To_Marshaller (Main_destroy'access), Main_Window);
Show_All(Main_Window.Master);
end Initialize;
begin
Gtk.Main.Init;
Gtk.Rc.Parse("./gtkrc.rc" );
end Idl.Main_Window;