----------------------------------------------------------------------- -- GtkAda - Ada95 binding for the Gimp Toolkit -- -- -- -- Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet -- -- Copyright (C) 2000-2011, 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 Glib; use Glib; with Glib.Properties; use Glib.Properties; with Gtk; use Gtk; with Gdk; use Gdk; with Gdk.Color; use Gdk.Color; with Gtk.Box; use Gtk.Box; with Gtk.Button; use Gtk.Button; with Gtk.Dialog; use Gtk.Dialog; with Gtk.Enums; use Gtk.Enums; with Gtk.Frame; use Gtk.Frame; with Gtk.Handlers; use Gtk.Handlers; with Gtkada.Handlers; use Gtkada.Handlers; with Gtk.Hbutton_Box; use Gtk.Hbutton_Box; with Gtk.Label; use Gtk.Label; with Gtk.Main; use Gtk.Main; with Gtk.Notebook; use Gtk.Notebook; with Gtk.Scrolled_Window; use Gtk.Scrolled_Window; with Gtk.Paned; use Gtk.Paned; with Gtk.Style; use Gtk.Style; with Gtk.Text_Buffer; use Gtk.Text_Buffer; with Gtk.Text_Iter; use Gtk.Text_Iter; with Gtk.Text_Mark; use Gtk.Text_Mark; with Gtk.Text_Tag; use Gtk.Text_Tag; with Gtk.Text_Tag_Table; use Gtk.Text_Tag_Table; with Gtk.Text_View; use Gtk.Text_View; with Gtk.Tree_Model; use Gtk.Tree_Model; with Gtk.Tree_Selection; use Gtk.Tree_Selection; with Gtk.Tree_Store; use Gtk.Tree_Store; with Gtk.Tree_View; use Gtk.Tree_View; with Gtk.Tree_View_Column; use Gtk.Tree_View_Column; with Gtk.Cell_Renderer_Text; use Gtk.Cell_Renderer_Text; with Gtk.Widget; use Gtk.Widget; with Gtk.Window; use Gtk.Window; with Pango.Font; use Pango.Font; with Ada.Strings.Fixed; with Create_About; with Create_Alignment; with Create_Arrow; with Create_Assistant; with Create_Box; with Create_Builder; with Create_Gtkada_Builder; with Create_Button_Box; with Create_Buttons; with Create_Calendar; with Create_Canvas; with Create_Cell_View; with Create_Check_Buttons; with Create_Clipboard; with Create_Clist; with Create_Ctree; with Create_Color_Selection; with Create_Combo_Box; with Create_Cursors; with Create_Dialog; with Create_Dnd; with Create_Entry; with Create_Frame; with Create_File_Chooser; with Create_File_Selection; with Create_Fixed; with Create_Font_Selection; with Create_Gamma_Curve; with Create_Gc; with Create_Handle_Box; with Create_Icon_View; with Create_Item_Factory; with Create_Label; with Create_Layout; with Create_Link_Buttons; with Create_List; with Create_Main_Loop; with Create_Menu; with Create_MDI; with Create_Notebook; with Create_Opacity; with Create_Paned; with Create_Pixbuf; with Create_Pixmap; with Create_Plot; with Create_Plot_3D; with Create_Plot_Realtime; with Create_Preview_Color; with Create_Preview_Gray; with Create_Print; with Create_Progress; with Create_Radio_Button; with Create_Range; with Create_Reparent; with Create_Rulers; with Create_Scrolled; with Create_Scroll_Test; with Create_Selection; with Create_Size_Groups; with Create_Sheet; with Create_Sources; with Create_Spin; with Create_Spinners; with Create_Splittable; with Create_Status; with Create_Status_Icons; with Create_Test_Idle; with Create_Test_Timeout; with Create_Text_View; with Create_Toggle_Buttons; with Create_Toolbar; with Create_Tooltips; with Create_Tree_Filter; with Create_Tree_View; with Create_UI_Manager; with Common; use Common; with View_Gl; use View_Gl; with Libart_Demo; use Libart_Demo; package body Main_Windows is procedure Fill_Gtk_Tree (Tree : Gtk.Tree_Store.Gtk_Tree_Store; Gtkada_Demos : Boolean := False; Pixbuf_Demos : Boolean := False); -- Creates the tree that contains the list of gtk demos available procedure Display_Help (Button : access Gtk_Widget_Record'Class); -- Display an Help window for the current demo package Notebook_Cb is new Gtk.Handlers.User_Callback (Gtk_Notebook_Record, Gtk_Notebook); Help_Dialog : Gtk.Dialog.Gtk_Dialog; Help_Text : Gtk.Text_Buffer.Gtk_Text_Buffer; -- The dialog used to display the help window Gtk_Demo_Frames : array (1 .. 3) of Gtk.Frame.Gtk_Frame; -- Frames where the gtk demos should be displayed. type Demo_Function is access procedure (Frame : access Gtk_Frame_Record'Class); -- The type of function to call when an item in the tree is selected. -- The parameter is the frame in which the demo should be displayed Current_Help : Help_Function := null; -- Returns the help string to display, -- Symbols between @b and @B are displayed in bold -- New lines should be represented by ASCII.LF type String_Access is access String; function NS (S : String) return String_Access; procedure Tree_Select_Child (View : access Gtk_Widget_Record'Class); -- Callbacks when a different item in the tree is selected. package Window_Cb is new Handlers.Callback (Gtk_Widget_Record); package Return_Window_Cb is new Handlers.Return_Callback (Gtk_Widget_Record, Boolean); procedure Exit_Main (Object : access Gtk_Widget_Record'Class); -- Callbacks when the main window is killed function Delete_Event (Object : access Gtk_Widget_Record'Class) return Boolean; procedure Destroy_Help (Button : access Gtk_Widget_Record'Class); function Opengl_Help return String; procedure Switch_Page (Notebook : access Gtk_Notebook_Record'Class; Page : Gtk.Gtk_Notebook_Page; User : Gtk_Notebook); -- Called when a new notebook page is selected procedure Create_Demo_Frame (Win : access Main_Window_Record'Class; Page : Integer; Title : String; Gtkada_Demo, Pixbuf_Demo : Boolean); -- Create the main demo frame type Demo_Type is (Box, Base, Complex, Gimp, GdkD, Gtkada, Misc, Pixbuf); -- The available types for demos. -- Each of them is a tree item, whose subitems are the matching demos. -- Box: Containers -- Base: Basic widgets, found in all GUI toolkits -- Complex: More interesting widgets -- Gimp: Widgets developped for gimp, that could be reused -- Misc: Demonstrates some features that are not widgets -- Gtkada: Widgets specific to GtkAda -- Pixbuf: Demonstrate the use of images type Tree_Item_Information is record Label : String_Access; Typ : Demo_Type; Func : Demo_Function; Help : Help_Function; end record; function NS (S : String) return String_Access is begin return new String'(S); end NS; type Tree_Item_Array is array (Positive range <>) of Tree_Item_Information; -- The list of items to put in the tree for the gtk demos Gtk_Demos : constant Tree_Item_Array := ((NS ("about dialog"), Base, Create_About.Run'Access, Create_About.Help'Access), (NS ("alignment"), Box, Create_Alignment.Run'Access, Create_Alignment.Help'Access), (NS ("animation"), Pixbuf, Create_Pixbuf.Run'Access, Create_Pixbuf.Help'Access), (NS ("animated gif"), Pixbuf, Create_Pixbuf.Run_Gif'Access, Create_Pixbuf.Help_Gif'Access), (NS ("arrow"), Base, Create_Arrow.Run'Access, Create_Arrow.Help'Access), (NS ("assistant"), Complex, Create_Assistant.Run'Access, Create_Assistant.Help'Access), (NS ("box"), Box, Create_Box.Run'Access, Create_Box.Help'Access), (NS ("builder"), Complex, Create_Builder.Run'Access, Create_Builder.Help'Access), (NS ("gtkada builder"), Complex, Create_Gtkada_Builder.Run'Access, Create_Gtkada_Builder.Help'Access), (NS ("button box"), Box, Create_Button_Box.Run'Access, Create_Button_Box.Help'Access), (NS ("buttons"), Base, Create_Buttons.Run'Access, Create_Buttons.Help'Access), (NS ("calendar"), Base, Create_Calendar.Run'Access, Create_Calendar.Help'Access), (NS ("canvas"), Gtkada, Create_Canvas.Run'Access, Create_Canvas.Help'Access), (NS ("cell view"), Complex, Create_Cell_View.Run'Access, Create_Cell_View.Help'Access), (NS ("check buttons"), Base, Create_Check_Buttons.Run'Access, Create_Check_Buttons.Help'Access), (NS ("clipboard"), Misc, Create_Clipboard.Run'Access, Create_Clipboard.Help'Access), (NS ("clist"), Complex, Create_Clist.Run'Access, Create_Clist.Help'Access), (NS ("ctree"), Complex, Create_Ctree.Run'Access, Create_Ctree.Help'Access), (NS ("color selection"), Gimp, Create_Color_Selection.Run'Access, Create_Color_Selection.Help'Access), (NS ("combo boxes"), Complex, Create_Combo_Box.Run'Access, Create_Combo_Box.Help'Access), (NS ("cursors"), Misc, Create_Cursors.Run'Access, Create_Cursors.Help'Access), (NS ("dialog"), Base, Create_Dialog.Run'Access, Create_Dialog.Help'Access), (NS ("drag-and-drop"), Complex, Create_Dnd.Run'Access, Create_Dnd.Help'Access), (NS ("entry"), Base, Create_Entry.Run'Access, Create_Entry.Help'Access), (NS ("event watcher"), Misc, null, null), (NS ("file chooser button"), Complex, Create_File_Chooser.Run_Button'Access, Create_File_Chooser.Help_Button'Access), (NS ("file selection"), Complex, Create_File_Selection.Run'Access, Create_File_Selection.Help'Access), (NS ("fixed"), Box, Create_Fixed.Run'Access, Create_Fixed.Help'Access), (NS ("font selection"), Gimp, Create_Font_Selection.Run'Access, Create_Font_Selection.Help'Access), (NS ("frame/aspect frame"), Box, Create_Frame.Run'Access, Create_Frame.Help'Access), (NS ("gamma curve"), Gimp, Create_Gamma_Curve.Run'Access, Create_Gamma_Curve.Help'Access), (NS ("graphic contexts"), GdkD, Create_Gc.Run'Access, Create_Gc.Help'Access), (NS ("handle box"), Box, Create_Handle_Box.Run'Access, Create_Handle_Box.Help'Access), (NS ("icon view"), Complex, Create_Icon_View.Run'Access, Create_Icon_View.Help'Access), (NS ("item factory"), Complex, Create_Item_Factory.Run'Access, Create_Item_Factory.Help'Access), (NS ("labels"), Base, Create_Label.Run'Access, Create_Label.Help'Access), (NS ("layout"), Box, Create_Layout.Run'Access, Create_Layout.Help'Access), (NS ("link buttons"), Base, Create_Link_Buttons.Run'Access, Create_Link_Buttons.Help'Access), (NS ("list"), Base, Create_List.Run'Access, Create_List.Help'Access), (NS ("menus"), Base, Create_Menu.Run'Access, Create_Menu.Help'Access), (NS ("mdi"), Gtkada, Create_MDI.Run'Access, Create_MDI.Help'Access), (NS ("mdi (independent perspectives)"), Gtkada, Create_MDI.Run_Independent'Access, Create_MDI.Help'Access), (NS ("modal window"), Base, null, null), (NS ("multi paned"), Gtkada, Create_Splittable.Run'Access, Create_Splittable.Help'Access), (NS ("notebook"), Box, Create_Notebook.Run'Access, Create_Notebook.Help'Access), (NS ("opacity"), Misc, Create_Opacity.Run'Access, Create_Opacity.Help'Access), (NS ("panes"), Box, Create_Paned.Run'Access, Create_Paned.Help'Access), (NS ("pixmap"), Base, Create_Pixmap.Run'Access, Create_Pixmap.Help'Access), (NS ("plot"), Complex, Create_Plot.Run'Access, Create_Plot.Help'Access), (NS ("plot 3D"), Complex, Create_Plot_3D.Run'Access, Create_Plot_3D.Help'Access), (NS ("plot realtime"), Complex, Create_Plot_Realtime.Run'Access, Create_Plot_Realtime.Help'Access), (NS ("properties"), Misc, null, null), (NS ("preview color"), Gimp, Create_Preview_Color.Run'Access, Create_Preview_Color.Help'Access), (NS ("preview gray"), Gimp, Create_Preview_Gray.Run'Access, Create_Preview_Gray.Help'Access), (NS ("printing"), Base, Create_Print.Run'Access, Create_Print.Help'Access), (NS ("progress bar"), Complex, Create_Progress.Run'Access, Create_Progress.Help'Access), (NS ("progressive loading"), Pixbuf, null, null), (NS ("radio buttons"), Base, Create_Radio_Button.Run'Access, Create_Radio_Button.Help'Access), (NS ("range controls"), Base, Create_Range.Run'Access, Create_Range.Help'Access), (NS ("rc file"), Misc, null, null), (NS ("reparent"), Complex, Create_Reparent.Run'Access, Create_Reparent.Help'Access), (NS ("rulers"), Gimp, Create_Rulers.Run'Access, Create_Rulers.Help'Access), (NS ("saved position"), Misc, null, null), (NS ("scaling/composing"), Pixbuf, Libart_Demo.Run'Access, Libart_Demo.Help'Access), (NS ("scrolled windows"), Base, Create_Scrolled.Run'Access, Create_Scrolled.Help'Access), (NS ("selection"), Complex, Create_Selection.Run'Access, Create_Selection.Help'Access), (NS ("shapes"), Misc, null, null), (NS ("sheet"), Complex, Create_Sheet.Run'Access, Create_Sheet.Help'Access), (NS ("size groups"), Box, Create_Size_Groups.Run'Access, Create_Size_Groups.Help'Access), (NS ("event sources"), Misc, Create_Sources.Run'Access, Create_Sources.Help'Access), (NS ("spinbutton"), Base, Create_Spin.Run'Access, Create_Spin.Help'Access), (NS ("spinner"), Base, Create_Spinners.Run'Access, Create_Spinners.Help'Access), (NS ("statusbar"), Base, Create_Status.Run'Access, Create_Status.Help'Access), (NS ("status icons"), Base, Create_Status_Icons.Run'Access, Create_Status_Icons.Help'Access), (NS ("stock icons"), Pixbuf, null, null), (NS ("test idle"), Misc, Create_Test_Idle.Run'Access, Create_Test_Idle.Help'Access), (NS ("test mainloop"), Misc, Create_Main_Loop.Run'Access, Create_Main_Loop.Help'Access), (NS ("test scrolling"), Misc, Create_Scroll_Test.Run'Access, Create_Scroll_Test.Help'Access), (NS ("test selection"), Misc, null, null), (NS ("test timeout"), Misc, Create_Test_Timeout.Run'Access, Create_Test_Timeout.Help'Access), (NS ("text view"), Complex, Create_Text_View.Run'Access, Create_Text_View.Help'Access), (NS ("toggle buttons"), Base, Create_Toggle_Buttons.Run'Access, Create_Toggle_Buttons.Help'Access), (NS ("toolbar"), Box, Create_Toolbar.Run'Access, Create_Toolbar.Help'Access), (NS ("tooltips"), Complex, Create_Tooltips.Run'Access, Create_Tooltips.Help'Access), (NS ("tree filter"), Complex, Create_Tree_Filter.Run'Access, Create_Tree_Filter.Help'Access), (NS ("tree view"), Complex, Create_Tree_View.Run'Access, Create_Tree_View.Help'Access), (NS ("UI manager"), Complex, Create_UI_Manager.Run'Access, Create_UI_Manager.Help'Access), (NS ("WM hints"), Misc, null, null) ); ------------------- -- Fill_Gtk_Tree -- ------------------- procedure Fill_Gtk_Tree (Tree : Gtk.Tree_Store.Gtk_Tree_Store; Gtkada_Demos : Boolean := False; Pixbuf_Demos : Boolean := False) is Sibling : Gtk_Tree_Iter := Null_Iter; Subtree : Gtk_Tree_Iter := Null_Iter; Frame_Num : Integer := 1; begin for Typ in Demo_Type'Range loop if ((not Gtkada_Demos) and then not Pixbuf_Demos and then Typ /= Gtkada and then Typ /= Pixbuf) or else (Gtkada_Demos and then Typ = Gtkada) or else (Pixbuf_Demos and then Typ = Pixbuf) then Append (Tree_Store => Tree, Iter => Sibling, Parent => Null_Iter); case Typ is when Box => Set (Tree, Sibling, 0, "Containers"); when Base => Set (Tree, Sibling, 0, "Base widgets"); when Complex => Set (Tree, Sibling, 0, "Composite widgets"); when Gimp => Set (Tree, Sibling, 0, "Gimp widgets"); when Misc => Set (Tree, Sibling, 0, "Misc. demos"); when GdkD => Set (Tree, Sibling, 0, "Gdk demos"); when Gtkada => Set (Tree, Sibling, 0, "GtkAda widgets"); Frame_Num := 2; when Pixbuf => Set (Tree, Sibling, 0, "Images"); Frame_Num := 3; end case; Set (Tree, Sibling, 1, 0); Set (Tree, Sibling, 2, 0); for Item_Num in Gtk_Demos'Range loop if Gtk_Demos (Item_Num).Typ = Typ and then Gtk_Demos (Item_Num).Func /= null then Append (Tree_Store => Tree, Iter => Subtree, Parent => Sibling); Set (Tree, Subtree, 0, Gtk_Demos (Item_Num).Label.all); Set (Tree, Subtree, 1, Gint (Item_Num)); Set (Tree, Subtree, 2, Gint (Frame_Num)); end if; end loop; end if; end loop; end Fill_Gtk_Tree; ------------------ -- Destroy_Help -- ------------------ procedure Destroy_Help (Button : access Gtk_Widget_Record'Class) is pragma Warnings (Off, Button); begin Destroy (Help_Dialog); Help_Dialog := null; end Destroy_Help; ------------------ -- Display_Help -- ------------------ procedure Display_Help (Button : access Gtk_Widget_Record'Class) is Close : Gtk.Button.Gtk_Button; Scrolled : Gtk_Scrolled_Window; Label : Gtk.Label.Gtk_Label; View : Gtk_Text_View; Iter, Last : Gtk_Text_Iter; Blue_Tag, Tag : Gtk_Text_Tag; Mark : Gtk_Text_Mark; pragma Unreferenced (Button); procedure Show_Text_With_Tag (Iter : in out Gtk_Text_Iter; Text : String); -- Insert Text in the help dialog, using Tag to set the color procedure Show_Text_With_Tag (Iter : in out Gtk_Text_Iter; Text : String) is Last : Gtk_Text_Iter; begin if Mark /= null then Move_Mark (Help_Text, Mark, Iter); else Mark := Create_Mark (Help_Text, "", Iter); end if; Insert (Help_Text, Iter, Text); if Tag /= null then Get_Iter_At_Mark (Help_Text, Last, Mark); Apply_Tag (Help_Text, Tag, Last, Iter); end if; end Show_Text_With_Tag; begin if Help_Dialog = null then Gtk_New (Help_Dialog); Set_Policy (Help_Dialog, Allow_Shrink => True, Allow_Grow => True, Auto_Shrink => True); Set_Title (Help_Dialog, "testgtk help"); Set_Default_Size (Help_Dialog, 640, 450); Set_Spacing (Get_Vbox (Help_Dialog), 3); Gtk_New (Label, "Information on this demo"); Pack_Start (Get_Vbox (Help_Dialog), Label, False, True, 0); Gtk_New (Scrolled); Pack_Start (Get_Vbox (Help_Dialog), Scrolled, True, True, 0); Set_Policy (Scrolled, Policy_Automatic, Policy_Automatic); Gtk_New (Help_Text); Gtk_New (View, Help_Text); Add (Scrolled, View); Set_Editable (View, False); Set_Wrap_Mode (View, Wrap_Mode => Wrap_Word); Gtk_New (Close, "Close"); Pack_Start (Get_Action_Area (Help_Dialog), Close, False, False); Widget_Handler.Object_Connect (Close, "clicked", Widget_Handler.To_Marshaller (Destroy_Help'Access), Slot_Object => Help_Dialog); Set_Flags (Close, Can_Default); Grab_Default (Close); Blue_Tag := Create_Tag (Help_Text, "blue"); Set_Property (Blue_Tag, Gtk.Text_Tag.Foreground_Property, "blue"); else Get_Start_Iter (Help_Text, Iter); Get_End_Iter (Help_Text, Last); Delete (Help_Text, Iter, Last); Blue_Tag := Lookup (Get_Tag_Table (Help_Text), "blue"); end if; Get_Start_Iter (Help_Text, Iter); Tag := null; if Current_Help = null then Insert (Help_Text, Iter, "No help available"); else declare Help : constant String := Current_Help.all; Pos : Natural := Help'First; First : Natural; Blue : Gdk_Color; Newline : constant String := (1 => ASCII.LF); Line_End : Natural; -- Points to the first character of the next line begin Set_Rgb (Blue, 16#0#, 16#0#, 16#FFFF#); Alloc (Get_Default_Colormap, Blue); loop -- The end of the line can be at most Max_Length character, -- finishing at the first previous white space. Stops at the -- first Newline encountered if any Line_End := Help'Last + 1; First := Ada.Strings.Fixed.Index (Help (Pos .. Line_End - 1), Newline); if First /= 0 then Line_End := First; end if; -- Scan and print the line while Pos < Line_End loop -- Any special sections to highlight ? First := Ada.Strings.Fixed.Index (Help (Pos .. Line_End - 1), "@"); if First = 0 or First = Line_End - 1 then Show_Text_With_Tag (Iter, Help (Pos .. Line_End - 1)); Pos := Line_End; else Show_Text_With_Tag (Iter, Help (Pos .. First - 1)); case Help (First + 1) is when 'b' => Tag := Blue_Tag; Pos := First + 2; when 'B' => Tag := null; Pos := First + 2; when others => Show_Text_With_Tag (Iter, "@"); Pos := First + 1; end case; end if; end loop; Pos := Pos + 1; exit when Pos > Help'Last; Insert (Help_Text, Iter, Newline); end loop; end; end if; Show_All (Help_Dialog); end Display_Help; ----------------- -- Exit_Main -- ----------------- procedure Exit_Main (Object : access Gtk_Widget_Record'Class) is begin Destroy (Object); Gtk.Main.Main_Quit; end Exit_Main; ------------------ -- Delete_Event -- ------------------ function Delete_Event (Object : access Gtk_Widget_Record'Class) return Boolean is pragma Unreferenced (Object); begin -- We could return True to force the user to kill the window through the -- "Quit" button, as opposed to the icon in the title bar. return False; end Delete_Event; -------------- -- Set_Help -- -------------- procedure Set_Help (Func : Help_Function) is begin Current_Help := Func; if Help_Dialog /= null then declare W : aliased Gtk_Widget_Record; begin Display_Help (W'Access); end; end if; end Set_Help; ----------------------- -- Tree_Select_Child -- ----------------------- procedure Tree_Select_Child (View : access Gtk_Widget_Record'Class) is Model : Gtk_Tree_Model; Iter : Gtk_Tree_Iter; Demo_Num : Integer; Frame_Num : Integer; Child : Gtk_Widget; begin Get_Selected (Get_Selection (Gtk_Tree_View (View)), Model, Iter); if Iter = Null_Iter then return; end if; Demo_Num := Integer (Get_Int (Model, Iter, 1)); Frame_Num := Integer (Get_Int (Model, Iter, 2)); if Demo_Num /= 0 and then Gtk_Demos (Demo_Num).Func /= null then -- Remove the current demo from the frame Child := Get_Child (Gtk_Demo_Frames (Frame_Num)); if Child /= null then Remove (Gtk_Demo_Frames (Frame_Num), Child); end if; -- And then insert our own new demo Gtk_Demos (Demo_Num).Func (Gtk_Demo_Frames (Frame_Num)); Set_Help (Gtk_Demos (Demo_Num).Help); end if; end Tree_Select_Child; ------------- -- Gtk_New -- ------------- procedure Gtk_New (Win : out Main_Window) is begin Win := new Main_Window_Record; Initialize (Win); end Gtk_New; ----------------- -- OpenGL_Help -- ----------------- function Opengl_Help return String is begin return "This demo shows how you can use GtkAda to display an @bOpenGL@B" & " widget. GtkAda provides a special window in which you can display" & " any kind of OpenGL drawing." & ASCII.LF & "GtkAda comes with a very basic binding to OpenGL (@bMesa@B), but" & " you can use any binding you want, including win32 on Windows." & ASCII.LF & ASCII.LF & "To use this demo, try moving the demo with: " & ASCII.LF & " - Left mouse button: rotate the drawing." & ASCII.LF & " - Middle mouse button: zoom the drawing."; end Opengl_Help; ----------------- -- Switch_Page -- ----------------- procedure Switch_Page (Notebook : access Gtk_Notebook_Record'Class; Page : Gtk.Gtk_Notebook_Page; User : Gtk_Notebook) is pragma Warnings (Off, Page); pragma Warnings (Off, User); begin if Get_Current_Page (Notebook) = 3 then Set_Help (Opengl_Help'Access); else Set_Help (null); end if; end Switch_Page; ----------------------- -- Create_Demo_Frame -- ----------------------- procedure Create_Demo_Frame (Win : access Main_Window_Record'Class; Page : Integer; Title : String; Gtkada_Demo, Pixbuf_Demo : Boolean) is Frame : Gtk.Frame.Gtk_Frame; Label : Gtk.Label.Gtk_Label; Tree : Gtk_Tree_View; Model : Gtk_Tree_Store; Scrolled : Gtk_Scrolled_Window; Paned : Gtk_Paned; Render : Gtk_Cell_Renderer_Text; Col : Gtk_Tree_View_Column; C : Gint; pragma Unreferenced (C); begin Gtk_New (Frame); Gtk_New (Label, Title); Append_Page (Win.Notebook, Child => Frame, Tab_Label => Label); Gtk_New_Hpaned (Paned); Add (Frame, Paned); Gtk_New (Scrolled); Set_Policy (Scrolled, Gtk.Enums.Policy_Automatic, Gtk.Enums.Policy_Always); Pack1 (Paned, Scrolled); Gtk_New (Model, (1 => GType_String, 2 => GType_Int, 3 => GType_Int)); Gtk_New (Tree, Model); Set_Headers_Visible (Tree, False); Modify_Font (Tree, From_String ("Sans 8")); Gtk_New (Render); Gtk_New (Col); C := Append_Column (Tree, Col); Pack_Start (Col, Render, Expand => True); Add_Attribute (Col, Render, "text", 0); Set_Mode (Get_Selection (Tree), Gtk.Enums.Selection_Single); Add_With_Viewport (Scrolled, Tree); Fill_Gtk_Tree (Model, Gtkada_Demo, Pixbuf_Demo); Widget_Callback.Object_Connect (Get_Selection (Tree), Gtk.Tree_Selection.Signal_Changed, Tree_Select_Child'Access, Slot_Object => Tree); Gtk_New (Gtk_Demo_Frames (Page)); Set_Shadow_Type (Gtk_Demo_Frames (Page), The_Type => Gtk.Enums.Shadow_None); Pack2 (Paned, Gtk_Demo_Frames (Page)); Set_Position (Paned, 170); end Create_Demo_Frame; ---------------- -- Initialize -- ---------------- procedure Initialize (Win : access Main_Window_Record'Class) is Frame : Gtk.Frame.Gtk_Frame; Label : Gtk.Label.Gtk_Label; Vbox : Gtk.Box.Gtk_Box; Style : Gtk_Style; Button : Gtk.Button.Gtk_Button; Bbox : Gtk.Hbutton_Box.Gtk_Hbutton_Box; begin Gtk.Window.Initialize (Win, Gtk.Enums.Window_Toplevel); Set_Default_Size (Win, 800, 600); Window_Cb.Connect (Win, "destroy", Window_Cb.To_Marshaller (Exit_Main'Access)); Return_Window_Cb.Connect (Win, "delete_event", Return_Window_Cb.To_Marshaller (Delete_Event'Access)); -- The global box Gtk_New_Vbox (Vbox, Homogeneous => False, Spacing => 0); Add (Win, Vbox); -- Label Style := Copy (Get_Style (Win)); Set_Font_Description (Style, From_String ("Helvetica Bold 18")); Gtk_New (Label, "GtkAda, the portable Ada95 GUI"); Set_Style (Label, Style); Pack_Start (Vbox, Label, Expand => False, Fill => False, Padding => 10); -- Notebook creation Gtk_New (Win.Notebook); Pack_Start (Vbox, Win.Notebook, Expand => True, Fill => True); Notebook_Cb.Connect (Win.Notebook, "switch_page", Notebook_Cb.To_Marshaller (Switch_Page'Access), Win.Notebook, After => True); -- First page: Gtk demos Create_Demo_Frame (Win, 1, "Gtk demo", False, False); Create_Demo_Frame (Win, 2, "GtkAda demo", True, False); Create_Demo_Frame (Win, 3, "Image manipulation", False, True); -- Fourth page: OpenGL demos Gtk_New (Frame); Gtk_New (Label, "OpenGL demo"); Append_Page (Win.Notebook, Frame, Label); View_Gl.Run (Frame); -- Button box for the buttons at the bottom -- Gtk_New_Hbox (Bbox, Homogeneous => True, Spacing => 10); Gtk_New (Bbox); Set_Layout (Bbox, Buttonbox_Spread); Set_Spacing (Bbox, 40); Gtk_New (Button, "Help on current demo"); Pack_Start (Bbox, Button, Expand => True, Fill => False); Widget_Handler.Connect (Button, "clicked", Widget_Handler.To_Marshaller (Display_Help'Access)); Gtk_New (Button, "Quit"); Pack_Start (Bbox, Button, Expand => True, Fill => False); Window_Cb.Object_Connect (Button, "clicked", Window_Cb.To_Marshaller (Exit_Main'Access), Win); Pack_End (Vbox, Bbox, Expand => False, Padding => 5); -- Display everything Show_All (Vbox); end Initialize; end Main_Windows;