ncurses 4.1
[ncurses.git] / Ada95 / samples / sample-curses_demo-mouse.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                       GNAT ncurses Binding Samples                       --
4 --                                                                          --
5 --                         Sample.Curses_Demo.Mouse                         --
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.4 $
26 ------------------------------------------------------------------------------
27 with Terminal_Interface.Curses; use Terminal_Interface.Curses;
28 with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
29 with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
30 with Terminal_Interface.Curses.Text_IO; use Terminal_Interface.Curses.Text_IO;
31 with Terminal_Interface.Curses.Text_IO.Integer_IO;
32 with Terminal_Interface.Curses.Text_IO.Enumeration_IO;
33
34 with Sample.Helpers; use Sample.Helpers;
35 with Sample.Manifest; use Sample.Manifest;
36 with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
37 with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
38 with Sample.Explanation; use Sample.Explanation;
39
40 package body Sample.Curses_Demo.Mouse is
41
42    package Int_IO is new
43      Terminal_Interface.Curses.Text_IO.Integer_IO (Integer);
44    use Int_IO;
45
46    package Button_IO is new
47      Terminal_Interface.Curses.Text_IO.Enumeration_IO (Mouse_Button);
48    use Button_IO;
49
50    package State_IO is new
51      Terminal_Interface.Curses.Text_IO.Enumeration_IO (Button_State);
52    use State_IO;
53
54    procedure Demo is
55
56       type Controls is array (1 .. 3) of Panel;
57
58       Frame : Window;
59       Msg   : Window;
60       Ctl   : Controls;
61       Pan   : Panel;
62       N     : constant Natural := Ctl'Length;
63       K     : Real_Key_Code;
64       V     : Cursor_Visibility := Invisible;
65       W     : Window;
66       Note  : Window;
67       Msg_L : constant Line_Count := 8;
68       Lins  : Line_Position := Lines;
69       Cols  : Column_Position;
70       Mask  : Event_Mask;
71       procedure Show_Mouse_Event;
72
73       procedure Show_Mouse_Event
74       is
75          Evt    : constant Mouse_Event := Get_Mouse;
76          Y      : Line_Position;
77          X      : Column_Position;
78          Button : Mouse_Button;
79          State  : Button_State;
80          W      : Window;
81       begin
82          Get_Event (Evt, Y, X, Button, State);
83          Put (Msg, "Event at");
84          Put (Msg, "  X=");    Put (Msg, Integer (X), 3);
85          Put (Msg, ", Y=");    Put (Msg, Integer (Y), 3);
86          Put (Msg, ", Btn=");  Put (Msg, Button, 10);
87          Put (Msg, ", Stat="); Put (Msg, State, 15);
88          for I in Ctl'Range loop
89             W := Get_Window (Ctl (I));
90             if Enclosed_In_Window (W, Evt) then
91                Transform_Coordinates (W, Y, X, From_Screen);
92                Put (Msg, ",Box(");
93                Put (Msg, Integer (I), 1); Put (Msg, ",");
94                Put (Msg, Integer (Y), 1); Put (Msg, ",");
95                Put (Msg, Integer (X), 1); Put (Msg, ")");
96             end if;
97          end loop;
98          New_Line (Msg);
99          Flush (Msg);
100          Update_Panels; Update_Screen;
101       end Show_Mouse_Event;
102
103    begin
104       Push_Environment ("MOUSE00");
105       Notepad ("MOUSE-PAD00");
106       Default_Labels;
107       Set_Cursor_Visibility (V);
108
109       Note  := Notepad_Window;
110       if Note /= Null_Window then
111          Get_Window_Position (Note, Lins, Cols);
112       end if;
113       Frame := Create (Msg_L, Columns, Lins - Msg_L, 0);
114       if Has_Colors then
115          Set_Background (Win => Frame,
116                          Ch => (Color => Default_Colors,
117                                 Attr  => Normal_Video,
118                                 Ch    => ' '));
119          Set_Character_Attributes (Win   => Frame,
120                                    Attr  => Normal_Video,
121                                    Color => Default_Colors);
122          Erase (Frame);
123       end if;
124       Msg   := Derived_Window (Frame, Msg_L - 2, Columns - 2, 1, 1);
125       Pan   := Create (Frame);
126
127       Set_Meta_Mode;
128       Set_KeyPad_Mode;
129       Mask := Start_Mouse;
130
131       Box (Frame);
132       Window_Title (Frame, "Mouse Protocol");
133       Refresh_Without_Update (Frame);
134       Allow_Scrolling (Msg, True);
135
136       declare
137          Middle_Column : constant Integer := Integer (Columns) / 2;
138          Middle_Index  : constant Natural := Ctl'First + (Ctl'Length / 2);
139          Width         : constant Column_Count := 5;
140          Height        : constant Line_Count   := 3;
141          Half          : constant Column_Count := Width / 2;
142          Space         : constant Column_Count := 3;
143          Position      : Integer;
144          W             : Window;
145       begin
146          for I in Ctl'Range loop
147             Position := (Integer (I) - Integer (Middle_Index)) *
148               Integer (Half + Space + Width) + Middle_Column;
149             W := Create (Height,
150                          Width,
151                          1,
152                          Column_Position (Position));
153             if Has_Colors then
154                Set_Background (Win => W,
155                                Ch => (Color => Menu_Back_Color,
156                                       Attr  => Normal_Video,
157                                       Ch    => ' '));
158                Set_Character_Attributes (Win   => W,
159                                          Attr  => Normal_Video,
160                                          Color => Menu_Fore_Color);
161                Erase (W);
162             end if;
163             Ctl (I) := Create (W);
164             Box (W);
165             Move_Cursor (W, 1, Half);
166             Put (W, Integer (I), 1);
167             Refresh_Without_Update (W);
168          end loop;
169       end;
170
171       Update_Panels; Update_Screen;
172
173       loop
174          K := Get_Key;
175          if K in Special_Key_Code'Range then
176             case K is
177                when QUIT_CODE     => exit;
178                when HELP_CODE     => Explain_Context;
179                when EXPLAIN_CODE  => Explain ("MOUSEKEYS");
180                when Key_Mouse     => Show_Mouse_Event;
181                when others        => null;
182             end case;
183          end if;
184       end loop;
185
186       for I in Ctl'Range loop
187          W := Get_Window (Ctl (I));
188          Clear (W);
189          Delete (Ctl (I));
190          Delete (W);
191       end loop;
192
193       Clear (Frame);
194       Delete (Pan);
195       Delete (Msg);
196       Delete (Frame);
197
198       Set_Cursor_Visibility (V);
199       End_Mouse;
200
201       Pop_Environment;
202       Update_Panels; Update_Screen;
203
204    end Demo;
205
206 end Sample.Curses_Demo.Mouse;
207