Ada95/samples/sample-curses_demo.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                       GNAT ncurses Binding Samples                       --
   4 --                                                                          --
   5 --                            Sample.Curses_Demo                            --
   6 --                                                                          --
   7 --                                 B O D Y                                  --
   8 --                                                                          --
   9 --  Version 00.92                                                           --
  10 --                                                                          --
  11 --  The ncurses Ada95 binding is copyrighted 1996 by                        --
  12 --  Juergen Pfeifer, Email: Juergen.Pfeifer@T-Online.de                     --
  13 --                                                                          --
  14 --  Permission is hereby granted to reproduce and distribute this           --
  15 --  binding by any means and for any fee, whether alone or as part          --
  16 --  of a larger distribution, in source or in binary form, PROVIDED         --
  17 --  this notice is included with any such distribution, and is not          --
  18 --  removed from any of its header files. Mention of ncurses and the        --
  19 --  author of this binding in any applications linked with it is            --
  20 --  highly appreciated.                                                     --
  21 --                                                                          --
  22 --  This binding comes AS IS with no warranty, implied or expressed.        --
  23 ------------------------------------------------------------------------------
  24 --  Version Control
  25 --  $Revision: 1.2 $
  26 ------------------------------------------------------------------------------
  27 with Terminal_Interface.Curses; use Terminal_Interface.Curses;
  28 with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus;
  29 with Terminal_Interface.Curses.Mouse;  use Terminal_Interface.Curses.Mouse;
  30 with Terminal_Interface.Curses.Panels;  use Terminal_Interface.Curses.Panels;
  31 with Terminal_Interface.Curses.Panels.User_Data;
  32
  33 with Sample.Manifest; use Sample.Manifest;
  34 with Sample.Helpers; use Sample.Helpers;
  35 with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
  36 with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
  37 with Sample.Header_Handler; use Sample.Header_Handler;
  38 with Sample.Explanation; use Sample.Explanation;
  39
  40 with Sample.Menu_Demo.Handler;
  41 with Sample.Curses_Demo.Mouse;
  42 with Sample.Curses_Demo.Attributes;
  43
  44 package body Sample.Curses_Demo is
  45
  46    procedure Demo
  47    is
  48       function My_Driver (M : Menu;
  49                           K : Key_Code;
  50                           Pan : Panel) return Boolean;
  51       package Mh is new Sample.Menu_Demo.Handler (My_Driver);
  52
  53       Itm : constant Item_Array (1 .. 2) :=
  54         (New_Item ("Attributes Demo"),
  55          New_Item ("Mouse Demo"));
  56       M : Menu := New_Menu (Itm);
  57
  58       function My_Driver (M : Menu;
  59                           K : Key_Code;
  60                           Pan : Panel) return Boolean
  61       is
  62          Idx : constant Positive := Get_Index (Current (M));
  63       begin
  64          if K in User_Key_Code'Range then
  65             if K = QUIT then
  66                return True;
  67             elsif K = SELECT_ITEM then
  68                if Idx in Itm'Range then
  69                   Hide (Pan);
  70                   Update_Panels;
  71                end if;
  72                case Idx is
  73                   when 1 => Sample.Curses_Demo.Attributes.Demo;
  74                   when 2 => Sample.Curses_Demo.Mouse.Demo;
  75                   when others => Not_Implemented;
  76                end case;
  77                if Idx in Itm'Range then
  78                   Top (Pan);
  79                   Show (Pan);
  80                   Update_Panels;
  81                   Update_Screen;
  82                end if;
  83             end if;
  84          end if;
  85          return False;
  86       end My_Driver;
  87
  88    begin
  89
  90       if Item_Count (M) /= Itm'Length then
  91          raise Constraint_Error;
  92       end if;
  93
  94       if not Has_Key (Key_Mouse) then
  95          declare
  96             O : Item_Option_Set;
  97          begin
  98             Get_Options (Itm (2), O);
  99             O.Selectable := False;
 100             Set_Options (Itm (2), O);
 101          end;
 102       end if;
 103
 104       Push_Environment ("CURSES00");
 105       Notepad ("CURSES-PAD00");
 106       Default_Labels;
 107       Refresh_Soft_Label_Keys_Without_Update;
 108
 109       Mh.Drive_Me (M, " Demo ");
 110       Pop_Environment;
 111
 112       Delete (M);
 113
 114    end Demo;
 115
 116 end Sample.Curses_Demo;