| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT ncurses Binding Samples -- |
| -- -- |
| -- Sample.Form_Demo.Aux -- |
| -- -- |
| -- B O D Y -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| -- Copyright (c) 1998,2004 Free Software Foundation, Inc. -- |
| -- -- |
| -- Permission is hereby granted, free of charge, to any person obtaining a -- |
| -- copy of this software and associated documentation files (the -- |
| -- "Software"), to deal in the Software without restriction, including -- |
| -- without limitation the rights to use, copy, modify, merge, publish, -- |
| -- distribute, distribute with modifications, sublicense, and/or sell -- |
| -- copies of the Software, and to permit persons to whom the Software is -- |
| -- furnished to do so, subject to the following conditions: -- |
| -- -- |
| -- The above copyright notice and this permission notice shall be included -- |
| -- in all copies or substantial portions of the Software. -- |
| -- -- |
| -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- |
| -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- |
| -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- |
| -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- |
| -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- |
| -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- |
| -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- |
| -- -- |
| -- Except as contained in this notice, the name(s) of the above copyright -- |
| -- holders shall not be used in advertising or otherwise to promote the -- |
| -- sale, use or other dealings in this Software without prior written -- |
| -- authorization. -- |
| ------------------------------------------------------------------------------ |
| -- Author: Juergen Pfeifer, 1996 |
| -- Version Control |
| -- $Revision: 1.16 $ |
| -- $Date: 2004/08/21 21:37:00 $ |
| -- Binding Version 01.00 |
| ------------------------------------------------------------------------------ |
| with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; |
| |
| with Sample.Manifest; use Sample.Manifest; |
| with Sample.Helpers; use Sample.Helpers; |
| with Sample.Keyboard_Handler; use Sample.Keyboard_Handler; |
| with Sample.Explanation; use Sample.Explanation; |
| |
| package body Sample.Form_Demo.Aux is |
| |
| procedure Geometry (F : in Form; |
| L : out Line_Count; -- Lines used for menu |
| C : out Column_Count; -- Columns used for menu |
| Y : out Line_Position; -- Proposed Line for menu |
| X : out Column_Position) -- Proposed Column for menu |
| is |
| begin |
| Scale (F, L, C); |
| |
| L := L + 2; -- count for frame at top and bottom |
| C := C + 2; -- " |
| |
| -- Calculate horizontal coordinate at the screen center |
| X := (Columns - C) / 2; |
| Y := 1; -- start always in line 1 |
| end Geometry; |
| |
| function Create (F : Form; |
| Title : String; |
| Lin : Line_Position; |
| Col : Column_Position) return Panel |
| is |
| W, S : Window; |
| L : Line_Count; |
| C : Column_Count; |
| Y : Line_Position; |
| X : Column_Position; |
| Pan : Panel; |
| begin |
| Geometry (F, L, C, Y, X); |
| W := New_Window (L, C, Lin, Col); |
| Set_Meta_Mode (W); |
| Set_KeyPad_Mode (W); |
| if Has_Colors then |
| Set_Background (Win => W, |
| Ch => (Ch => ' ', |
| Color => Default_Colors, |
| Attr => Normal_Video)); |
| Set_Character_Attributes (Win => W, |
| Color => Default_Colors, |
| Attr => Normal_Video); |
| Erase (W); |
| end if; |
| S := Derived_Window (W, L - 2, C - 2, 1, 1); |
| Set_Meta_Mode (S); |
| Set_KeyPad_Mode (S); |
| Box (W); |
| Set_Window (F, W); |
| Set_Sub_Window (F, S); |
| if Title'Length > 0 then |
| Window_Title (W, Title); |
| end if; |
| Pan := New_Panel (W); |
| Post (F); |
| return Pan; |
| end Create; |
| |
| procedure Destroy (F : in Form; |
| P : in out Panel) |
| is |
| W, S : Window; |
| begin |
| W := Get_Window (F); |
| S := Get_Sub_Window (F); |
| Post (F, False); |
| Erase (W); |
| Delete (P); |
| Set_Window (F, Null_Window); |
| Set_Sub_Window (F, Null_Window); |
| Delete (S); |
| Delete (W); |
| Update_Panels; |
| end Destroy; |
| |
| function Get_Request (F : Form; |
| P : Panel; |
| Handle_CRLF : Boolean := True) return Key_Code |
| is |
| W : constant Window := Get_Window (F); |
| K : Real_Key_Code; |
| Ch : Character; |
| begin |
| Top (P); |
| loop |
| K := Get_Key (W); |
| if K in Special_Key_Code'Range then |
| case K is |
| when HELP_CODE => Explain_Context; |
| when EXPLAIN_CODE => Explain ("FORMKEYS"); |
| when Key_Home => return F_First_Field; |
| when Key_End => return F_Last_Field; |
| when QUIT_CODE => return QUIT; |
| when Key_Cursor_Down => return F_Down_Char; |
| when Key_Cursor_Up => return F_Up_Char; |
| when Key_Cursor_Left => return F_Previous_Char; |
| when Key_Cursor_Right => return F_Next_Char; |
| when Key_Next_Page => return F_Next_Page; |
| when Key_Previous_Page => return F_Previous_Page; |
| when Key_Backspace => return F_Delete_Previous; |
| when Key_Clear_Screen => return F_Clear_Field; |
| when Key_Clear_End_Of_Line => return F_Clear_EOF; |
| when others => return K; |
| end case; |
| elsif K in Normal_Key_Code'Range then |
| Ch := Character'Val (K); |
| case Ch is |
| when CAN => return QUIT; -- CTRL-X |
| |
| when ACK => return F_Next_Field; -- CTRL-F |
| when STX => return F_Previous_Field; -- CTRL-B |
| when FF => return F_Left_Field; -- CTRL-L |
| when DC2 => return F_Right_Field; -- CTRL-R |
| when NAK => return F_Up_Field; -- CTRL-U |
| when EOT => return F_Down_Field; -- CTRL-D |
| |
| when ETB => return F_Next_Word; -- CTRL-W |
| when DC4 => return F_Previous_Word; -- CTRL-T |
| |
| when SOH => return F_Begin_Field; -- CTRL-A |
| when ENQ => return F_End_Field; -- CTRL-E |
| |
| when HT => return F_Insert_Char; -- CTRL-I |
| when SI => return F_Insert_Line; -- CTRL-O |
| when SYN => return F_Delete_Char; -- CTRL-V |
| when BS => return F_Delete_Previous; -- CTRL-H |
| when EM => return F_Delete_Line; -- CTRL-Y |
| when BEL => return F_Delete_Word; -- CTRL-G |
| when VT => return F_Clear_EOF; -- CTRL-K |
| |
| when SO => return F_Next_Choice; -- CTRL-N |
| when DLE => return F_Previous_Choice; -- CTRL-P |
| |
| when CR | LF => |
| if Handle_CRLF then |
| return F_New_Line; |
| else |
| return K; |
| end if; |
| when others => return K; |
| end case; |
| else |
| return K; |
| end if; |
| end loop; |
| end Get_Request; |
| |
| function Make (Top : Line_Position; |
| Left : Column_Position; |
| Text : String) return Field |
| is |
| Fld : Field; |
| C : constant Column_Count := Column_Count (Text'Length); |
| begin |
| Fld := New_Field (1, C, Top, Left); |
| Set_Buffer (Fld, 0, Text); |
| Switch_Options (Fld, (Active => True, others => False), False); |
| if Has_Colors then |
| Set_Background (Fld => Fld, Color => Default_Colors); |
| end if; |
| return Fld; |
| end Make; |
| |
| function Make (Height : Line_Count := 1; |
| Width : Column_Count; |
| Top : Line_Position; |
| Left : Column_Position; |
| Off_Screen : Natural := 0) return Field |
| is |
| Fld : constant Field := New_Field (Height, Width, Top, Left, Off_Screen); |
| begin |
| if Has_Colors then |
| Set_Foreground (Fld => Fld, Color => Form_Fore_Color); |
| Set_Background (Fld => Fld, Color => Form_Back_Color); |
| else |
| Set_Background (Fld, (Reverse_Video => True, others => False)); |
| end if; |
| return Fld; |
| end Make; |
| |
| function Default_Driver (F : Form; |
| K : Key_Code; |
| P : Panel) return Boolean |
| is |
| begin |
| if P = Null_Panel then |
| raise Panel_Exception; |
| end if; |
| if K in User_Key_Code'Range and then K = QUIT then |
| if Driver (F, F_Validate_Field) = Form_Ok then |
| return True; |
| end if; |
| end if; |
| return False; |
| end Default_Driver; |
| |
| function Count_Active (F : Form) return Natural |
| is |
| N : Natural := 0; |
| O : Field_Option_Set; |
| H : constant Natural := Field_Count (F); |
| begin |
| if H > 0 then |
| for I in 1 .. H loop |
| Get_Options (Fields (F, I), O); |
| if O.Active then |
| N := N + 1; |
| end if; |
| end loop; |
| end if; |
| return N; |
| end Count_Active; |
| |
| end Sample.Form_Demo.Aux; |
