diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/c_fl_dialog.cpp | 55 | ||||
| -rw-r--r-- | src/c_fl_dialog.h | 17 | ||||
| -rw-r--r-- | src/c_fl_input.cpp | 97 | ||||
| -rw-r--r-- | src/c_fl_input.h | 28 | ||||
| -rw-r--r-- | src/fltk-dialogs.adb | 225 | ||||
| -rw-r--r-- | src/fltk-dialogs.ads | 78 | ||||
| -rw-r--r-- | src/fltk-widgets-boxes.adb | 4 | ||||
| -rw-r--r-- | src/fltk-widgets-boxes.ads | 3 | ||||
| -rw-r--r-- | src/fltk-widgets-inputs.adb | 333 | ||||
| -rw-r--r-- | src/fltk-widgets-inputs.ads | 121 |
10 files changed, 924 insertions, 37 deletions
diff --git a/src/c_fl_dialog.cpp b/src/c_fl_dialog.cpp index cb6d305..b73c05c 100644 --- a/src/c_fl_dialog.cpp +++ b/src/c_fl_dialog.cpp @@ -10,23 +10,70 @@ void dialog_fl_alert(const char * m) { fl_alert(m); } +//int dialog_fl_ask(const char * m) { +// return fl_ask(m); +//} + +void dialog_fl_beep(int b) { + fl_beep(b); +} int dialog_fl_choice(const char * m, const char * a, const char * b, const char * c) { return fl_choice(m, a, b, c); } +const char * dialog_fl_input(const char * m, const char * d) { + return fl_input(m, d); +} + +void dialog_fl_message(const char * m) { + fl_message(m); +} + +const char * dialog_fl_password(const char * m, const char * d) { + return fl_password(m, d); +} + + + + +int dialog_fl_color_chooser(const char * n, double & r, double & g, double & b, int m) { + return fl_color_chooser(n, r, g, b, m); +} + +char * dialog_fl_dir_chooser(const char * m, const char * d, int r) { + return fl_dir_chooser(m, d, r); +} char * dialog_fl_file_chooser(const char * m, const char * p, const char * d, int r) { return fl_file_chooser(m, p, d, r); } -const char * dialog_fl_input(const char * m, const char * d) { - return fl_input(m, d); + + +int dialog_fl_get_message_hotspot(void) { + return fl_message_hotspot(); } +void dialog_fl_set_message_hotspot(int v) { + fl_message_hotspot(v); +} -void dialog_fl_message(const char * m) { - fl_message(m); +void dialog_fl_message_font(int f, int s) { + fl_message_font(f, s); +} + +void * dialog_fl_message_icon(void) { + return fl_message_icon(); +} + +void dialog_fl_message_title(const char * t) { + fl_message_title(t); +} + +void dialog_fl_message_title_default(const char * t) { + fl_message_title_default(t); } + diff --git a/src/c_fl_dialog.h b/src/c_fl_dialog.h index 6804022..b366d2c 100644 --- a/src/c_fl_dialog.h +++ b/src/c_fl_dialog.h @@ -5,10 +5,25 @@ extern "C" void dialog_fl_alert(const char * m); +//extern "C" int dialog_fl_ask(const char * m); +extern "C" void dialog_fl_beep(int b); extern "C" int dialog_fl_choice(const char * m, const char * a, const char * b, const char * c); -extern "C" char * dialog_fl_file_chooser(const char * m, const char * p, const char * d, int r); extern "C" const char * dialog_fl_input(const char * m, const char * d); extern "C" void dialog_fl_message(const char * m); +extern "C" const char * dialog_fl_password(const char * m, const char * d); + + +extern "C" int dialog_fl_color_chooser(const char * n, double & r, double & g, double & b, int m); +extern "C" char * dialog_fl_dir_chooser(const char * m, const char * d, int r); +extern "C" char * dialog_fl_file_chooser(const char * m, const char * p, const char * d, int r); + + +extern "C" int dialog_fl_get_message_hotspot(void); +extern "C" void dialog_fl_set_message_hotspot(int v); +extern "C" void dialog_fl_message_font(int f, int s); +extern "C" void * dialog_fl_message_icon(void); +extern "C" void dialog_fl_message_title(const char * t); +extern "C" void dialog_fl_message_title_default(const char * t); #endif diff --git a/src/c_fl_input.cpp b/src/c_fl_input.cpp index 7e106e2..84bbc90 100644 --- a/src/c_fl_input.cpp +++ b/src/c_fl_input.cpp @@ -90,6 +90,10 @@ int fl_input_copy_cuts(INPUT i) { return reinterpret_cast<Fl_Input*>(i)->copy_cuts(); } +int fl_input_undo(INPUT i) { + return reinterpret_cast<Fl_Input*>(i)->undo(); +} + @@ -101,9 +105,72 @@ void fl_input_set_readonly(INPUT i, int t) { reinterpret_cast<Fl_Input*>(i)->readonly(t); } +int fl_input_get_tab_nav(INPUT i) { + return reinterpret_cast<Fl_Input*>(i)->tab_nav(); +} + +void fl_input_set_tab_nav(INPUT i, int t) { + reinterpret_cast<Fl_Input*>(i)->tab_nav(t); +} + +int fl_input_get_wrap(INPUT i) { + return reinterpret_cast<Fl_Input*>(i)->wrap(); +} + +void fl_input_set_wrap(INPUT i, int t) { + reinterpret_cast<Fl_Input*>(i)->wrap(t); +} + + + + +int fl_input_get_input_type(INPUT i) { + return reinterpret_cast<Fl_Input*>(i)->input_type(); +} +void fl_input_set_input_type(INPUT i, int t) { + reinterpret_cast<Fl_Input*>(i)->input_type(t); +} + +unsigned long fl_input_get_shortcut(INPUT i) { + return reinterpret_cast<Fl_Input*>(i)->shortcut(); +} + +void fl_input_set_shortcut(INPUT i, unsigned long t) { + reinterpret_cast<Fl_Input*>(i)->shortcut(t); +} + +int fl_input_get_mark(INPUT i) { + return reinterpret_cast<Fl_Input*>(i)->mark(); +} + +int fl_input_set_mark(INPUT i, int t) { + return reinterpret_cast<Fl_Input*>(i)->mark(t); +} + +int fl_input_get_position(INPUT i) { + return reinterpret_cast<Fl_Input*>(i)->position(); +} + +int fl_input_set_position(INPUT i, int t) { + return reinterpret_cast<Fl_Input*>(i)->position(t); +} + + +unsigned int fl_input_index(INPUT i, int p) { + return reinterpret_cast<Fl_Input*>(i)->index(p); +} + +int fl_input_insert(INPUT i, const char * s, int l) { + return reinterpret_cast<Fl_Input*>(i)->insert(s,l); +} + +int fl_input_replace(INPUT i, int b, int e, const char * s, int l) { + return reinterpret_cast<Fl_Input*>(i)->replace(b,e,s,l); +} + const char * fl_input_get_value(INPUT i) { return reinterpret_cast<Fl_Input*>(i)->value(); } @@ -115,6 +182,29 @@ void fl_input_set_value(INPUT i, char * s, int len) { +int fl_input_get_maximum_size(INPUT i) { + return reinterpret_cast<Fl_Input*>(i)->maximum_size(); +} + +void fl_input_set_maximum_size(INPUT i, int t) { + reinterpret_cast<Fl_Input*>(i)->maximum_size(t); +} + +int fl_input_get_size(INPUT i) { + return reinterpret_cast<Fl_Input*>(i)->size(); +} + + + + +unsigned int fl_input_get_cursor_color(INPUT i) { + return reinterpret_cast<Fl_Input*>(i)->cursor_color(); +} + +void fl_input_set_cursor_color(INPUT i, unsigned int t) { + reinterpret_cast<Fl_Input*>(i)->cursor_color(t); +} + unsigned int fl_input_get_textcolor(INPUT i) { return reinterpret_cast<Fl_Input*>(i)->textcolor(); } @@ -140,3 +230,10 @@ void fl_input_set_textsize(INPUT i, int t) { } + + +void fl_input_set_size(INPUT i, int w, int h) { + reinterpret_cast<Fl_Input*>(i)->size(w,h); +} + + diff --git a/src/c_fl_input.h b/src/c_fl_input.h index 4ffbea4..38bfc7e 100644 --- a/src/c_fl_input.h +++ b/src/c_fl_input.h @@ -30,16 +30,41 @@ extern "C" int fl_input_cut(INPUT i); extern "C" int fl_input_cut2(INPUT i, int b); extern "C" int fl_input_cut3(INPUT i, int a, int b); extern "C" int fl_input_copy_cuts(INPUT i); +extern "C" int fl_input_undo(INPUT i); extern "C" int fl_input_get_readonly(INPUT i); extern "C" void fl_input_set_readonly(INPUT i, int t); +extern "C" int fl_input_get_tab_nav(INPUT i); +extern "C" void fl_input_set_tab_nav(INPUT i, int t); +extern "C" int fl_input_get_wrap(INPUT i); +extern "C" void fl_input_set_wrap(INPUT i, int t); +extern "C" int fl_input_get_input_type(INPUT i); +extern "C" void fl_input_set_input_type(INPUT i, int t); +extern "C" unsigned long fl_input_get_shortcut(INPUT i); +extern "C" void fl_input_set_shortcut(INPUT i, unsigned long t); +extern "C" int fl_input_get_mark(INPUT i); +extern "C" int fl_input_set_mark(INPUT i, int t); +extern "C" int fl_input_get_position(INPUT i); +extern "C" int fl_input_set_position(INPUT i, int t); + + +extern "C" unsigned int fl_input_index(INPUT i, int p); +extern "C" int fl_input_insert(INPUT i, const char * s, int l); +extern "C" int fl_input_replace(INPUT i, int b, int e, const char * s, int l); extern "C" const char * fl_input_get_value(INPUT i); extern "C" void fl_input_set_value(INPUT i, char * s, int len); +extern "C" int fl_input_get_maximum_size(INPUT i); +extern "C" void fl_input_set_maximum_size(INPUT i, int t); +extern "C" int fl_input_get_size(INPUT i); + + +extern "C" unsigned int fl_input_get_cursor_color(INPUT i); +extern "C" void fl_input_set_cursor_color(INPUT i, unsigned int t); extern "C" unsigned int fl_input_get_textcolor(INPUT i); extern "C" void fl_input_set_textcolor(INPUT i, unsigned int t); extern "C" int fl_input_get_textfont(INPUT i); @@ -48,5 +73,8 @@ extern "C" int fl_input_get_textsize(INPUT i); extern "C" void fl_input_set_textsize(INPUT i, int t); +extern "C" void fl_input_set_size(INPUT i, int w, int h); + + #endif diff --git a/src/fltk-dialogs.adb b/src/fltk-dialogs.adb index 0f724c0..20f4c6b 100644 --- a/src/fltk-dialogs.adb +++ b/src/fltk-dialogs.adb @@ -2,10 +2,12 @@ with - Interfaces.C.Strings; + Interfaces.C.Strings, + System; use type + Interfaces.C.int, Interfaces.C.Strings.chars_ptr; @@ -16,17 +18,20 @@ package body FLTK.Dialogs is (M : in Interfaces.C.char_array); pragma Import (C, dialog_fl_alert, "dialog_fl_alert"); + -- function dialog_fl_ask + -- (M : in Interfaces.C.char_array) + -- return Interfaces.C.int; + -- pragma Import (C, dialog_fl_ask, "dialog_fl_ask"); + + procedure dialog_fl_beep + (B : in Interfaces.C.int); + pragma Import (C, dialog_fl_beep, "dialog_fl_beep"); + function dialog_fl_choice (M, A, B, C : in Interfaces.C.char_array) return Interfaces.C.int; pragma Import (C, dialog_fl_choice, "dialog_fl_choice"); - function dialog_fl_file_chooser - (M, P, D : in Interfaces.C.char_array; - R : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, dialog_fl_file_chooser, "dialog_fl_file_chooser"); - function dialog_fl_input (M, D : in Interfaces.C.char_array) return Interfaces.C.Strings.chars_ptr; @@ -36,6 +41,60 @@ package body FLTK.Dialogs is (M : in Interfaces.C.char_array); pragma Import (C, dialog_fl_message, "dialog_fl_message"); + function dialog_fl_password + (M, D : in Interfaces.C.char_array) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, dialog_fl_password, "dialog_fl_password"); + + + + + function dialog_fl_color_chooser + (N : in Interfaces.C.char_array; + R, G, B : in out Interfaces.C.double; + M : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, dialog_fl_color_chooser, "dialog_fl_color_chooser"); + + function dialog_fl_dir_chooser + (M, D : in Interfaces.C.char_array; + R : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, dialog_fl_dir_chooser, "dialog_fl_dir_chooser"); + + function dialog_fl_file_chooser + (M, P, D : in Interfaces.C.char_array; + R : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, dialog_fl_file_chooser, "dialog_fl_file_chooser"); + + + + + function dialog_fl_get_message_hotspot + return Interfaces.C.int; + pragma Import (C, dialog_fl_get_message_hotspot, "dialog_fl_get_message_hotspot"); + + procedure dialog_fl_set_message_hotspot + (V : in Interfaces.C.int); + pragma Import (C, dialog_fl_set_message_hotspot, "dialog_fl_set_message_hotspot"); + + procedure dialog_fl_message_font + (F, S : in Interfaces.C.int); + pragma Import (C, dialog_fl_message_font, "dialog_fl_message_font"); + + function dialog_fl_message_icon + return System.Address; + pragma Import (C, dialog_fl_message_icon, "dialog_fl_message_icon"); + + procedure dialog_fl_message_title + (T : in Interfaces.C.char_array); + pragma Import (C, dialog_fl_message_title, "dialog_fl_message_title"); + + procedure dialog_fl_message_title_default + (T : in Interfaces.C.char_array); + pragma Import (C, dialog_fl_message_title_default, "dialog_fl_message_title_default"); + @@ -46,6 +105,19 @@ package body FLTK.Dialogs is end Alert; + -- function Ask + -- (Message : in String) + -- return Boolean is + -- begin + -- return dialog_fl_ask (Interfaces.C.To_C (Message)) /= 0; + -- end Ask; + + + procedure Beep + (Kind : in Beep_Kind) is + begin + dialog_fl_beep (Beep_Kind'Pos (Kind)); + end Beep; function Three_Way_Choice @@ -62,35 +134,36 @@ package body FLTK.Dialogs is end Three_Way_Choice; - - - function File_Chooser - (Message, Filter_Pattern, Default : in String; - Relative : in Boolean := False) + function Text_Input + (Message : in String; + Default : in String := "") return String is - Result : Interfaces.C.Strings.chars_ptr := dialog_fl_file_chooser + Result : Interfaces.C.Strings.chars_ptr := dialog_fl_input (Interfaces.C.To_C (Message), - Interfaces.C.To_C (Filter_Pattern), - Interfaces.C.To_C (Default), - Boolean'Pos (Relative)); + Interfaces.C.To_C (Default)); begin if Result = Interfaces.C.Strings.Null_Ptr then return ""; else return Interfaces.C.Strings.Value (Result); end if; - end File_Chooser; + end Text_Input; + procedure Message_Box + (Message : in String) is + begin + dialog_fl_message (Interfaces.C.To_C (Message)); + end Message_Box; - function Text_Input + function Password (Message : in String; Default : in String := "") return String is - Result : Interfaces.C.Strings.chars_ptr := dialog_fl_input + Result : Interfaces.C.Strings.chars_ptr := dialog_fl_password (Interfaces.C.To_C (Message), Interfaces.C.To_C (Default)); begin @@ -99,16 +172,120 @@ package body FLTK.Dialogs is else return Interfaces.C.Strings.Value (Result); end if; - end Text_Input; + end Password; - procedure Message_Box - (Message : in String) is + function Color_Chooser + (Title : in String; + R, G, B : in out Long_Float; + Mode : in FLTK.Widgets.Groups.Color_Choosers.Color_Mode) + return Boolean + is + C_R : Interfaces.C.double := Interfaces.C.double (R); + C_G : Interfaces.C.double := Interfaces.C.double (G); + C_B : Interfaces.C.double := Interfaces.C.double (B); + M : Interfaces.C.int := FLTK.Widgets.Groups.Color_Choosers.Color_Mode'Pos (Mode); + Result : Boolean := dialog_fl_color_chooser + (Interfaces.C.To_C (Title), C_R, C_G, C_B, M) /= 0; begin - dialog_fl_message (Interfaces.C.To_C (Message)); - end Message_Box; + R := Long_Float (C_R); + G := Long_Float (C_G); + B := Long_Float (C_B); + return Result; + end Color_Chooser; + + + function Dir_Chooser + (Message, Default : in String; + Relative : in Boolean := False) + return String + is + Result : Interfaces.C.Strings.chars_ptr := dialog_fl_dir_chooser + (Interfaces.C.To_C (Message), + Interfaces.C.To_C (Default), + Boolean'Pos (Relative)); + begin + if Result = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Result); + end if; + end Dir_Chooser; + + + function File_Chooser + (Message, Filter_Pattern, Default : in String; + Relative : in Boolean := False) + return String + is + Result : Interfaces.C.Strings.chars_ptr := dialog_fl_file_chooser + (Interfaces.C.To_C (Message), + Interfaces.C.To_C (Filter_Pattern), + Interfaces.C.To_C (Default), + Boolean'Pos (Relative)); + begin + if Result = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Result); + end if; + end File_Chooser; + + + + + function Get_Hotspot + return Boolean is + begin + return dialog_fl_get_message_hotspot /= 0; + end Get_Hotspot; + + + procedure Set_Hotspot + (To : in Boolean) is + begin + dialog_fl_set_message_hotspot (Boolean'Pos (To)); + end Set_Hotspot; + + + procedure Set_Message_Font + (Font : in Font_Kind; + Size : in Font_Size) is + begin + dialog_fl_message_font (Font_Kind'Pos (Font), Interfaces.C.int (Size)); + end Set_Message_Font; + + + function Get_Message_Icon + return FLTK.Widgets.Boxes.Box_Cursor is + begin + return (Data => Icon_Box'Access); + end Get_Message_Icon; + + + procedure Set_Message_Title + (To : in String) is + begin + dialog_fl_message_title (Interfaces.C.To_C (To)); + end Set_Message_Title; + + + procedure Set_Message_Title_Default + (To : in String) is + begin + dialog_fl_message_title_default (Interfaces.C.To_C (To)); + end Set_Message_Title_Default; + + + + +begin + + + Wrapper (Icon_Box).Void_Ptr := dialog_fl_message_icon; + Wrapper (Icon_Box).Needs_Dealloc := False; end FLTK.Dialogs; diff --git a/src/fltk-dialogs.ads b/src/fltk-dialogs.ads index cb5b966..0368834 100644 --- a/src/fltk-dialogs.ads +++ b/src/fltk-dialogs.ads @@ -1,17 +1,63 @@ +with + + FLTK.Widgets.Boxes, + FLTK.Widgets.Groups.Color_Choosers; + + package FLTK.Dialogs is + type Beep_Kind is + (Default_Beep, Message_Beep, Error_Beep, + Question_Beep, Password_Beep, Notification_Beep); + + type Choice is (First, Second, Third); + + + + procedure Alert (Message : String); + -- function Ask + -- (Message : in String) + -- return Boolean; + + procedure Beep + (Kind : in Beep_Kind); - type Choice is (First, Second, Third); function Three_Way_Choice (Message, Button1, Button2, Button3 : in String) return Choice; + function Text_Input + (Message : in String; + Default : in String := "") + return String; + + procedure Message_Box + (Message : in String); + + function Password + (Message : in String; + Default : in String := "") + return String; + + + + + function Color_Chooser + (Title : in String; + R, G, B : in out Long_Float; + Mode : in FLTK.Widgets.Groups.Color_Choosers.Color_Mode) + return Boolean; + + function Dir_Chooser + (Message, Default : in String; + Relative : in Boolean := False) + return String; function File_Chooser (Message, Filter_Pattern, Default : in String; @@ -19,14 +65,32 @@ package FLTK.Dialogs is return String; - function Text_Input - (Message : in String; - Default : in String := "") - return String; - procedure Message_Box - (Message : in String); + function Get_Hotspot + return Boolean; + + procedure Set_Hotspot + (To : in Boolean); + + procedure Set_Message_Font + (Font : in Font_Kind; + Size : in Font_Size); + + function Get_Message_Icon + return FLTK.Widgets.Boxes.Box_Cursor; + + procedure Set_Message_Title + (To : in String); + + procedure Set_Message_Title_Default + (To : in String); + + +private + + + Icon_Box : aliased FLTK.Widgets.Boxes.Box; end FLTK.Dialogs; diff --git a/src/fltk-widgets-boxes.adb b/src/fltk-widgets-boxes.adb index 27aed8f..e60f0f7 100644 --- a/src/fltk-widgets-boxes.adb +++ b/src/fltk-widgets-boxes.adb @@ -56,7 +56,9 @@ package body FLTK.Widgets.Boxes is if This.Void_Ptr /= System.Null_Address and then This in Box'Class then - free_fl_box (This.Void_Ptr); + if This.Needs_Dealloc then + free_fl_box (This.Void_Ptr); + end if; This.Void_Ptr := System.Null_Address; end if; Finalize (Widget (This)); diff --git a/src/fltk-widgets-boxes.ads b/src/fltk-widgets-boxes.ads index 99962ba..ef551b5 100644 --- a/src/fltk-widgets-boxes.ads +++ b/src/fltk-widgets-boxes.ads @@ -5,6 +5,9 @@ package FLTK.Widgets.Boxes is type Box is new Widget with private; + type Box_Cursor (Data : access Box'Class) is limited null record + with Implicit_Dereference => Data; + diff --git a/src/fltk-widgets-inputs.adb b/src/fltk-widgets-inputs.adb index 7e57a3e..5196911 100644 --- a/src/fltk-widgets-inputs.adb +++ b/src/fltk-widgets-inputs.adb @@ -65,6 +65,11 @@ package body FLTK.Widgets.Inputs is return Interfaces.C.int; pragma Import (C, fl_input_copy_cuts, "fl_input_copy_cuts"); + function fl_input_undo + (I : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_input_undo, "fl_input_undo"); + @@ -78,8 +83,94 @@ package body FLTK.Widgets.Inputs is T : in Interfaces.C.int); pragma Import (C, fl_input_set_readonly, "fl_input_set_readonly"); + function fl_input_get_tab_nav + (I : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_input_get_tab_nav, "fl_input_get_tab_nav"); + + procedure fl_input_set_tab_nav + (I : in System.Address; + T : in Interfaces.C.int); + pragma Import (C, fl_input_set_tab_nav, "fl_input_set_tab_nav"); + + function fl_input_get_wrap + (I : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_input_get_wrap, "fl_input_get_wrap"); + + procedure fl_input_set_wrap + (I : in System.Address; + T : in Interfaces.C.int); + pragma Import (C, fl_input_set_wrap, "fl_input_set_wrap"); + + + + + function fl_input_get_input_type + (I : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_input_get_input_type, "fl_input_get_input_type"); + + procedure fl_input_set_input_type + (I : in System.Address; + T : in Interfaces.C.int); + pragma Import (C, fl_input_set_input_type, "fl_input_set_input_type"); + + function fl_input_get_shortcut + (I : in System.Address) + return Interfaces.C.unsigned_long; + pragma Import (C, fl_input_get_shortcut, "fl_input_get_shortcut"); + + procedure fl_input_set_shortcut + (I : in System.Address; + T : in Interfaces.C.unsigned_long); + pragma Import (C, fl_input_set_shortcut, "fl_input_set_shortcut"); + + function fl_input_get_mark + (I : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_input_get_mark, "fl_input_get_mark"); + + function fl_input_set_mark + (I : in System.Address; + T : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_input_set_mark, "fl_input_set_mark"); + + function fl_input_get_position + (I : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_input_get_position, "fl_input_get_position"); + + function fl_input_set_position + (I : in System.Address; + T : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_input_set_position, "fl_input_set_position"); + + + + + function fl_input_index + (I : in System.Address; + P : in Interfaces.C.int) + return Interfaces.C.unsigned; + pragma Import (C, fl_input_index, "fl_input_index"); + function fl_input_insert + (I : in System.Address; + S : in Interfaces.C.char_array; + L : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_input_insert, "fl_input_insert"); + function fl_input_replace + (I : in System.Address; + B, E : in Interfaces.C.int; + S : in Interfaces.C.char_array; + L : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_input_replace, "fl_input_replace"); procedure fl_input_set_value (I : in System.Address; @@ -90,6 +181,34 @@ package body FLTK.Widgets.Inputs is + function fl_input_get_maximum_size + (I : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_input_get_maximum_size, "fl_input_get_maximum_size"); + + procedure fl_input_set_maximum_size + (I : in System.Address; + T : in Interfaces.C.int); + pragma Import (C, fl_input_set_maximum_size, "fl_input_set_maximum_size"); + + function fl_input_get_size + (I : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_input_get_size, "fl_input_get_size"); + + + + + function fl_input_get_cursor_color + (I : in System.Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_input_get_cursor_color, "fl_input_get_cursor_color"); + + procedure fl_input_set_cursor_color + (I : in System.Address; + T : in Interfaces.C.unsigned); + pragma Import (C, fl_input_set_cursor_color, "fl_input_set_cursor_color"); + function fl_input_get_textcolor (I : in System.Address) return Interfaces.C.unsigned; @@ -123,6 +242,14 @@ package body FLTK.Widgets.Inputs is + procedure fl_input_set_size + (I : in System.Address; + W, H : in Interfaces.C.int); + pragma Import (C, fl_input_set_size, "fl_input_set_size"); + + + + procedure fl_input_draw (W : in System.Address); pragma Import (C, fl_input_draw, "fl_input_draw"); @@ -222,6 +349,13 @@ package body FLTK.Widgets.Inputs is end Copy_Cuts; + procedure Undo + (This : in out Input) is + begin + This.Was_Changed := fl_input_undo (This.Void_Ptr) /= 0; + end Undo; + + function Has_Changed @@ -255,6 +389,139 @@ package body FLTK.Widgets.Inputs is end Set_Readonly; + function Is_Tab_Nav + (This : in Input) + return Boolean is + begin + return fl_input_get_tab_nav (This.Void_Ptr) /= 0; + end Is_Tab_Nav; + + + procedure Set_Tab_Nav + (This : in out Input; + To : in Boolean) is + begin + fl_input_set_tab_nav (This.Void_Ptr, Boolean'Pos (To)); + end Set_Tab_Nav; + + + function Is_Wrap + (This : in Input) + return Boolean is + begin + return fl_input_get_wrap (This.Void_Ptr) /= 0; + end Is_Wrap; + + + procedure Set_Wrap + (This : in out Input; + To : in Boolean) is + begin + fl_input_set_wrap (This.Void_Ptr, Boolean'Pos (To)); + end Set_Wrap; + + + + + function Get_Input_Type + (This : in Input) + return Input_Kind + is + C_Val : Interfaces.C.int := fl_input_get_input_type (This.Void_Ptr); + begin + for V in Input_Kind loop + if Input_Kind_Values (V) = C_Val then + return V; + end if; + end loop; + return Normal_Kind; + end Get_Input_Type; + + + function Get_Shortcut_Key + (This : in Input) + return Shortcut_Key is + begin + return C_To_Key (fl_input_get_shortcut (This.Void_Ptr)); + end Get_Shortcut_Key; + + + procedure Set_Shortcut_Key + (This : in out Input; + To : in Shortcut_Key) is + begin + fl_input_set_shortcut (This.Void_Ptr, Key_To_C (To)); + end Set_Shortcut_Key; + + + function Get_Mark + (This : in Input) + return Natural is + begin + return Natural (fl_input_get_mark (This.Void_Ptr)); + end Get_Mark; + + + procedure Set_Mark + (This : in out Input; + To : in Natural) is + begin + This.Was_Changed := fl_input_set_mark + (This.Void_Ptr, Interfaces.C.int (To)) /= 0; + end Set_Mark; + + + function Get_Position + (This : in Input) + return Natural is + begin + return Natural (fl_input_get_position (This.Void_Ptr)); + end Get_Position; + + + procedure Set_Position + (This : in out Input; + To : in Natural) is + begin + This.Was_Changed := fl_input_set_position + (This.Void_Ptr, Interfaces.C.int (To)) /= 0; + end Set_Position; + + + + + function Index + (This : in Input; + Place : in Integer) + return Character is + begin + return Character'Val (fl_input_index (This.Void_Ptr, Interfaces.C.int (Place))); + end Index; + + + procedure Insert + (This : in out Input; + Str : in String) is + begin + This.Was_Changed := fl_input_insert + (This.Void_Ptr, + Interfaces.C.To_C (Str), + Str'Length) /= 0; + end Insert; + + + procedure Replace + (This : in out Input; + From, To : in Natural; + New_Text : in String) is + begin + This.Was_Changed := fl_input_replace + (This.Void_Ptr, + Interfaces.C.int (From), + Interfaces.C.int (To), + Interfaces.C.To_C (New_Text), + New_Text'Length) /= 0; + end Replace; function Get_Value @@ -275,6 +542,48 @@ package body FLTK.Widgets.Inputs is + function Get_Maximum_Size + (This : in Input) + return Natural is + begin + return Natural (fl_input_get_maximum_size (This.Void_Ptr)); + end Get_Maximum_Size; + + + procedure Set_Maximum_Size + (This : in out Input; + To : in Natural) is + begin + fl_input_set_maximum_size (This.Void_Ptr, Interfaces.C.int (To)); + end Set_Maximum_Size; + + + function Size + (This : in Input) + return Natural is + begin + return Natural (fl_input_get_size (This.Void_Ptr)); + end Size; + + + + + function Get_Cursor_Color + (This : in Input) + return Color is + begin + return Color (fl_input_get_cursor_color (This.Void_Ptr)); + end Get_Cursor_Color; + + + procedure Set_Cursor_Color + (This : in out Input; + To : in Color) is + begin + fl_input_set_cursor_color (This.Void_Ptr, Interfaces.C.unsigned (To)); + end Set_Cursor_Color; + + function Get_Text_Color (This : in Input) return Color is @@ -325,6 +634,16 @@ package body FLTK.Widgets.Inputs is + procedure Resize + (This : in out Input; + W, H : in Integer) is + begin + fl_input_set_size (This.Void_Ptr, Interfaces.C.int (W), Interfaces.C.int (H)); + end Resize; + + + + procedure Draw (This : in out Input) is begin @@ -342,5 +661,19 @@ package body FLTK.Widgets.Inputs is end Handle; + + + package body Extra is + + procedure Set_Input_Type + (This : in out Input; + To : in Input_Kind) is + begin + fl_input_set_input_type (This.Void_Ptr, Input_Kind_Values (To)); + end Set_Input_Type; + + end Extra; + + end FLTK.Widgets.Inputs; diff --git a/src/fltk-widgets-inputs.ads b/src/fltk-widgets-inputs.ads index fc7b980..d3bcbba 100644 --- a/src/fltk-widgets-inputs.ads +++ b/src/fltk-widgets-inputs.ads @@ -14,6 +14,10 @@ package FLTK.Widgets.Inputs is type Input_Cursor (Data : access Input'Class) is limited null record with Implicit_Dereference => Data; + type Input_Kind is + (Normal_Kind, Float_Kind, Integer_Kind, Multiline_Kind, + Secret_Kind, Readonly_Kind, Wrap_Kind); + @@ -46,6 +50,9 @@ package FLTK.Widgets.Inputs is procedure Copy_Cuts (This : in out Input); + procedure Undo + (This : in out Input); + @@ -64,8 +71,69 @@ package FLTK.Widgets.Inputs is (This : in out Input; To : in Boolean); + function Is_Tab_Nav + (This : in Input) + return Boolean; + + procedure Set_Tab_Nav + (This : in out Input; + To : in Boolean); + + function Is_Wrap + (This : in Input) + return Boolean; + + procedure Set_Wrap + (This : in out Input; + To : in Boolean); + + + + + function Get_Input_Type + (This : in Input) + return Input_Kind; + + function Get_Shortcut_Key + (This : in Input) + return Shortcut_Key; + + procedure Set_Shortcut_Key + (This : in out Input; + To : in Shortcut_Key); + + function Get_Mark + (This : in Input) + return Natural; + + procedure Set_Mark + (This : in out Input; + To : in Natural); + + function Get_Position + (This : in Input) + return Natural; + + procedure Set_Position + (This : in out Input; + To : in Natural); + + + function Index + (This : in Input; + Place : in Integer) + return Character; + + procedure Insert + (This : in out Input; + Str : in String); + + procedure Replace + (This : in out Input; + From, To : in Natural; + New_Text : in String); function Get_Value (This : in Input) @@ -78,6 +146,29 @@ package FLTK.Widgets.Inputs is + function Get_Maximum_Size + (This : in Input) + return Natural; + + procedure Set_Maximum_Size + (This : in out Input; + To : in Natural); + + function Size + (This : in Input) + return Natural; + + + + + function Get_Cursor_Color + (This : in Input) + return Color; + + procedure Set_Cursor_Color + (This : in out Input; + To : in Color); + function Get_Text_Color (This : in Input) return Color; @@ -105,6 +196,13 @@ package FLTK.Widgets.Inputs is + procedure Resize + (This : in out Input; + W, H : in Integer); + + + + procedure Draw (This : in out Input); @@ -114,6 +212,17 @@ package FLTK.Widgets.Inputs is return Event_Outcome; + + + package Extra is + + procedure Set_Input_Type + (This : in out Input; + To : in Input_Kind); + + end Extra; + + private @@ -127,6 +236,18 @@ private + Input_Kind_Values : array (Input_Kind) of Interfaces.C.int := + (Normal_Kind => 0, + Float_Kind => 1, + Integer_Kind => 2, + Multiline_Kind => 4, + Secret_Kind => 5, + Readonly_Kind => 8, + Wrap_Kind => 16); + + + + function fl_input_get_value (F : in System.Address) return Interfaces.C.Strings.chars_ptr; |