diff options
Diffstat (limited to 'body/fltk-widgets-groups-text_displays.adb')
| -rw-r--r-- | body/fltk-widgets-groups-text_displays.adb | 1153 |
1 files changed, 1153 insertions, 0 deletions
diff --git a/body/fltk-widgets-groups-text_displays.adb b/body/fltk-widgets-groups-text_displays.adb new file mode 100644 index 0000000..011d841 --- /dev/null +++ b/body/fltk-widgets-groups-text_displays.adb @@ -0,0 +1,1153 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces.C, + FLTK.Text_Buffers; + +use type + + Interfaces.C.int; + + +package body FLTK.Widgets.Groups.Text_Displays is + + + ------------------------ + -- Functions From C -- + ------------------------ + + function new_fl_text_display + (X, Y, W, H : in Interfaces.C.int; + Label : in Interfaces.C.char_array) + return Storage.Integer_Address; + pragma Import (C, new_fl_text_display, "new_fl_text_display"); + pragma Inline (new_fl_text_display); + + procedure free_fl_text_display + (TD : in Storage.Integer_Address); + pragma Import (C, free_fl_text_display, "free_fl_text_display"); + pragma Inline (free_fl_text_display); + + + + + function fl_text_display_get_buffer + (TD : in Storage.Integer_Address) + return Storage.Integer_Address; + pragma Import (C, fl_text_display_get_buffer, "fl_text_display_get_buffer"); + pragma Inline (fl_text_display_get_buffer); + + procedure fl_text_display_set_buffer + (TD, TB : in Storage.Integer_Address); + pragma Import (C, fl_text_display_set_buffer, "fl_text_display_set_buffer"); + pragma Inline (fl_text_display_set_buffer); + + + + + procedure fl_text_display_highlight_data + (TD, TB, ST : in Storage.Integer_Address; + L : in Interfaces.C.int); + pragma Import (C, fl_text_display_highlight_data, "fl_text_display_highlight_data"); + pragma Inline (fl_text_display_highlight_data); + + procedure fl_text_display_highlight_data2 + (TD, TB, ST : in Storage.Integer_Address; + L : in Interfaces.C.int; + C : in Interfaces.C.unsigned; + B, A : in Storage.Integer_Address); + pragma Import (C, fl_text_display_highlight_data2, "fl_text_display_highlight_data2"); + pragma Inline (fl_text_display_highlight_data2); + + + + + function fl_text_display_col_to_x + (TD : in Storage.Integer_Address; + C : in Interfaces.C.double) + return Interfaces.C.double; + pragma Import (C, fl_text_display_col_to_x, "fl_text_display_col_to_x"); + pragma Inline (fl_text_display_col_to_x); + + function fl_text_display_x_to_col + (TD : in Storage.Integer_Address; + X : in Interfaces.C.double) + return Interfaces.C.double; + pragma Import (C, fl_text_display_x_to_col, "fl_text_display_x_to_col"); + pragma Inline (fl_text_display_x_to_col); + + function fl_text_display_in_selection + (TD : in Storage.Integer_Address; + X, Y : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_display_in_selection, "fl_text_display_in_selection"); + pragma Inline (fl_text_display_in_selection); + + function fl_text_display_position_to_xy + (TD : in Storage.Integer_Address; + P : in Interfaces.C.int; + X, Y : out Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_display_position_to_xy, "fl_text_display_position_to_xy"); + pragma Inline (fl_text_display_position_to_xy); + + + + + function fl_text_display_get_cursor_color + (TD : in Storage.Integer_Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_text_display_get_cursor_color, "fl_text_display_get_cursor_color"); + pragma Inline (fl_text_display_get_cursor_color); + + procedure fl_text_display_set_cursor_color + (TD : in Storage.Integer_Address; + C : in Interfaces.C.unsigned); + pragma Import (C, fl_text_display_set_cursor_color, "fl_text_display_set_cursor_color"); + pragma Inline (fl_text_display_set_cursor_color); + + procedure fl_text_display_set_cursor_style + (TD : in Storage.Integer_Address; + S : in Interfaces.C.int); + pragma Import (C, fl_text_display_set_cursor_style, "fl_text_display_set_cursor_style"); + pragma Inline (fl_text_display_set_cursor_style); + + procedure fl_text_display_hide_cursor + (TD : in Storage.Integer_Address); + pragma Import (C, fl_text_display_hide_cursor, "fl_text_display_hide_cursor"); + pragma Inline (fl_text_display_hide_cursor); + + procedure fl_text_display_show_cursor + (TD : in Storage.Integer_Address); + pragma Import (C, fl_text_display_show_cursor, "fl_text_display_show_cursor"); + pragma Inline (fl_text_display_show_cursor); + + + + + function fl_text_display_get_text_color + (TD : in Storage.Integer_Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_text_display_get_text_color, "fl_text_display_get_text_color"); + pragma Inline (fl_text_display_get_text_color); + + procedure fl_text_display_set_text_color + (TD : in Storage.Integer_Address; + C : in Interfaces.C.unsigned); + pragma Import (C, fl_text_display_set_text_color, "fl_text_display_set_text_color"); + pragma Inline (fl_text_display_set_text_color); + + function fl_text_display_get_text_font + (TD : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_get_text_font, "fl_text_display_get_text_font"); + pragma Inline (fl_text_display_get_text_font); + + procedure fl_text_display_set_text_font + (TD : in Storage.Integer_Address; + F : in Interfaces.C.int); + pragma Import (C, fl_text_display_set_text_font, "fl_text_display_set_text_font"); + pragma Inline (fl_text_display_set_text_font); + + function fl_text_display_get_text_size + (TD : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_get_text_size, "fl_text_display_get_text_size"); + pragma Inline (fl_text_display_get_text_size); + + procedure fl_text_display_set_text_size + (TD : in Storage.Integer_Address; + S : in Interfaces.C.int); + pragma Import (C, fl_text_display_set_text_size, "fl_text_display_set_text_size"); + pragma Inline (fl_text_display_set_text_size); + + + + + procedure fl_text_display_insert + (TD : in Storage.Integer_Address; + I : in Interfaces.C.char_array); + pragma Import (C, fl_text_display_insert, "fl_text_display_insert"); + pragma Inline (fl_text_display_insert); + + procedure fl_text_display_overstrike + (TD : in Storage.Integer_Address; + T : in Interfaces.C.char_array); + pragma Import (C, fl_text_display_overstrike, "fl_text_display_overstrike"); + pragma Inline (fl_text_display_overstrike); + + function fl_text_display_get_insert_pos + (TD : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_get_insert_pos, "fl_text_display_get_insert_pos"); + pragma Inline (fl_text_display_get_insert_pos); + + procedure fl_text_display_set_insert_pos + (TD : in Storage.Integer_Address; + P : in Interfaces.C.int); + pragma Import (C, fl_text_display_set_insert_pos, "fl_text_display_set_insert_pos"); + pragma Inline (fl_text_display_set_insert_pos); + + procedure fl_text_display_show_insert_pos + (TD : in Storage.Integer_Address); + pragma Import (C, fl_text_display_show_insert_pos, "fl_text_display_show_insert_pos"); + pragma Inline (fl_text_display_show_insert_pos); + + + + + function fl_text_display_word_start + (TD : in Storage.Integer_Address; + P : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_display_word_start, "fl_text_display_word_start"); + pragma Inline (fl_text_display_word_start); + + function fl_text_display_word_end + (TD : in Storage.Integer_Address; + P : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_display_word_end, "fl_text_display_word_end"); + pragma Inline (fl_text_display_word_end); + + procedure fl_text_display_next_word + (TD : in Storage.Integer_Address); + pragma Import (C, fl_text_display_next_word, "fl_text_display_next_word"); + pragma Inline (fl_text_display_next_word); + + procedure fl_text_display_previous_word + (TD : in Storage.Integer_Address); + pragma Import (C, fl_text_display_previous_word, "fl_text_display_previous_word"); + pragma Inline (fl_text_display_previous_word); + + procedure fl_text_display_wrap_mode + (TD : in Storage.Integer_Address; + W, M : in Interfaces.C.int); + pragma Import (C, fl_text_display_wrap_mode, "fl_text_display_wrap_mode"); + pragma Inline (fl_text_display_wrap_mode); + + + + + function fl_text_display_line_start + (TD : in Storage.Integer_Address; + S : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_display_line_start, "fl_text_display_line_start"); + pragma Inline (fl_text_display_line_start); + + function fl_text_display_line_end + (TD : in Storage.Integer_Address; + S, P : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_display_line_end, "fl_text_display_line_end"); + pragma Inline (fl_text_display_line_end); + + function fl_text_display_count_lines + (TD : in Storage.Integer_Address; + S, F, P : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_display_count_lines, "fl_text_display_count_lines"); + pragma Inline (fl_text_display_count_lines); + + function fl_text_display_skip_lines + (TD : in Storage.Integer_Address; + S, L, P : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_display_skip_lines, "fl_text_display_skip_lines"); + pragma Inline (fl_text_display_skip_lines); + + function fl_text_display_rewind_lines + (TD : in Storage.Integer_Address; + S, L : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_display_rewind_lines, "fl_text_display_rewind_lines"); + pragma Inline (fl_text_display_rewind_lines); + + + + + function fl_text_display_get_linenumber_align + (TD : in Storage.Integer_Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_text_display_get_linenumber_align, + "fl_text_display_get_linenumber_align"); + pragma Inline (fl_text_display_get_linenumber_align); + + procedure fl_text_display_set_linenumber_align + (TD : in Storage.Integer_Address; + A : in Interfaces.C.unsigned); + pragma Import (C, fl_text_display_set_linenumber_align, + "fl_text_display_set_linenumber_align"); + pragma Inline (fl_text_display_set_linenumber_align); + + function fl_text_display_get_linenumber_bgcolor + (TD : in Storage.Integer_Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_text_display_get_linenumber_bgcolor, + "fl_text_display_get_linenumber_bgcolor"); + pragma Inline (fl_text_display_get_linenumber_bgcolor); + + procedure fl_text_display_set_linenumber_bgcolor + (TD : in Storage.Integer_Address; + C : in Interfaces.C.unsigned); + pragma Import (C, fl_text_display_set_linenumber_bgcolor, + "fl_text_display_set_linenumber_bgcolor"); + pragma Inline (fl_text_display_set_linenumber_bgcolor); + + function fl_text_display_get_linenumber_fgcolor + (TD : in Storage.Integer_Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_text_display_get_linenumber_fgcolor, + "fl_text_display_get_linenumber_fgcolor"); + pragma Inline (fl_text_display_get_linenumber_fgcolor); + + procedure fl_text_display_set_linenumber_fgcolor + (TD : in Storage.Integer_Address; + C : in Interfaces.C.unsigned); + pragma Import (C, fl_text_display_set_linenumber_fgcolor, + "fl_text_display_set_linenumber_fgcolor"); + pragma Inline (fl_text_display_set_linenumber_fgcolor); + + function fl_text_display_get_linenumber_font + (TD : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_get_linenumber_font, + "fl_text_display_get_linenumber_font"); + pragma Inline (fl_text_display_get_linenumber_font); + + procedure fl_text_display_set_linenumber_font + (TD : in Storage.Integer_Address; + F : in Interfaces.C.int); + pragma Import (C, fl_text_display_set_linenumber_font, + "fl_text_display_set_linenumber_font"); + pragma Inline (fl_text_display_set_linenumber_font); + + function fl_text_display_get_linenumber_size + (TD : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_get_linenumber_size, + "fl_text_display_get_linenumber_size"); + pragma Inline (fl_text_display_get_linenumber_size); + + procedure fl_text_display_set_linenumber_size + (TD : in Storage.Integer_Address; + S : in Interfaces.C.int); + pragma Import (C, fl_text_display_set_linenumber_size, + "fl_text_display_set_linenumber_size"); + pragma Inline (fl_text_display_set_linenumber_size); + + function fl_text_display_get_linenumber_width + (TD : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_get_linenumber_width, + "fl_text_display_get_linenumber_width"); + pragma Inline (fl_text_display_get_linenumber_width); + + procedure fl_text_display_set_linenumber_width + (TD : in Storage.Integer_Address; + W : in Interfaces.C.int); + pragma Import (C, fl_text_display_set_linenumber_width, + "fl_text_display_set_linenumber_width"); + pragma Inline (fl_text_display_set_linenumber_width); + + + + + function fl_text_display_move_down + (TD : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_move_down, "fl_text_display_move_down"); + pragma Inline (fl_text_display_move_down); + + function fl_text_display_move_left + (TD : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_move_left, "fl_text_display_move_left"); + pragma Inline (fl_text_display_move_left); + + function fl_text_display_move_right + (TD : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_move_right, "fl_text_display_move_right"); + pragma Inline (fl_text_display_move_right); + + function fl_text_display_move_up + (TD : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_move_up, "fl_text_display_move_up"); + pragma Inline (fl_text_display_move_up); + + + + + procedure fl_text_display_scroll + (TD : in Storage.Integer_Address; + L : in Interfaces.C.int); + pragma Import (C, fl_text_display_scroll, "fl_text_display_scroll"); + pragma Inline (fl_text_display_scroll); + + function fl_text_display_get_scrollbar_align + (TD : in Storage.Integer_Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_text_display_get_scrollbar_align, "fl_text_display_get_scrollbar_align"); + pragma Inline (fl_text_display_get_scrollbar_align); + + procedure fl_text_display_set_scrollbar_align + (TD : in Storage.Integer_Address; + A : in Interfaces.C.unsigned); + pragma Import (C, fl_text_display_set_scrollbar_align, "fl_text_display_set_scrollbar_align"); + pragma Inline (fl_text_display_set_scrollbar_align); + + function fl_text_display_get_scrollbar_width + (TD : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_get_scrollbar_width, "fl_text_display_get_scrollbar_width"); + pragma Inline (fl_text_display_get_scrollbar_width); + + procedure fl_text_display_set_scrollbar_width + (TD : in Storage.Integer_Address; + W : in Interfaces.C.int); + pragma Import (C, fl_text_display_set_scrollbar_width, "fl_text_display_set_scrollbar_width"); + pragma Inline (fl_text_display_set_scrollbar_width); + + + + + procedure fl_text_display_redisplay_range + (TD : in Storage.Integer_Address; + S, F : in Interfaces.C.int); + pragma Import (C, fl_text_display_redisplay_range, "fl_text_display_redisplay_range"); + pragma Inline (fl_text_display_redisplay_range); + + procedure fl_text_display_draw + (W : in Storage.Integer_Address); + pragma Import (C, fl_text_display_draw, "fl_text_display_draw"); + pragma Inline (fl_text_display_draw); + + function fl_text_display_handle + (W : in Storage.Integer_Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_display_handle, "fl_text_display_handle"); + pragma Inline (fl_text_display_handle); + + + + + ---------------------- + -- Callback Hooks -- + ---------------------- + + procedure Style_Hook + (C : in Interfaces.C.int; + D : in Storage.Integer_Address) + is + use Styles; -- for maximum stylin' + + Ada_Widget : access Text_Display'Class := + Text_Display_Convert.To_Pointer (Storage.To_Address (D)); + begin + if Ada_Widget.Style_Callback /= null then + Ada_Widget.Style_Callback (Character'Val (C), Text_Display (Ada_Widget.all)); + end if; + end Style_Hook; + + + + + ------------------- + -- Destructors -- + ------------------- + + procedure Extra_Final + (This : in out Text_Display) is + begin + Extra_Final (Group (This)); + end Extra_Final; + + + procedure Finalize + (This : in out Text_Display) is + begin + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_text_display (This.Void_Ptr); + This.Void_Ptr := Null_Pointer; + if This.Raw_Buffer /= Null_Pointer then + free_fl_text_buffer (This.Raw_Buffer); -- buffer is reference counted + This.Raw_Buffer := Null_Pointer; + end if; + end if; + end Finalize; + + + + + -------------------- + -- Constructors -- + -------------------- + + procedure Extra_Init + (This : in out Text_Display; + X, Y, W, H : in Integer; + Text : in String) is + begin + Extra_Init (Group (This), X, Y, W, H, Text); + end Extra_Init; + + + procedure Initialize + (This : in out Text_Display) is + begin + This.Draw_Ptr := fl_text_display_draw'Address; + This.Handle_Ptr := fl_text_display_handle'Address; + end Initialize; + + + package body Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Text_Display is + begin + return This : Text_Display do + This.Void_Ptr := new_fl_text_display + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + Extra_Init (This, X, Y, W, H, Text); + end return; + end Create; + + + function Create + (Parent : in out Group'Class; + X, Y, W, H : in Integer; + Text : in String := "") + return Text_Display is + begin + return This : Text_Display := Create (X, Y, W, H, Text) do + Parent.Add (This); + end return; + end Create; + + end Forge; + + + + + ---------------------- + -- Child Packages -- + ---------------------- + + package body Styles is + + function Item + (Tint : in Color; + Font : in Font_Kind; + Size : in Font_Size) + return Style_Entry is + begin + return This : Style_Entry do + This.Attr := 0; + This.Col := Interfaces.C.unsigned (Tint); + This.Font := Font_Kind'Pos (Font); + This.Size := Interfaces.C.int (Size); + end return; + end Item; + + pragma Inline (Item); + + end Styles; + + + + + ----------------------- + -- API Subprograms -- + ----------------------- + + function Get_Buffer + (This : in Text_Display) + return FLTK.Text_Buffers.Text_Buffer_Reference is + begin + return Ref : FLTK.Text_Buffers.Text_Buffer_Reference (This.Buffer); + end Get_Buffer; + + + procedure Set_Buffer + (This : in out Text_Display; + Buff : in out FLTK.Text_Buffers.Text_Buffer) is + begin + This.Buffer := Buff'Unchecked_Access; + fl_text_display_set_buffer (This.Void_Ptr, Wrapper (Buff).Void_Ptr); + if This.Raw_Buffer /= Null_Pointer then + free_fl_text_buffer (This.Raw_Buffer); + end if; + This.Raw_Buffer := Wrapper (Buff).Void_Ptr; + upref_fl_text_buffer (This.Raw_Buffer); + end Set_Buffer; + + + + + procedure Highlight_Data + (This : in out Text_Display; + Buff : in out FLTK.Text_Buffers.Text_Buffer; + Table : in Styles.Style_Array) is + begin + fl_text_display_highlight_data + (This.Void_Ptr, + Wrapper (Buff).Void_Ptr, + Storage.To_Integer (Table'Address), + Table'Length); + end Highlight_Data; + + + procedure Highlight_Data + (This : in out Text_Display; + Buff : in out FLTK.Text_Buffers.Text_Buffer; + Table : in Styles.Style_Array; + Unfinished : in Styles.Style_Index; + Callback : in Styles.Unfinished_Style_Callback) is + begin + This.Style_Callback := Callback; + fl_text_display_highlight_data2 + (This.Void_Ptr, + Wrapper (Buff).Void_Ptr, + Storage.To_Integer (Table'Address), + Table'Length, + Character'Pos (Character (Unfinished)), + Storage.To_Integer (Style_Hook'Address), + Storage.To_Integer (This'Address)); + end Highlight_Data; + + + + + function Col_To_X + (This : in Text_Display; + Col_Num : in Integer) + return Integer is + begin + return Integer (Interfaces.C.double'Rounding + (fl_text_display_col_to_x (This.Void_Ptr, Interfaces.C.double (Col_Num)))); + end Col_To_X; + + + function X_To_Col + (This : in Text_Display; + X_Pos : in Integer) + return Integer is + begin + return Integer (Interfaces.C.double'Rounding + (fl_text_display_x_to_col (This.Void_Ptr, Interfaces.C.double (X_Pos)))); + end X_To_Col; + + + function In_Selection + (This : in Text_Display; + X, Y : in Integer) + return Boolean is + begin + return fl_text_display_in_selection + (This.Void_Ptr, Interfaces.C.int (X), Interfaces.C.int (Y)) /= 0; + end In_Selection; + + + procedure Position_To_XY + (This : in Text_Display; + Pos : in Integer; + X, Y : out Integer; + Vert_Out : out Boolean) is + begin + Vert_Out := fl_text_display_position_to_xy + (This.Void_Ptr, + Interfaces.C.int (Pos), + Interfaces.C.int (X), + Interfaces.C.int (Y)) /= 0; + end Position_To_XY; + + + + + function Get_Cursor_Color + (This : in Text_Display) + return Color is + begin + return Color (fl_text_display_get_cursor_color (This.Void_Ptr)); + end Get_Cursor_Color; + + + procedure Set_Cursor_Color + (This : in out Text_Display; + Col : in Color) is + begin + fl_text_display_set_cursor_color (This.Void_Ptr, Interfaces.C.unsigned (Col)); + end Set_Cursor_Color; + + + procedure Set_Cursor_Style + (This : in out Text_Display; + Style : in Cursor_Style) is + begin + fl_text_display_set_cursor_style (This.Void_Ptr, Cursor_Style'Pos (Style)); + end Set_Cursor_Style; + + + procedure Hide_Cursor + (This : in out Text_Display) is + begin + fl_text_display_hide_cursor (This.Void_Ptr); + end Hide_Cursor; + + + procedure Show_Cursor + (This : in out Text_Display) is + begin + fl_text_display_show_cursor (This.Void_Ptr); + end Show_Cursor; + + + + + function Get_Text_Color + (This : in Text_Display) + return Color is + begin + return Color (fl_text_display_get_text_color (This.Void_Ptr)); + end Get_Text_Color; + + + procedure Set_Text_Color + (This : in out Text_Display; + Col : in Color) is + begin + fl_text_display_set_text_color (This.Void_Ptr, Interfaces.C.unsigned (Col)); + end Set_Text_Color; + + + function Get_Text_Font + (This : in Text_Display) + return Font_Kind is + begin + return Font_Kind'Val (fl_text_display_get_text_font (This.Void_Ptr)); + end Get_Text_Font; + + + procedure Set_Text_Font + (This : in out Text_Display; + Font : in Font_Kind) is + begin + fl_text_display_set_text_font (This.Void_Ptr, Font_Kind'Pos (Font)); + end Set_Text_Font; + + + function Get_Text_Size + (This : in Text_Display) + return Font_Size is + begin + return Font_Size (fl_text_display_get_text_size (This.Void_Ptr)); + end Get_Text_Size; + + + procedure Set_Text_Size + (This : in out Text_Display; + Size : in Font_Size) is + begin + fl_text_display_set_text_size (This.Void_Ptr, Interfaces.C.int (Size)); + end Set_Text_Size; + + + + + procedure Insert_Text + (This : in out Text_Display; + Item : in String) is + begin + fl_text_display_insert (This.Void_Ptr, Interfaces.C.To_C (Item)); + end Insert_Text; + + + procedure Overstrike + (This : in out Text_Display; + Text : in String) is + begin + fl_text_display_overstrike (This.Void_Ptr, Interfaces.C.To_C (Text)); + end Overstrike; + + + function Get_Insert_Position + (This : in Text_Display) + return Natural is + begin + return Natural (fl_text_display_get_insert_pos (This.Void_Ptr)); + end Get_Insert_Position; + + + procedure Set_Insert_Position + (This : in out Text_Display; + Pos : in Natural) is + begin + fl_text_display_set_insert_pos (This.Void_Ptr, Interfaces.C.int (Pos)); + end Set_Insert_Position; + + + procedure Show_Insert_Position + (This : in out Text_Display) is + begin + fl_text_display_show_insert_pos (This.Void_Ptr); + end Show_Insert_Position; + + + + + function Word_Start + (This : in out Text_Display; + Pos : in Natural) + return Natural is + begin + return Natural (fl_text_display_word_start + (This.Void_Ptr, + Interfaces.C.int (Pos))); + end Word_Start; + + + function Word_End + (This : in out Text_Display; + Pos : in Natural) + return Natural is + begin + return Natural (fl_text_display_word_end + (This.Void_Ptr, + Interfaces.C.int (Pos))); + end Word_End; + + + procedure Next_Word + (This : in out Text_Display) is + begin + fl_text_display_next_word (This.Void_Ptr); + end Next_Word; + + + procedure Previous_Word + (This : in out Text_Display) is + begin + fl_text_display_previous_word (This.Void_Ptr); + end Previous_Word; + + + procedure Set_Wrap_Mode + (This : in out Text_Display; + Mode : in Wrap_Mode; + Margin : in Natural := 0) is + begin + fl_text_display_wrap_mode + (This.Void_Ptr, + Wrap_Mode'Pos (Mode), + Interfaces.C.int (Margin)); + end Set_Wrap_Mode; + + + + + function Line_Start + (This : in Text_Display; + Pos : in Natural) + return Natural is + begin + return Natural (fl_text_display_line_start + (This.Void_Ptr, + Interfaces.C.int (Pos))); + end Line_Start; + + + function Line_End + (This : in Text_Display; + Pos : in Natural; + Start_Pos_Is_Line_Start : in Boolean := False) + return Natural is + begin + return Natural (fl_text_display_line_end + (This.Void_Ptr, + Interfaces.C.int (Pos), + Boolean'Pos (Start_Pos_Is_Line_Start))); + end Line_End; + + + function Count_Lines + (This : in Text_Display; + Start, Finish : in Natural; + Start_Pos_Is_Line_Start : in Boolean := False) + return Natural is + begin + return Natural (fl_text_display_count_lines + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish), + Boolean'Pos (Start_Pos_Is_Line_Start))); + end Count_Lines; + + + function Skip_Lines + (This : in Text_Display; + Start, Lines : in Natural; + Start_Pos_Is_Line_Start : in Boolean := False) + return Natural is + begin + return Natural (fl_text_display_skip_lines + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Lines), + Boolean'Pos (Start_Pos_Is_Line_Start))); + end Skip_Lines; + + + function Rewind_Lines + (This : in Text_Display; + Start, Lines : in Natural) + return Natural is + begin + return Natural (fl_text_display_rewind_lines + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Lines))); + end Rewind_Lines; + + + + + function Get_Linenumber_Alignment + (This : in Text_Display) + return Alignment is + begin + return Alignment (fl_text_display_get_linenumber_align (This.Void_Ptr)); + end Get_Linenumber_Alignment; + + + procedure Set_Linenumber_Alignment + (This : in out Text_Display; + To : in Alignment) is + begin + fl_text_display_set_linenumber_align + (This.Void_Ptr, + Interfaces.C.unsigned (To)); + end Set_Linenumber_Alignment; + + + function Get_Linenumber_Back_Color + (This : in Text_Display) + return Color is + begin + return Color (fl_text_display_get_linenumber_bgcolor (This.Void_Ptr)); + end Get_Linenumber_Back_Color; + + + procedure Set_Linenumber_Back_Color + (This : in out Text_Display; + To : in Color) is + begin + fl_text_display_set_linenumber_bgcolor + (This.Void_Ptr, + Interfaces.C.unsigned (To)); + end Set_Linenumber_Back_Color; + + + function Get_Linenumber_Fore_Color + (This : in Text_Display) + return Color is + begin + return Color (fl_text_display_get_linenumber_fgcolor (This.Void_Ptr)); + end Get_Linenumber_Fore_Color; + + + procedure Set_Linenumber_Fore_Color + (This : in out Text_Display; + To : in Color) is + begin + fl_text_display_set_linenumber_fgcolor + (This.Void_Ptr, + Interfaces.C.unsigned (To)); + end Set_Linenumber_Fore_Color; + + + function Get_Linenumber_Font + (This : in Text_Display) + return Font_Kind is + begin + return Font_Kind'Val (fl_text_display_get_linenumber_font (This.Void_Ptr)); + end Get_Linenumber_Font; + + + procedure Set_Linenumber_Font + (This : in out Text_Display; + To : in Font_Kind) is + begin + fl_text_display_set_linenumber_font + (This.Void_Ptr, + Font_Kind'Pos (To)); + end Set_Linenumber_Font; + + + function Get_Linenumber_Size + (This : in Text_Display) + return Font_Size is + begin + return Font_Size (fl_text_display_get_linenumber_size (This.Void_Ptr)); + end Get_Linenumber_Size; + + + procedure Set_Linenumber_Size + (This : in out Text_Display; + To : in Font_Size) is + begin + fl_text_display_set_linenumber_size + (This.Void_Ptr, + Interfaces.C.int (To)); + end Set_Linenumber_Size; + + + function Get_Linenumber_Width + (This : in Text_Display) + return Natural is + begin + return Natural (fl_text_display_get_linenumber_width (This.Void_Ptr)); + end Get_Linenumber_Width; + + + procedure Set_Linenumber_Width + (This : in out Text_Display; + Width : in Natural) is + begin + fl_text_display_set_linenumber_width + (This.Void_Ptr, + Interfaces.C.int (Width)); + end Set_Linenumber_Width; + + + + + procedure Move_Down + (This : in out Text_Display) is + begin + if fl_text_display_move_down (This.Void_Ptr) = 0 then + raise Bounds_Error; + end if; + end Move_Down; + + + procedure Move_Left + (This : in out Text_Display) is + begin + if fl_text_display_move_left (This.Void_Ptr) = 0 then + raise Bounds_Error; + end if; + end Move_Left; + + + procedure Move_Right + (This : in out Text_Display) is + begin + if fl_text_display_move_right (This.Void_Ptr) = 0 then + raise Bounds_Error; + end if; + end Move_Right; + + + procedure Move_Up + (This : in out Text_Display) is + begin + if fl_text_display_move_up (This.Void_Ptr) = 0 then + raise Bounds_Error; + end if; + end Move_Up; + + + + + procedure Scroll_To + (This : in out Text_Display; + Line : in Natural) is + begin + fl_text_display_scroll (This.Void_Ptr, Interfaces.C.int (Line)); + end Scroll_To; + + + function Get_Scrollbar_Alignment + (This : in Text_Display) + return Alignment is + begin + return Alignment (fl_text_display_get_scrollbar_align (This.Void_Ptr)); + end Get_Scrollbar_Alignment; + + + procedure Set_Scrollbar_Alignment + (This : in out Text_Display; + Align : in Alignment) is + begin + fl_text_display_set_scrollbar_align + (This.Void_Ptr, + Interfaces.C.unsigned (Align)); + end Set_Scrollbar_Alignment; + + + function Get_Scrollbar_Width + (This : in Text_Display) + return Natural is + begin + return Natural (fl_text_display_get_scrollbar_width (This.Void_Ptr)); + end Get_Scrollbar_Width; + + + procedure Set_Scrollbar_Width + (This : in out Text_Display; + Width : in Natural) is + begin + fl_text_display_set_scrollbar_width + (This.Void_Ptr, + Interfaces.C.int (Width)); + end Set_Scrollbar_Width; + + + + + procedure Redisplay_Range + (This : in out Text_Display; + Start, Finish : in Natural) is + begin + fl_text_display_redisplay_range + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish)); + end Redisplay_Range; + + + procedure Draw + (This : in out Text_Display) is + begin + Group (This).Draw; + end Draw; + + + function Handle + (This : in out Text_Display; + Event : in Event_Kind) + return Event_Outcome is + begin + return Group (This).Handle (Event); + end Handle; + + +end FLTK.Widgets.Groups.Text_Displays; + + |