diff options
Diffstat (limited to 'ncurses-5.3/Ada95/samples/sample-form_demo-aux.adb')
| -rw-r--r-- | ncurses-5.3/Ada95/samples/sample-form_demo-aux.adb | 260 |
1 files changed, 0 insertions, 260 deletions
diff --git a/ncurses-5.3/Ada95/samples/sample-form_demo-aux.adb b/ncurses-5.3/Ada95/samples/sample-form_demo-aux.adb deleted file mode 100644 index 5455478..0000000 --- a/ncurses-5.3/Ada95/samples/sample-form_demo-aux.adb +++ /dev/null @@ -1,260 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- Sample.Form_Demo.Aux -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998 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 --- Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en --- Version Control --- $Revision$ --- 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 : 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 : 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 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; |