sample-form_demo-aux.adb [plain text]
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; C : out Column_Count; Y : out Line_Position; X : out Column_Position) is
begin
Scale (F, L, C);
L := L + 2; C := C + 2;
X := (Columns - C) / 2;
Y := 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;
when ACK => return F_Next_Field; when STX => return F_Previous_Field; when FF => return F_Left_Field; when DC2 => return F_Right_Field; when NAK => return F_Up_Field; when EOT => return F_Down_Field;
when ETB => return F_Next_Word; when DC4 => return F_Previous_Word;
when SOH => return F_Begin_Field; when ENQ => return F_End_Field;
when HT => return F_Insert_Char; when SI => return F_Insert_Line; when SYN => return F_Delete_Char; when BS => return F_Delete_Previous; when EM => return F_Delete_Line; when BEL => return F_Delete_Word; when VT => return F_Clear_EOF;
when SO => return F_Next_Choice; when DLE => return F_Previous_Choice;
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;