ncurses 4.1
[ncurses.git] / Ada95 / samples / sample-form_demo.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                       GNAT ncurses Binding Samples                       --
4 --                                                                          --
5 --                             Sample.Form_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 Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
28 with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
29
30 with Terminal_Interface.Curses; use Terminal_Interface.Curses;
31 with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
32 with Terminal_Interface.Curses.Forms; use Terminal_Interface.Curses.Forms;
33 with Terminal_Interface.Curses.Forms.Field_User_Data;
34 with Terminal_Interface.Curses.Forms.Form_User_Data;
35
36 with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
37 with Sample.My_Field_Type; use Sample.My_Field_Type;
38 with Sample.Manifest; use Sample.Manifest;
39 with Sample.Explanation; use Sample.Explanation;
40 with Sample.Form_Demo.Aux; use Sample.Form_Demo.Aux;
41 with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
42 with Sample.Form_Demo.Handler;
43
44 package body Sample.Form_Demo is
45
46    type User_Data is
47       record
48          Data : Integer;
49       end record;
50    type User_Access is access User_Data;
51
52    package Fld_U is new
53      Terminal_Interface.Curses.Forms.Field_User_Data (User_Data,
54                                                       User_Access);
55
56    package Frm_U is new
57      Terminal_Interface.Curses.Forms.Form_User_Data (User_Data,
58                                                      User_Access);
59
60    Enums : constant Enum_Array := (new String'("alpha"),
61                                    new String'("beta"),
62                                    new String'("gamma"));
63
64    Enum_Info : constant Enumeration_Info := (Enums'Length, Enums,
65                                              False, False);
66
67    Enum_Field : constant Enumeration_Field := Create (Enum_Info, True);
68
69    procedure Demo
70    is
71
72       Mft : My_Data := (Ch => 'X');
73
74       FA : Field_Array (1 .. 9) := (Make (0, 14, "Sample Entry Form"),
75                                     Make (2, 0,  "An Enumeration"),
76                                     Make (2, 20, "Numeric 1-10"),
77                                     Make (2, 34, "Only 'X'"),
78                                     Make (5, 0,
79                                           "Multiple Lines offscreen (Scroll)"),
80
81                                     Make (Width => 18, Top => 3, Left =>  0),
82                                     Make (Width => 12, Top => 3, Left => 20),
83                                     Make (Width => 12, Top => 3, Left => 34),
84                                     Make (Width => 46, Top => 6, Left =>  0,
85                                           Height => 4, Off_Screen => 2)
86                                     );
87
88       Frm : Terminal_Interface.Curses.Forms.Form := Create (FA);
89
90       I_F : constant Integer_Field := (Precision   => 0,
91                                        Lower_Limit => 1,
92                                        Upper_Limit => 10);
93
94       F1, F2 : User_Access;
95
96       package Fh is new Sample.Form_Demo.Handler (Default_Driver);
97
98    begin
99       Push_Environment ("FORM00");
100       Notepad ("FORM-PAD00");
101       Default_Labels;
102
103       Set_Type (FA (6), Enum_Field);
104       Set_Type (FA (7), I_F);
105       Set_Type (FA (8), Mft);
106
107       F1 := new User_Data'(Data => 4711);
108       Fld_U.Set_User_Data (FA (1), F1);
109
110       Fh.Drive_Me (Frm);
111
112       Fld_U.Get_User_Data (FA (1), F2);
113       pragma Assert (F1 = F2);
114       pragma Assert (F1.Data = F2.Data);
115
116       Pop_Environment;
117       Delete (Frm);
118
119       for I in FA'Range loop
120          Delete (FA (I));
121       end loop;
122    end Demo;
123
124 end Sample.Form_Demo;