diff options
Diffstat (limited to 'src/fltk-dialogs.adb')
| -rw-r--r-- | src/fltk-dialogs.adb | 225 |
1 files changed, 201 insertions, 24 deletions
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; |