-------------------------------------------------------------------
--           RAPID - RAPID ADA PORTABLE INTERFACE DESIGNER         
--           TCL PEER FOR THE MCC GUI PACKAGE LIBRARY 
--           Copyright (C) 1999 Martin C. Carlisle.                
--                                                                 
-- RAPID is free software;  you can  redistribute it  and/or modify
-- it under terms of the  GNU General Public License as published  
-- by the Free Software  Foundation;  either version 2,  or (at your
-- option) any later version.  RAPID 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
-- distributed with RAPID; see file COPYING.  If not, write to the 
-- Free Software Foundation,  59 Temple Place - Suite 330,  Boston, 
-- MA 02111-1307, USA.                                                 
--                                                                     
-- As a special exception, if other files instantiate generics from
-- this unit, or you link this unit with other files to produce an 
-- executable, this unit does not by itself cause the resulting 
-- executable to be covered by the GNU General Public License.  
-- This exception does not however invalidate any other reasons 
-- why the executable file might be covered by the GNU Public 
-- License.  This exception does not apply to executables which
-- are GUI design tools, or that could act as a replacement
-- for RAPID.
----------------------------------------------------------------------
-- Adapted from Ch. 7 of "Graphical Applications with Tcl & Tk"
-- by Eric Foster-Johnson
----------------------------------------------------------------------
-- Change log:
----------------------------------------------------------------------
with Ada.Unchecked_Conversion;
with ada.exceptions;
with mcc.common_dialogs;
package body Mcc.Gui.Widget.Dropdown is
   Initialized : Boolean := False;
   procedure Initialize;
   
   ---------------
   -- Add_Entry --
   ---------------

   procedure Add_Entry
     (Obj      : in out Dropdown;
      Location : in     Natural;
      Text     : in     String)
   is
   begin
      Peer.Eval(Obj.My_Peer.Name.all & ".top.frame.list insert " &
         integer'image(location) & " """ &
         Peer.Fix_Quotes(Text) & '"');
   end Add_Entry;

   -----------
   -- Clear --
   -----------

   procedure Clear (Obj  : in out Dropdown) is
   begin
      Peer.Eval(Obj.My_Peer.Name.all & ".top.frame.list delete 0 end");
   end Clear;

   -----------
   -- Count --
   -----------

   function Count (Obj : in Dropdown) return Natural is
      Result : Integer;
   begin
      Peer.Eval(
         "set index [" &
         Obj.My_Peer.Name.all & ".top.frame.list" &
         " index end]");
      Peer.Get_Value(
         Name   => "index",
         Result => Result);
      return Result;
   exception
      when others => return 0;
   end Count;

   ------------
   -- Create --
   ------------

   procedure Create
     (Obj                  : in out Dropdown;
      Parent               : in     Mcc.Gui.Container.Container'Class;
      X                    : in     Integer;
      Y                    : in     Integer;
      Width                : in     Natural;
      Height               : in     Natural;
      Number_Rows          : in     Natural)
   is
      type Parent_Access is access constant Mcc.Gui.Container.Container'Class;
      function Convert is new Ada.Unchecked_Conversion(
         Parent_Access,Mcc.Gui.Container.Container_Pointer);
   begin
      if not Initialized then
         Initialize;
         Initialized := True;
      end if;
      
      Obj.My_Peer := Peer.Create_Peer(Mcc.Gui.Container.Get_Peer(Parent));
      Peer.Eval("DropListCreate " & Obj.My_Peer.Name.all &
         " """" " & integer'image(width) & integer'image(Number_Rows) &
         " " &
         Peer.Undot_Name(Obj.My_Peer.Name.all) & " """" ");

      Peer.Eval("place " & Obj.My_Peer.Name.all &
         " -anchor nw" &
         " -x " & Integer'Image(X) &
         " -y " & Integer'Image(Y) &
         " -width" & Integer'Image(Width) &
         " -height" & Integer'Image(Height));

      -- Since most of window is subwidget, set its bindings to
      -- that of parent.  This greatly simplifies the implementation
      -- of mouse and key bindings in mcc.gui
      Peer.Eval("bindtags " & Obj.My_Peer.Name.all & 
         ".ent ""[bindtags " & Obj.My_Peer.Name.all & 
         ".ent] " &
         Obj.My_Peer.Name.all & """");
      Obj.Parent := Convert(Parent'Unchecked_Access);
   end Create;

   ------------------------------------------------
   -- procedure Delete_Entry
   --
   -- Delete a range of entries
   ------------------------------------------------
   procedure Delete_Entry(
      Obj   : in out Dropdown;
      Start : in     Natural;
      Stop  : in     Natural) is
   begin
      Peer.Eval(Obj.My_Peer.Name.all & ".top.frame.list delete " &
         integer'image(start-1) & integer'image(stop-1));
   end Delete_Entry;

   ------------------
   -- Get_Selected --
   ------------------

   function Get_Selected (Obj : in Dropdown) return Natural is
      Result : Integer;
      SResult : String(1..50);
      Last : natural;
   begin
      Peer.Eval(
         "set index [" &
         Obj.My_Peer.Name.all & ".top.frame.list" &
         " curselection]");
      Peer.Get_Value(
         Name   => "index",
         Result => Result);
      return Result + 1;
   exception
      when e:others => 
         return 0;
   end Get_Selected;

   -----------------
   -- Select_Item --
   -----------------

   procedure Select_Item
     (Obj    : in out Dropdown;
      Number : in     Natural)
   is
   begin
      Peer.Eval(Obj.My_Peer.Name.all & ".top.frame.list selection clear 0 end ");
      Peer.Eval(Obj.My_Peer.Name.all & ".top.frame.list selection set " &
         integer'image(number-1));
      Peer.Eval(
         "catch {" & ASCII.LF &
            "set selected [list_selected " & Obj.My_Peer.Name.all &
            ".top.frame.list]" & ASCII.LF &

             "if { $selected != """" } {" & ASCII.LF &
             --
             -- Put item into entry widget.
             --
             Obj.My_Peer.Name.all & 
             ".ent configure -state normal" & ASCII.LF &
             Obj.My_Peer.Name.all & 
             ".ent delete 0 end" & ASCII.LF &
             Obj.My_Peer.Name.all & 
             ".ent insert 0 ""$selected""" & ASCII.LF &
             Obj.My_Peer.Name.all & 
             ".ent configure -state disabled" & ASCII.LF & 
         "}" & ASCII.LF &
         "}");
   end Select_Item;

procedure Initialize is
begin
-- Drop-down list code.
--
-- The main procedure to use is DropListCreate.
-- The test_drop_list procedure shows how to use
-- the drop list. The rest of the procedures are
-- private to the drop list.
--

-- Creates a drop-down list and a few interface widgets
-- (label, entry and drop-button) from your supplied basename.
--
-- basename = base name for frame that holds entry widget.
-- text = text for label widget.
-- height = number of visible lines in list.
-- width = number of columns in list and entry widget.
-- variable = name of variable that gets the selected value.
-- initial_value = first value.
--
-- Returns name of actual listbox widget, 
-- so you can fill in the listbox.
--
Peer.Eval("proc DropListCreate { " & ASCII.LF &
    "basename text width height variable initial_value } {" &
    "upvar #0 $variable var" & ASCII.LF &
    "set var ""$initial_value""" & ASCII.LF &

    -- Name of top-level widget to create.
    "set top $basename.top" & ASCII.LF &

    --
    -- Widgets to enter data.
    --
    "frame $basename -bd 0" & ASCII.LF &
    "label $basename.lbl -text $text -anchor e" & ASCII.LF &
    "entry $basename.ent -width $width -state disabled" & ASCII.LF &
    "$basename.ent insert 0 ""$initial_value""" & ASCII.LF &
    "DropButton $basename.drop $basename.top $basename.ent" & ASCII.LF &

    "bind $basename.ent <Return> " &
        """DropListSetVal $basename.ent $variable""" & ASCII.LF &
 
    "bind $basename.ent <Key-Escape> ""wm withdraw $top""" & ASCII.LF &

    "pack $basename.lbl -side left -fill y" & ASCII.LF &
    "pack $basename.drop -side right -fill y" & ASCII.LF &
    "pack $basename.ent -side left -expand 1 -fill y" & ASCII.LF &

    --
    -- Drop-list is a top-level temporary window.
    --
    "toplevel $top -cursor top_left_arrow" & ASCII.LF &
    "wm overrideredirect $top 1" & ASCII.LF &
    "wm withdraw $top " & ASCII.LF &

    -- Create list
    "set frm $top.frame" & ASCII.LF &
    "frame $frm -bd 4 -relief sunken -width $width" & ASCII.LF &

    -- export selection 0 allows me to have more than 1
    "listbox $frm.list -height $height " &
        "-selectmode single -exportselection 0 " &
        "-yscrollcommand ""$frm.scrollbar set"" " & ASCII.LF &

    "bind $frm.list <Key-Escape> ""wm withdraw $top""" & ASCII.LF &

    -- Create scrollbar
    "scrollbar $frm.scrollbar " &
        "-command ""$frm.list yview"" " & ASCII.LF &

    "pack $frm.scrollbar -side right -fill y" & ASCII.LF &
    "pack $frm.list      -side left " & ASCII.LF &
    "pack $frm -side top " & ASCII.LF &

    "bind $frm.list <ButtonRelease-1> " &
        """DropListClick $top $basename.ent $variable""" & ASCII.LF &

"}");

-- Returns selected item for a single-select list.
Peer.Eval("proc list_selected { listname } {" & ASCII.LF &
    "set indx [$listname curselection]" & ASCII.LF &

    "if { $indx != """" } {" & ASCII.LF &
        "set item [$listname get $indx]" & ASCII.LF &

        "return $item" & ASCII.LF &
    "} else {" & ASCII.LF &
        "return """";" & ASCII.LF &
    "}" & ASCII.LF &
"}");



-- Places value in global variable.
Peer.Eval("proc DropListSetVal { entry variable } {" & ASCII.LF &
    "upvar #0 $variable var" & ASCII.LF &

    "set value [$entry get]" & ASCII.LF &

    "if { $value != """" } {" & ASCII.LF &
        "set var $value" & ASCII.LF &
    "}" & ASCII.LF &

"}");

-- Handles click on drop list widget.
Peer.Eval("proc DropListClick { basename entry variable } {" & ASCII.LF &

    "catch {" & ASCII.LF &
        "set selected [list_selected $basename.frame.list]" & ASCII.LF &

        "if { $selected != """" } {" & ASCII.LF &
            --
            -- Put item into entry widget.
            --
            "$entry configure -state normal" & ASCII.LF &
            "$entry delete 0 end" & ASCII.LF &
            "$entry insert 0 ""$selected""" & ASCII.LF &
            "$entry configure -state disabled" & ASCII.LF &

            "DropListSetVal $entry $variable" & ASCII.LF &
        "}" & ASCII.LF &
    "}" & ASCII.LF &

    "wm withdraw $basename" & ASCII.LF &
"}");



-- Makes drop list visible. Create with DropListCreate.
Peer.Eval("proc ShowDropList { basename associated_widget } {" & ASCII.LF &
    "set x [winfo rootx $associated_widget]" & ASCII.LF &
    "set y [winfo rooty $associated_widget]" & ASCII.LF &
    "set y [expr $y + [winfo height $associated_widget]]" & ASCII.LF &

    "wm geometry $basename ""+$x+$y""" & ASCII.LF &
    "update" & ASCII.LF &
    "wm deiconify $basename" & ASCII.LF &
    "raise $basename" & ASCII.LF &

    "focus $basename.frame.list " & ASCII.LF &
"}");


-- Creates a button with a drop-down bitmap.
Peer.Eval("proc DropButton { name toplevel entry } {" & ASCII.LF &

    "button $name -image dnarrow " &
    "-command ""ShowDropList $toplevel $entry""" & ASCII.LF &

    "return $name" & ASCII.LF &
"}");

--
-- Bitmap data for down arrow bitmap.
--
Peer.Eval("set dnarrow_data """ & ASCII.LF &
"#define dnarrow2_width 18" & ASCII.LF &
"#define dnarrow2_height 18" & ASCII.LF &
"static unsigned char dnarrow2_bits[] = {" & ASCII.LF &
   "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x00, 0xf8, 0x7f, 0x00," & ASCII.LF &
   "0xf8, 0x7f, 0x00, 0xf0, 0x3f, 0x00, 0xf0, 0x3f, 0x00, 0xe0, 0x1f, 0x00," & ASCII.LF &
   "0xc0, 0x0f, 0x00, 0xc0, 0x0f, 0x00, 0x80, 0x07, 0x00, 0x80, 0x07, 0x00," & ASCII.LF &
   "0x00, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x00," & ASCII.LF &
   "0xfc, 0xff, 0x00, 0x00, 0x00, 0x00};" & ASCII.LF &
"""" & ASCII.LF &
"image create bitmap dnarrow -data $dnarrow_data");
end Initialize;

end Mcc.Gui.Widget.Dropdown;
