ncurses 4.1
[ncurses.git] / Ada95 / ada_include / terminal_interface-curses-forms-choice_field_types.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                           GNAT ncurses Binding                           --
4 --                                                                          --
5 --              Terminal_Interface.Curses.Forms.Choice_Field_Types          --
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.5 $
26 ------------------------------------------------------------------------------
27 with Interfaces.C;
28 with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
29 with Terminal_Interface.Curses.Forms.Field_Types;
30
31 --  |
32 --  |=====================================================================
33 --  | man page form_fieldtype.3x
34 --  |=====================================================================
35 --  |
36 package body Terminal_Interface.Curses.Forms.Choice_Field_Types is
37
38    use type Interfaces.C.int;
39
40    package Ft is new Terminal_Interface.Curses.Forms.Field_Types
41      (User, User_Access, Field_Check, Character_Check);
42
43    type N_Check is access
44       function (Fld : Field; Info : User_Access) return Boolean;
45    pragma Convention (C, N_Check);
46
47    type P_Check is access
48       function (Fld : Field; Info : User_Access) return Boolean;
49    pragma Convention (C, P_Check);
50
51    function Nc (Fld : Field; Info : User_Access) return Boolean;
52    pragma Convention (C, Nc);
53
54    function Pc (Fld : Field; Info : User_Access) return Boolean;
55    pragma Convention (C, Pc);
56
57    function Nc (Fld : Field; Info : User_Access) return Boolean
58    is
59    begin
60       return Next_Choice (Fld, Info);
61    end Nc;
62
63    function Pc (Fld : Field; Info : User_Access) return Boolean
64    is
65    begin
66       return Prev_Choice (Fld, Info);
67    end Pc;
68    --  |
69    --  |
70    --  |
71    function Set_Choice (Ft : C_Field_Type;
72                         Nc : N_Check;
73                         Pc : P_Check) return C_Int;
74    pragma Import (C, Set_Choice, "set_fieldtype_choice");
75
76    procedure Define_Choices
77    is
78       R : Eti_Error;
79    begin
80       R := Set_Choice (Search_Type (User'Tag), Nc'Access, Pc'Access);
81       if (R /= E_OK) then
82          Eti_Exception (R);
83       end if;
84    end Define_Choices;
85
86 begin
87    Define_Choices;
88 end Terminal_Interface.Curses.Forms.Choice_Field_Types;