From 0d842f0423ba0754fb3675c7468397a8da5f6e1b Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Thu, 27 Apr 2017 10:40:48 +1000 Subject: Organising source --- c_fl.cpp | 10 - c_fl.h | 11 - c_fl_box.cpp | 16 - c_fl_box.h | 15 - c_fl_button.cpp | 31 -- c_fl_button.h | 19 - c_fl_check_button.cpp | 16 - c_fl_check_button.h | 15 - c_fl_dialog.cpp | 32 -- c_fl_dialog.h | 15 - c_fl_double_window.cpp | 32 -- c_fl_double_window.h | 19 - c_fl_group.cpp | 69 --- c_fl_group.h | 29 -- c_fl_image.cpp | 33 -- c_fl_image.h | 20 - c_fl_input.cpp | 21 - c_fl_input.h | 18 - c_fl_int_input.cpp | 21 - c_fl_int_input.h | 18 - c_fl_light_button.cpp | 16 - c_fl_light_button.h | 15 - c_fl_menu.cpp | 38 -- c_fl_menu.h | 22 - c_fl_menu_bar.cpp | 16 - c_fl_menu_bar.h | 15 - c_fl_menu_button.cpp | 21 - c_fl_menu_button.h | 18 - c_fl_menu_window.cpp | 52 -- c_fl_menu_window.h | 23 - c_fl_png_image.cpp | 16 - c_fl_png_image.h | 15 - c_fl_radio_button.cpp | 16 - c_fl_radio_button.h | 15 - c_fl_radio_light_button.cpp | 16 - c_fl_radio_light_button.h | 15 - c_fl_radio_round_button.cpp | 16 - c_fl_radio_round_button.h | 15 - c_fl_repeat_button.cpp | 16 - c_fl_repeat_button.h | 15 - c_fl_return_button.cpp | 16 - c_fl_return_button.h | 15 - c_fl_round_button.cpp | 16 - c_fl_round_button.h | 15 - c_fl_single_window.cpp | 32 -- c_fl_single_window.h | 19 - c_fl_text_buffer.cpp | 111 ----- c_fl_text_buffer.h | 36 -- c_fl_text_display.cpp | 105 ---- c_fl_text_display.h | 35 -- c_fl_text_editor.cpp | 48 -- c_fl_text_editor.h | 23 - c_fl_toggle_button.cpp | 16 - c_fl_toggle_button.h | 15 - c_fl_widget.cpp | 119 ----- c_fl_widget.h | 40 -- c_fl_window.cpp | 58 --- c_fl_window.h | 24 - fltk-dialogs.adb | 111 ----- fltk-dialogs.ads | 33 -- fltk-enum_values.ads | 7 - fltk-enums.adb | 71 --- fltk-enums.ads | 146 ------ fltk-images-rgb-png.adb | 49 -- fltk-images-rgb-png.ads | 25 - fltk-images-rgb.adb | 14 - fltk-images-rgb.ads | 20 - fltk-images.adb | 96 ---- fltk-images.ads | 40 -- fltk-text_buffers.adb | 540 --------------------- fltk-text_buffers.ads | 180 ------- fltk-widgets-boxes.adb | 58 --- fltk-widgets-boxes.ads | 26 - fltk-widgets-buttons-enter.adb | 58 --- fltk-widgets-buttons-enter.ads | 29 -- fltk-widgets-buttons-light-check.adb | 58 --- fltk-widgets-buttons-light-check.ads | 26 - fltk-widgets-buttons-light-radio.adb | 58 --- fltk-widgets-buttons-light-radio.ads | 26 - fltk-widgets-buttons-light-round-radio.adb | 58 --- fltk-widgets-buttons-light-round-radio.ads | 26 - fltk-widgets-buttons-light-round.adb | 58 --- fltk-widgets-buttons-light-round.ads | 26 - fltk-widgets-buttons-light.adb | 58 --- fltk-widgets-buttons-light.ads | 26 - fltk-widgets-buttons-radio.adb | 58 --- fltk-widgets-buttons-radio.ads | 26 - fltk-widgets-buttons-repeat.adb | 58 --- fltk-widgets-buttons-repeat.ads | 26 - fltk-widgets-buttons-toggle.adb | 58 --- fltk-widgets-buttons-toggle.ads | 26 - fltk-widgets-buttons.adb | 101 ---- fltk-widgets-buttons.ads | 43 -- fltk-widgets-groups-text_displays-text_editors.adb | 145 ------ fltk-widgets-groups-text_displays-text_editors.ads | 54 --- fltk-widgets-groups-text_displays.adb | 327 ------------- fltk-widgets-groups-text_displays.ads | 124 ----- fltk-widgets-groups-windows-double.adb | 108 ----- fltk-widgets-groups-windows-double.ads | 39 -- fltk-widgets-groups-windows-single-menu.adb | 158 ------ fltk-widgets-groups-windows-single-menu.ads | 53 -- fltk-widgets-groups-windows-single.adb | 108 ----- fltk-widgets-groups-windows-single.ads | 39 -- fltk-widgets-groups-windows.adb | 191 -------- fltk-widgets-groups-windows.ads | 67 --- fltk-widgets-groups.adb | 202 -------- fltk-widgets-groups.ads | 82 ---- fltk-widgets-inputs-int.adb | 75 --- fltk-widgets-inputs-int.ads | 31 -- fltk-widgets-inputs.adb | 74 --- fltk-widgets-inputs.ads | 31 -- fltk-widgets-menus-menu_bars.adb | 58 --- fltk-widgets-menus-menu_bars.ads | 26 - fltk-widgets-menus-menu_buttons.adb | 73 --- fltk-widgets-menus-menu_buttons.ads | 35 -- fltk-widgets-menus.adb | 160 ------ fltk-widgets-menus.ads | 97 ---- fltk-widgets.adb | 352 -------------- fltk-widgets.ads | 162 ------- fltk.adb | 44 -- fltk.ads | 43 -- lib/.gitignore | 4 + obj/.gitignore | 4 + src/c_fl.cpp | 10 + src/c_fl.h | 11 + src/c_fl_box.cpp | 16 + src/c_fl_box.h | 15 + src/c_fl_button.cpp | 31 ++ src/c_fl_button.h | 19 + src/c_fl_check_button.cpp | 16 + src/c_fl_check_button.h | 15 + src/c_fl_dialog.cpp | 32 ++ src/c_fl_dialog.h | 15 + src/c_fl_double_window.cpp | 32 ++ src/c_fl_double_window.h | 19 + src/c_fl_group.cpp | 69 +++ src/c_fl_group.h | 29 ++ src/c_fl_image.cpp | 33 ++ src/c_fl_image.h | 20 + src/c_fl_input.cpp | 21 + src/c_fl_input.h | 18 + src/c_fl_int_input.cpp | 21 + src/c_fl_int_input.h | 18 + src/c_fl_light_button.cpp | 16 + src/c_fl_light_button.h | 15 + src/c_fl_menu.cpp | 38 ++ src/c_fl_menu.h | 22 + src/c_fl_menu_bar.cpp | 16 + src/c_fl_menu_bar.h | 15 + src/c_fl_menu_button.cpp | 21 + src/c_fl_menu_button.h | 18 + src/c_fl_menu_window.cpp | 52 ++ src/c_fl_menu_window.h | 23 + src/c_fl_png_image.cpp | 16 + src/c_fl_png_image.h | 15 + src/c_fl_radio_button.cpp | 16 + src/c_fl_radio_button.h | 15 + src/c_fl_radio_light_button.cpp | 16 + src/c_fl_radio_light_button.h | 15 + src/c_fl_radio_round_button.cpp | 16 + src/c_fl_radio_round_button.h | 15 + src/c_fl_repeat_button.cpp | 16 + src/c_fl_repeat_button.h | 15 + src/c_fl_return_button.cpp | 16 + src/c_fl_return_button.h | 15 + src/c_fl_round_button.cpp | 16 + src/c_fl_round_button.h | 15 + src/c_fl_single_window.cpp | 32 ++ src/c_fl_single_window.h | 19 + src/c_fl_text_buffer.cpp | 111 +++++ src/c_fl_text_buffer.h | 36 ++ src/c_fl_text_display.cpp | 105 ++++ src/c_fl_text_display.h | 35 ++ src/c_fl_text_editor.cpp | 48 ++ src/c_fl_text_editor.h | 23 + src/c_fl_toggle_button.cpp | 16 + src/c_fl_toggle_button.h | 15 + src/c_fl_widget.cpp | 119 +++++ src/c_fl_widget.h | 40 ++ src/c_fl_window.cpp | 58 +++ src/c_fl_window.h | 24 + src/fltk-dialogs.adb | 111 +++++ src/fltk-dialogs.ads | 33 ++ src/fltk-enum_values.ads | 7 + src/fltk-enums.adb | 71 +++ src/fltk-enums.ads | 146 ++++++ src/fltk-images-rgb-png.adb | 49 ++ src/fltk-images-rgb-png.ads | 25 + src/fltk-images-rgb.adb | 14 + src/fltk-images-rgb.ads | 20 + src/fltk-images.adb | 96 ++++ src/fltk-images.ads | 40 ++ src/fltk-text_buffers.adb | 540 +++++++++++++++++++++ src/fltk-text_buffers.ads | 180 +++++++ src/fltk-widgets-boxes.adb | 58 +++ src/fltk-widgets-boxes.ads | 26 + src/fltk-widgets-buttons-enter.adb | 58 +++ src/fltk-widgets-buttons-enter.ads | 29 ++ src/fltk-widgets-buttons-light-check.adb | 58 +++ src/fltk-widgets-buttons-light-check.ads | 26 + src/fltk-widgets-buttons-light-radio.adb | 58 +++ src/fltk-widgets-buttons-light-radio.ads | 26 + src/fltk-widgets-buttons-light-round-radio.adb | 58 +++ src/fltk-widgets-buttons-light-round-radio.ads | 26 + src/fltk-widgets-buttons-light-round.adb | 58 +++ src/fltk-widgets-buttons-light-round.ads | 26 + src/fltk-widgets-buttons-light.adb | 58 +++ src/fltk-widgets-buttons-light.ads | 26 + src/fltk-widgets-buttons-radio.adb | 58 +++ src/fltk-widgets-buttons-radio.ads | 26 + src/fltk-widgets-buttons-repeat.adb | 58 +++ src/fltk-widgets-buttons-repeat.ads | 26 + src/fltk-widgets-buttons-toggle.adb | 58 +++ src/fltk-widgets-buttons-toggle.ads | 26 + src/fltk-widgets-buttons.adb | 101 ++++ src/fltk-widgets-buttons.ads | 43 ++ ...k-widgets-groups-text_displays-text_editors.adb | 145 ++++++ ...k-widgets-groups-text_displays-text_editors.ads | 54 +++ src/fltk-widgets-groups-text_displays.adb | 327 +++++++++++++ src/fltk-widgets-groups-text_displays.ads | 124 +++++ src/fltk-widgets-groups-windows-double.adb | 108 +++++ src/fltk-widgets-groups-windows-double.ads | 39 ++ src/fltk-widgets-groups-windows-single-menu.adb | 158 ++++++ src/fltk-widgets-groups-windows-single-menu.ads | 53 ++ src/fltk-widgets-groups-windows-single.adb | 108 +++++ src/fltk-widgets-groups-windows-single.ads | 39 ++ src/fltk-widgets-groups-windows.adb | 191 ++++++++ src/fltk-widgets-groups-windows.ads | 67 +++ src/fltk-widgets-groups.adb | 202 ++++++++ src/fltk-widgets-groups.ads | 82 ++++ src/fltk-widgets-inputs-int.adb | 75 +++ src/fltk-widgets-inputs-int.ads | 31 ++ src/fltk-widgets-inputs.adb | 74 +++ src/fltk-widgets-inputs.ads | 31 ++ src/fltk-widgets-menus-menu_bars.adb | 58 +++ src/fltk-widgets-menus-menu_bars.ads | 26 + src/fltk-widgets-menus-menu_buttons.adb | 73 +++ src/fltk-widgets-menus-menu_buttons.ads | 35 ++ src/fltk-widgets-menus.adb | 160 ++++++ src/fltk-widgets-menus.ads | 97 ++++ src/fltk-widgets.adb | 352 ++++++++++++++ src/fltk-widgets.ads | 162 +++++++ src/fltk.adb | 44 ++ src/fltk.ads | 43 ++ 244 files changed, 6879 insertions(+), 6871 deletions(-) delete mode 100644 c_fl.cpp delete mode 100644 c_fl.h delete mode 100644 c_fl_box.cpp delete mode 100644 c_fl_box.h delete mode 100644 c_fl_button.cpp delete mode 100644 c_fl_button.h delete mode 100644 c_fl_check_button.cpp delete mode 100644 c_fl_check_button.h delete mode 100644 c_fl_dialog.cpp delete mode 100644 c_fl_dialog.h delete mode 100644 c_fl_double_window.cpp delete mode 100644 c_fl_double_window.h delete mode 100644 c_fl_group.cpp delete mode 100644 c_fl_group.h delete mode 100644 c_fl_image.cpp delete mode 100644 c_fl_image.h delete mode 100644 c_fl_input.cpp delete mode 100644 c_fl_input.h delete mode 100644 c_fl_int_input.cpp delete mode 100644 c_fl_int_input.h delete mode 100644 c_fl_light_button.cpp delete mode 100644 c_fl_light_button.h delete mode 100644 c_fl_menu.cpp delete mode 100644 c_fl_menu.h delete mode 100644 c_fl_menu_bar.cpp delete mode 100644 c_fl_menu_bar.h delete mode 100644 c_fl_menu_button.cpp delete mode 100644 c_fl_menu_button.h delete mode 100644 c_fl_menu_window.cpp delete mode 100644 c_fl_menu_window.h delete mode 100644 c_fl_png_image.cpp delete mode 100644 c_fl_png_image.h delete mode 100644 c_fl_radio_button.cpp delete mode 100644 c_fl_radio_button.h delete mode 100644 c_fl_radio_light_button.cpp delete mode 100644 c_fl_radio_light_button.h delete mode 100644 c_fl_radio_round_button.cpp delete mode 100644 c_fl_radio_round_button.h delete mode 100644 c_fl_repeat_button.cpp delete mode 100644 c_fl_repeat_button.h delete mode 100644 c_fl_return_button.cpp delete mode 100644 c_fl_return_button.h delete mode 100644 c_fl_round_button.cpp delete mode 100644 c_fl_round_button.h delete mode 100644 c_fl_single_window.cpp delete mode 100644 c_fl_single_window.h delete mode 100644 c_fl_text_buffer.cpp delete mode 100644 c_fl_text_buffer.h delete mode 100644 c_fl_text_display.cpp delete mode 100644 c_fl_text_display.h delete mode 100644 c_fl_text_editor.cpp delete mode 100644 c_fl_text_editor.h delete mode 100644 c_fl_toggle_button.cpp delete mode 100644 c_fl_toggle_button.h delete mode 100644 c_fl_widget.cpp delete mode 100644 c_fl_widget.h delete mode 100644 c_fl_window.cpp delete mode 100644 c_fl_window.h delete mode 100644 fltk-dialogs.adb delete mode 100644 fltk-dialogs.ads delete mode 100644 fltk-enum_values.ads delete mode 100644 fltk-enums.adb delete mode 100644 fltk-enums.ads delete mode 100644 fltk-images-rgb-png.adb delete mode 100644 fltk-images-rgb-png.ads delete mode 100644 fltk-images-rgb.adb delete mode 100644 fltk-images-rgb.ads delete mode 100644 fltk-images.adb delete mode 100644 fltk-images.ads delete mode 100644 fltk-text_buffers.adb delete mode 100644 fltk-text_buffers.ads delete mode 100644 fltk-widgets-boxes.adb delete mode 100644 fltk-widgets-boxes.ads delete mode 100644 fltk-widgets-buttons-enter.adb delete mode 100644 fltk-widgets-buttons-enter.ads delete mode 100644 fltk-widgets-buttons-light-check.adb delete mode 100644 fltk-widgets-buttons-light-check.ads delete mode 100644 fltk-widgets-buttons-light-radio.adb delete mode 100644 fltk-widgets-buttons-light-radio.ads delete mode 100644 fltk-widgets-buttons-light-round-radio.adb delete mode 100644 fltk-widgets-buttons-light-round-radio.ads delete mode 100644 fltk-widgets-buttons-light-round.adb delete mode 100644 fltk-widgets-buttons-light-round.ads delete mode 100644 fltk-widgets-buttons-light.adb delete mode 100644 fltk-widgets-buttons-light.ads delete mode 100644 fltk-widgets-buttons-radio.adb delete mode 100644 fltk-widgets-buttons-radio.ads delete mode 100644 fltk-widgets-buttons-repeat.adb delete mode 100644 fltk-widgets-buttons-repeat.ads delete mode 100644 fltk-widgets-buttons-toggle.adb delete mode 100644 fltk-widgets-buttons-toggle.ads delete mode 100644 fltk-widgets-buttons.adb delete mode 100644 fltk-widgets-buttons.ads delete mode 100644 fltk-widgets-groups-text_displays-text_editors.adb delete mode 100644 fltk-widgets-groups-text_displays-text_editors.ads delete mode 100644 fltk-widgets-groups-text_displays.adb delete mode 100644 fltk-widgets-groups-text_displays.ads delete mode 100644 fltk-widgets-groups-windows-double.adb delete mode 100644 fltk-widgets-groups-windows-double.ads delete mode 100644 fltk-widgets-groups-windows-single-menu.adb delete mode 100644 fltk-widgets-groups-windows-single-menu.ads delete mode 100644 fltk-widgets-groups-windows-single.adb delete mode 100644 fltk-widgets-groups-windows-single.ads delete mode 100644 fltk-widgets-groups-windows.adb delete mode 100644 fltk-widgets-groups-windows.ads delete mode 100644 fltk-widgets-groups.adb delete mode 100644 fltk-widgets-groups.ads delete mode 100644 fltk-widgets-inputs-int.adb delete mode 100644 fltk-widgets-inputs-int.ads delete mode 100644 fltk-widgets-inputs.adb delete mode 100644 fltk-widgets-inputs.ads delete mode 100644 fltk-widgets-menus-menu_bars.adb delete mode 100644 fltk-widgets-menus-menu_bars.ads delete mode 100644 fltk-widgets-menus-menu_buttons.adb delete mode 100644 fltk-widgets-menus-menu_buttons.ads delete mode 100644 fltk-widgets-menus.adb delete mode 100644 fltk-widgets-menus.ads delete mode 100644 fltk-widgets.adb delete mode 100644 fltk-widgets.ads delete mode 100644 fltk.adb delete mode 100644 fltk.ads create mode 100644 lib/.gitignore create mode 100644 obj/.gitignore create mode 100644 src/c_fl.cpp create mode 100644 src/c_fl.h create mode 100644 src/c_fl_box.cpp create mode 100644 src/c_fl_box.h create mode 100644 src/c_fl_button.cpp create mode 100644 src/c_fl_button.h create mode 100644 src/c_fl_check_button.cpp create mode 100644 src/c_fl_check_button.h create mode 100644 src/c_fl_dialog.cpp create mode 100644 src/c_fl_dialog.h create mode 100644 src/c_fl_double_window.cpp create mode 100644 src/c_fl_double_window.h create mode 100644 src/c_fl_group.cpp create mode 100644 src/c_fl_group.h create mode 100644 src/c_fl_image.cpp create mode 100644 src/c_fl_image.h create mode 100644 src/c_fl_input.cpp create mode 100644 src/c_fl_input.h create mode 100644 src/c_fl_int_input.cpp create mode 100644 src/c_fl_int_input.h create mode 100644 src/c_fl_light_button.cpp create mode 100644 src/c_fl_light_button.h create mode 100644 src/c_fl_menu.cpp create mode 100644 src/c_fl_menu.h create mode 100644 src/c_fl_menu_bar.cpp create mode 100644 src/c_fl_menu_bar.h create mode 100644 src/c_fl_menu_button.cpp create mode 100644 src/c_fl_menu_button.h create mode 100644 src/c_fl_menu_window.cpp create mode 100644 src/c_fl_menu_window.h create mode 100644 src/c_fl_png_image.cpp create mode 100644 src/c_fl_png_image.h create mode 100644 src/c_fl_radio_button.cpp create mode 100644 src/c_fl_radio_button.h create mode 100644 src/c_fl_radio_light_button.cpp create mode 100644 src/c_fl_radio_light_button.h create mode 100644 src/c_fl_radio_round_button.cpp create mode 100644 src/c_fl_radio_round_button.h create mode 100644 src/c_fl_repeat_button.cpp create mode 100644 src/c_fl_repeat_button.h create mode 100644 src/c_fl_return_button.cpp create mode 100644 src/c_fl_return_button.h create mode 100644 src/c_fl_round_button.cpp create mode 100644 src/c_fl_round_button.h create mode 100644 src/c_fl_single_window.cpp create mode 100644 src/c_fl_single_window.h create mode 100644 src/c_fl_text_buffer.cpp create mode 100644 src/c_fl_text_buffer.h create mode 100644 src/c_fl_text_display.cpp create mode 100644 src/c_fl_text_display.h create mode 100644 src/c_fl_text_editor.cpp create mode 100644 src/c_fl_text_editor.h create mode 100644 src/c_fl_toggle_button.cpp create mode 100644 src/c_fl_toggle_button.h create mode 100644 src/c_fl_widget.cpp create mode 100644 src/c_fl_widget.h create mode 100644 src/c_fl_window.cpp create mode 100644 src/c_fl_window.h create mode 100644 src/fltk-dialogs.adb create mode 100644 src/fltk-dialogs.ads create mode 100644 src/fltk-enum_values.ads create mode 100644 src/fltk-enums.adb create mode 100644 src/fltk-enums.ads create mode 100644 src/fltk-images-rgb-png.adb create mode 100644 src/fltk-images-rgb-png.ads create mode 100644 src/fltk-images-rgb.adb create mode 100644 src/fltk-images-rgb.ads create mode 100644 src/fltk-images.adb create mode 100644 src/fltk-images.ads create mode 100644 src/fltk-text_buffers.adb create mode 100644 src/fltk-text_buffers.ads create mode 100644 src/fltk-widgets-boxes.adb create mode 100644 src/fltk-widgets-boxes.ads create mode 100644 src/fltk-widgets-buttons-enter.adb create mode 100644 src/fltk-widgets-buttons-enter.ads create mode 100644 src/fltk-widgets-buttons-light-check.adb create mode 100644 src/fltk-widgets-buttons-light-check.ads create mode 100644 src/fltk-widgets-buttons-light-radio.adb create mode 100644 src/fltk-widgets-buttons-light-radio.ads create mode 100644 src/fltk-widgets-buttons-light-round-radio.adb create mode 100644 src/fltk-widgets-buttons-light-round-radio.ads create mode 100644 src/fltk-widgets-buttons-light-round.adb create mode 100644 src/fltk-widgets-buttons-light-round.ads create mode 100644 src/fltk-widgets-buttons-light.adb create mode 100644 src/fltk-widgets-buttons-light.ads create mode 100644 src/fltk-widgets-buttons-radio.adb create mode 100644 src/fltk-widgets-buttons-radio.ads create mode 100644 src/fltk-widgets-buttons-repeat.adb create mode 100644 src/fltk-widgets-buttons-repeat.ads create mode 100644 src/fltk-widgets-buttons-toggle.adb create mode 100644 src/fltk-widgets-buttons-toggle.ads create mode 100644 src/fltk-widgets-buttons.adb create mode 100644 src/fltk-widgets-buttons.ads create mode 100644 src/fltk-widgets-groups-text_displays-text_editors.adb create mode 100644 src/fltk-widgets-groups-text_displays-text_editors.ads create mode 100644 src/fltk-widgets-groups-text_displays.adb create mode 100644 src/fltk-widgets-groups-text_displays.ads create mode 100644 src/fltk-widgets-groups-windows-double.adb create mode 100644 src/fltk-widgets-groups-windows-double.ads create mode 100644 src/fltk-widgets-groups-windows-single-menu.adb create mode 100644 src/fltk-widgets-groups-windows-single-menu.ads create mode 100644 src/fltk-widgets-groups-windows-single.adb create mode 100644 src/fltk-widgets-groups-windows-single.ads create mode 100644 src/fltk-widgets-groups-windows.adb create mode 100644 src/fltk-widgets-groups-windows.ads create mode 100644 src/fltk-widgets-groups.adb create mode 100644 src/fltk-widgets-groups.ads create mode 100644 src/fltk-widgets-inputs-int.adb create mode 100644 src/fltk-widgets-inputs-int.ads create mode 100644 src/fltk-widgets-inputs.adb create mode 100644 src/fltk-widgets-inputs.ads create mode 100644 src/fltk-widgets-menus-menu_bars.adb create mode 100644 src/fltk-widgets-menus-menu_bars.ads create mode 100644 src/fltk-widgets-menus-menu_buttons.adb create mode 100644 src/fltk-widgets-menus-menu_buttons.ads create mode 100644 src/fltk-widgets-menus.adb create mode 100644 src/fltk-widgets-menus.ads create mode 100644 src/fltk-widgets.adb create mode 100644 src/fltk-widgets.ads create mode 100644 src/fltk.adb create mode 100644 src/fltk.ads diff --git a/c_fl.cpp b/c_fl.cpp deleted file mode 100644 index b628c41..0000000 --- a/c_fl.cpp +++ /dev/null @@ -1,10 +0,0 @@ - - -#include -#include "c_fl.h" - - -int fl_run(void) { - return Fl::run(); -} - diff --git a/c_fl.h b/c_fl.h deleted file mode 100644 index 69e2e72..0000000 --- a/c_fl.h +++ /dev/null @@ -1,11 +0,0 @@ - - -#ifndef FL_GUARD -#define FL_GUARD - - -extern "C" int fl_run(void); - - -#endif - diff --git a/c_fl_box.cpp b/c_fl_box.cpp deleted file mode 100644 index eeee320..0000000 --- a/c_fl_box.cpp +++ /dev/null @@ -1,16 +0,0 @@ - - -#include -#include "c_fl_box.h" - - -BOX new_fl_box(int x, int y, int w, int h, char* label) { - Fl_Box *b = new Fl_Box(x, y, w, h, label); - return b; -} - - -void free_fl_box(BOX b) { - delete reinterpret_cast(b); -} - diff --git a/c_fl_box.h b/c_fl_box.h deleted file mode 100644 index df7b629..0000000 --- a/c_fl_box.h +++ /dev/null @@ -1,15 +0,0 @@ - - -#ifndef FL_BOX_GUARD -#define FL_BOX_GUARD - - -typedef void* BOX; - - -extern "C" BOX new_fl_box(int x, int y, int w, int h, char * label); -extern "C" void free_fl_box(BOX b); - - -#endif - diff --git a/c_fl_button.cpp b/c_fl_button.cpp deleted file mode 100644 index 621656c..0000000 --- a/c_fl_button.cpp +++ /dev/null @@ -1,31 +0,0 @@ - - -#include -#include "c_fl_button.h" - - -BUTTON new_fl_button(int x, int y, int w, int h, char* label) { - Fl_Button *b = new Fl_Button(x, y, w, h, label); - return b; -} - - -void free_fl_button(BUTTON b) { - delete reinterpret_cast(b); -} - - -int fl_button_get_state(BUTTON b) { - return reinterpret_cast(b)->value(); -} - - -void fl_button_set_state(BUTTON b, int s) { - reinterpret_cast(b)->value(s); -} - - -void fl_button_set_only(BUTTON b) { - reinterpret_cast(b)->setonly(); -} - diff --git a/c_fl_button.h b/c_fl_button.h deleted file mode 100644 index 239689a..0000000 --- a/c_fl_button.h +++ /dev/null @@ -1,19 +0,0 @@ - - -#ifndef FL_BUTTON_GUARD -#define FL_BUTTON_GUARD - - -typedef void* BUTTON; - - -extern "C" BUTTON new_fl_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_button(BUTTON b); - -extern "C" int fl_button_get_state(BUTTON b); -extern "C" void fl_button_set_state(BUTTON b, int s); -extern "C" void fl_button_set_only(BUTTON b); - - -#endif - diff --git a/c_fl_check_button.cpp b/c_fl_check_button.cpp deleted file mode 100644 index e737942..0000000 --- a/c_fl_check_button.cpp +++ /dev/null @@ -1,16 +0,0 @@ - - -#include -#include "c_fl_check_button.h" - - -CHECKBUTTON new_fl_check_button(int x, int y, int w, int h, char* label) { - Fl_Check_Button *b = new Fl_Check_Button(x, y, w, h, label); - return b; -} - - -void free_fl_check_button(CHECKBUTTON b) { - delete reinterpret_cast(b); -} - diff --git a/c_fl_check_button.h b/c_fl_check_button.h deleted file mode 100644 index f44b5ec..0000000 --- a/c_fl_check_button.h +++ /dev/null @@ -1,15 +0,0 @@ - - -#ifndef FL_CHECK_BUTTON_GUARD -#define FL_CHECK_BUTTON_GUARD - - -typedef void* CHECKBUTTON; - - -extern "C" CHECKBUTTON new_fl_check_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_check_button(CHECKBUTTON b); - - -#endif - diff --git a/c_fl_dialog.cpp b/c_fl_dialog.cpp deleted file mode 100644 index cb6d305..0000000 --- a/c_fl_dialog.cpp +++ /dev/null @@ -1,32 +0,0 @@ - - -#include -#include -#include -#include "c_fl_dialog.h" - - -void dialog_fl_alert(const char * m) { - fl_alert(m); -} - - -int dialog_fl_choice(const char * m, const char * a, const char * b, const char * c) { - return fl_choice(m, a, b, c); -} - - -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); -} - - -void dialog_fl_message(const char * m) { - fl_message(m); -} - diff --git a/c_fl_dialog.h b/c_fl_dialog.h deleted file mode 100644 index 6804022..0000000 --- a/c_fl_dialog.h +++ /dev/null @@ -1,15 +0,0 @@ - - -#ifndef FL_DIALOG_GUARD -#define FL_DIALOG_GUARD - - -extern "C" void dialog_fl_alert(const char * m); -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); - - -#endif - diff --git a/c_fl_double_window.cpp b/c_fl_double_window.cpp deleted file mode 100644 index 7f29af8..0000000 --- a/c_fl_double_window.cpp +++ /dev/null @@ -1,32 +0,0 @@ - - -#include -#include "c_fl_double_window.h" - - -DOUBLEWINDOW new_fl_double_window(int x, int y, int w, int h, char* label) { - Fl_Double_Window *d = new Fl_Double_Window(x, y, w, h, label); - return d; -} - - -DOUBLEWINDOW new_fl_double_window2(int w, int h) { - Fl_Double_Window *d = new Fl_Double_Window(w, h); - return d; -} - - -void free_fl_double_window(DOUBLEWINDOW d) { - delete reinterpret_cast(d); -} - - -void fl_double_window_show(DOUBLEWINDOW d) { - reinterpret_cast(d)->show(); -} - - -void fl_double_window_hide(DOUBLEWINDOW d) { - reinterpret_cast(d)->hide(); -} - diff --git a/c_fl_double_window.h b/c_fl_double_window.h deleted file mode 100644 index 3be3588..0000000 --- a/c_fl_double_window.h +++ /dev/null @@ -1,19 +0,0 @@ - - -#ifndef FL_DOUBLE_WINDOW_GUARD -#define FL_DOUBLE_WINDOW_GUARD - - -typedef void* DOUBLEWINDOW; - - -extern "C" DOUBLEWINDOW new_fl_double_window(int x, int y, int w, int h, char* label); -extern "C" DOUBLEWINDOW new_fl_double_window2(int w, int h); -extern "C" void free_fl_double_window(DOUBLEWINDOW d); - -extern "C" void fl_double_window_show(DOUBLEWINDOW d); -extern "C" void fl_double_window_hide(DOUBLEWINDOW d); - - -#endif - diff --git a/c_fl_group.cpp b/c_fl_group.cpp deleted file mode 100644 index 9ea2764..0000000 --- a/c_fl_group.cpp +++ /dev/null @@ -1,69 +0,0 @@ - - -#include -#include -#include "c_fl_group.h" -#include "c_fl_widget.h" - - -GROUP new_fl_group(int x, int y, int w, int h, char* label) { - Fl_Group *g = new Fl_Group(x, y, w, h, label); - return g; -} - - -void free_fl_group(GROUP g) { - delete reinterpret_cast(g); -} - - - - -void fl_group_end(GROUP g) { - reinterpret_cast(g)->end(); -} - - - - -void fl_group_add(GROUP g, WIDGET item) { - reinterpret_cast(g)->add(reinterpret_cast(item)); -} - - -int fl_group_find(GROUP g, WIDGET item) { - return reinterpret_cast(g)->find(reinterpret_cast(item)); -} - - -void fl_group_insert(GROUP g, WIDGET item, int place) { - reinterpret_cast(g)->insert(*(reinterpret_cast(item)), place); -} - - -void fl_group_remove(GROUP g, WIDGET item) { - reinterpret_cast(g)->remove(reinterpret_cast(item)); -} - - -void fl_group_remove2(GROUP g, int place) { - reinterpret_cast(g)->remove(place); -} - - -void fl_group_resizable(GROUP g, WIDGET item) { - reinterpret_cast(g)->resizable(reinterpret_cast(item)); -} - - - - -int fl_group_children(GROUP g) { - return reinterpret_cast(g)->children(); -} - - -void * fl_group_child(GROUP g, int place) { - return reinterpret_cast(g)->child(place); -} - diff --git a/c_fl_group.h b/c_fl_group.h deleted file mode 100644 index 9b58f8c..0000000 --- a/c_fl_group.h +++ /dev/null @@ -1,29 +0,0 @@ - - -#ifndef FL_GROUP_GUARD -#define FL_GROUP_GUARD - -#include "c_fl_widget.h" - - -typedef void* GROUP; - - -extern "C" GROUP new_fl_group(int x, int y, int w, int h, char* label); -extern "C" void free_fl_group(GROUP g); - -extern "C" void fl_group_end(GROUP g); - -extern "C" void fl_group_add(GROUP g, WIDGET item); -extern "C" int fl_group_find(GROUP g, WIDGET item); -extern "C" void fl_group_insert(GROUP g, WIDGET item, int place); -extern "C" void fl_group_remove(GROUP g, WIDGET item); -extern "C" void fl_group_remove2(GROUP g, int place); -extern "C" void fl_group_resizable(GROUP g, WIDGET item); - -extern "C" int fl_group_children(GROUP g); -extern "C" void * fl_group_child(GROUP g, int place); - - -#endif - diff --git a/c_fl_image.cpp b/c_fl_image.cpp deleted file mode 100644 index 8222392..0000000 --- a/c_fl_image.cpp +++ /dev/null @@ -1,33 +0,0 @@ - - -#include -#include "c_fl_image.h" - - -IMAGE new_fl_image(int w, int h, int d) { - Fl_Image *i = new Fl_Image(w, h, d); - return i; -} - - -void free_fl_image(IMAGE i) { - delete reinterpret_cast(i); -} - - - - -int fl_image_w(IMAGE i) { - return reinterpret_cast(i)->w(); -} - - -int fl_image_h(IMAGE i) { - return reinterpret_cast(i)->h(); -} - - -int fl_image_d(IMAGE i) { - return reinterpret_cast(i)->d(); -} - diff --git a/c_fl_image.h b/c_fl_image.h deleted file mode 100644 index a4be6df..0000000 --- a/c_fl_image.h +++ /dev/null @@ -1,20 +0,0 @@ - - -#ifndef FL_IMAGE_GUARD -#define FL_IMAGE_GUARD - - -typedef void* IMAGE; - - -extern "C" IMAGE new_fl_image(int w, int h, int d); -extern "C" void free_fl_image(IMAGE i); - - -extern "C" int fl_image_w(IMAGE i); -extern "C" int fl_image_h(IMAGE i); -extern "C" int fl_image_d(IMAGE i); - - -#endif - diff --git a/c_fl_input.cpp b/c_fl_input.cpp deleted file mode 100644 index 4f19bd1..0000000 --- a/c_fl_input.cpp +++ /dev/null @@ -1,21 +0,0 @@ - - -#include -#include "c_fl_input.h" - - -INPUT new_fl_input(int x, int y, int w, int h, char* label) { - Fl_Input *i = new Fl_Input(x, y, w, h, label); - return i; -} - - -void free_fl_input(INPUT i) { - delete reinterpret_cast(i); -} - - -const char * fl_input_get_value(INPUT i) { - return reinterpret_cast(i)->value(); -} - diff --git a/c_fl_input.h b/c_fl_input.h deleted file mode 100644 index cb40d42..0000000 --- a/c_fl_input.h +++ /dev/null @@ -1,18 +0,0 @@ - - -#ifndef FL_INPUT_GUARD -#define FL_INPUT_GUARD - - -typedef void* INPUT; - - -extern "C" INPUT new_fl_input(int x, int y, int w, int h, char* label); -extern "C" void free_fl_input(INPUT i); - - -extern "C" const char * fl_input_get_value(INPUT i); - - -#endif - diff --git a/c_fl_int_input.cpp b/c_fl_int_input.cpp deleted file mode 100644 index 2224857..0000000 --- a/c_fl_int_input.cpp +++ /dev/null @@ -1,21 +0,0 @@ - - -#include -#include "c_fl_int_input.h" - - -INT_INPUT new_fl_int_input(int x, int y, int w, int h, char* label) { - Fl_Int_Input *i = new Fl_Int_Input(x, y, w, h, label); - return i; -} - - -void free_fl_int_input(INT_INPUT i) { - delete reinterpret_cast(i); -} - - -const char * fl_int_input_get_value(INT_INPUT i) { - return reinterpret_cast(i)->value(); -} - diff --git a/c_fl_int_input.h b/c_fl_int_input.h deleted file mode 100644 index 5d99c3f..0000000 --- a/c_fl_int_input.h +++ /dev/null @@ -1,18 +0,0 @@ - - -#ifndef FL_INT_INPUT_GUARD -#define FL_INT_INPUT_GUARD - - -typedef void* INT_INPUT; - - -extern "C" INT_INPUT new_fl_int_input(int x, int y, int w, int h, char* label); -extern "C" void free_fl_int_input(INT_INPUT i); - - -extern "C" const char * fl_int_input_get_value(INT_INPUT i); - - -#endif - diff --git a/c_fl_light_button.cpp b/c_fl_light_button.cpp deleted file mode 100644 index daa99ef..0000000 --- a/c_fl_light_button.cpp +++ /dev/null @@ -1,16 +0,0 @@ - - -#include -#include "c_fl_light_button.h" - - -LIGHTBUTTON new_fl_light_button(int x, int y, int w, int h, char* label) { - Fl_Light_Button *b = new Fl_Light_Button(x, y, w, h, label); - return b; -} - - -void free_fl_light_button(LIGHTBUTTON b) { - delete reinterpret_cast(b); -} - diff --git a/c_fl_light_button.h b/c_fl_light_button.h deleted file mode 100644 index f8c005d..0000000 --- a/c_fl_light_button.h +++ /dev/null @@ -1,15 +0,0 @@ - - -#ifndef FL_LIGHT_BUTTON_GUARD -#define FL_LIGHT_BUTTON_GUARD - - -typedef void* LIGHTBUTTON; - - -extern "C" LIGHTBUTTON new_fl_light_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_light_button(LIGHTBUTTON b); - - -#endif - diff --git a/c_fl_menu.cpp b/c_fl_menu.cpp deleted file mode 100644 index f8c7b9e..0000000 --- a/c_fl_menu.cpp +++ /dev/null @@ -1,38 +0,0 @@ - - -#include -#include -#include "c_fl_menu.h" - - -int fl_menu_add(MENU m, const char * t, unsigned long s, void * c, void * u, unsigned long f) { - return reinterpret_cast(m)->add(t, s, reinterpret_cast(c), u, f); -} - - -const void * fl_menu_find_item(MENU m, const char * t) { - return reinterpret_cast(m)->find_item(t); -} - - -const void * fl_menu_mvalue(MENU m) { - return reinterpret_cast(m)->mvalue(); -} - - - - -int fl_menuitem_value(void * mi) { - return reinterpret_cast(mi)->value(); -} - - -void fl_menuitem_activate(void * mi) { - reinterpret_cast(mi)->activate(); -} - - -void fl_menuitem_deactivate(void * mi) { - reinterpret_cast(mi)->deactivate(); -} - diff --git a/c_fl_menu.h b/c_fl_menu.h deleted file mode 100644 index 2b9aa68..0000000 --- a/c_fl_menu.h +++ /dev/null @@ -1,22 +0,0 @@ - - -#ifndef FL_MENU_GUARD -#define FL_MENU_GUARD - - -typedef void* MENU; -// typedef void* MENUITEM; - - -extern "C" int fl_menu_add(MENU m, const char * t, unsigned long s, void * c, void * u, unsigned long f); -extern "C" const void * fl_menu_find_item(MENU m, const char * t); -extern "C" const void * fl_menu_mvalue(MENU m); - - -extern "C" int fl_menuitem_value(void * mi); -extern "C" void fl_menuitem_activate(void * mi); -extern "C" void fl_menuitem_deactivate(void * mi); - - -#endif - diff --git a/c_fl_menu_bar.cpp b/c_fl_menu_bar.cpp deleted file mode 100644 index 3349008..0000000 --- a/c_fl_menu_bar.cpp +++ /dev/null @@ -1,16 +0,0 @@ - - -#include -#include "c_fl_menu_bar.h" - - -MENUBAR new_fl_menu_bar(int x, int y, int w, int h, char* label) { - Fl_Menu_Bar *m = new Fl_Menu_Bar(x, y, w, h, label); - return m; -} - - -void free_fl_menu_bar(MENUBAR m) { - delete reinterpret_cast(m); -} - diff --git a/c_fl_menu_bar.h b/c_fl_menu_bar.h deleted file mode 100644 index a09d22b..0000000 --- a/c_fl_menu_bar.h +++ /dev/null @@ -1,15 +0,0 @@ - - -#ifndef FL_MENU_BAR_GUARD -#define FL_MENU_BAR_GUARD - - -typedef void* MENUBAR; - - -extern "C" MENUBAR new_fl_menu_bar(int x, int y, int w, int h, char* label); -extern "C" void free_fl_menu_bar(MENUBAR m); - - -#endif - diff --git a/c_fl_menu_button.cpp b/c_fl_menu_button.cpp deleted file mode 100644 index 864dd3e..0000000 --- a/c_fl_menu_button.cpp +++ /dev/null @@ -1,21 +0,0 @@ - - -#include -#include "c_fl_menu_button.h" - - -MENUBUTTON new_fl_menu_button(int x, int y, int w, int h, char* label) { - Fl_Menu_Button *m = new Fl_Menu_Button(x, y, w, h, label); - return m; -} - - -void free_fl_menu_button(MENUBUTTON m) { - delete reinterpret_cast(m); -} - - -void fl_menu_button_type(MENUBUTTON m, unsigned int t) { - reinterpret_cast(m)->type(t); -} - diff --git a/c_fl_menu_button.h b/c_fl_menu_button.h deleted file mode 100644 index 8c089b6..0000000 --- a/c_fl_menu_button.h +++ /dev/null @@ -1,18 +0,0 @@ - - -#ifndef FL_MENU_BUTTON_GUARD -#define FL_MENU_BUTTON_GUARD - - -typedef void* MENUBUTTON; - - -extern "C" MENUBUTTON new_fl_menu_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_menu_button(MENUBUTTON m); - - -extern "C" void fl_menu_button_type(MENUBUTTON m, unsigned int t); - - -#endif - diff --git a/c_fl_menu_window.cpp b/c_fl_menu_window.cpp deleted file mode 100644 index 66ad6f3..0000000 --- a/c_fl_menu_window.cpp +++ /dev/null @@ -1,52 +0,0 @@ - - -#include -#include "c_fl_menu_window.h" - - -MENUWINDOW new_fl_menu_window(int x, int y, int w, int h, char* label) { - Fl_Menu_Window *m = new Fl_Menu_Window(x, y, w, h, label); - return m; -} - - -MENUWINDOW new_fl_menu_window2(int w, int h) { - Fl_Menu_Window *m = new Fl_Menu_Window(w, h); - return m; -} - - -void free_fl_menu_window(MENUWINDOW m) { - delete reinterpret_cast(m); -} - - -void fl_menu_window_show(MENUWINDOW m) { - reinterpret_cast(m)->show(); -} - - -void fl_menu_window_hide(MENUWINDOW m) { - reinterpret_cast(m)->hide(); -} - - -void fl_menu_window_flush(MENUWINDOW m) { - reinterpret_cast(m)->flush(); -} - - -void fl_menu_window_set_overlay(MENUWINDOW m) { - reinterpret_cast(m)->set_overlay(); -} - - -void fl_menu_window_clear_overlay(MENUWINDOW m) { - reinterpret_cast(m)->clear_overlay(); -} - - -unsigned int fl_menu_window_overlay(MENUWINDOW m) { - return reinterpret_cast(m)->overlay(); -} - diff --git a/c_fl_menu_window.h b/c_fl_menu_window.h deleted file mode 100644 index 3322b29..0000000 --- a/c_fl_menu_window.h +++ /dev/null @@ -1,23 +0,0 @@ - - -#ifndef FL_MENU_WINDOW_GUARD -#define FL_MENU_WINDOW_GUARD - - -typedef void* MENUWINDOW; - - -extern "C" MENUWINDOW new_fl_menu_window(int x, int y, int w, int h, char* label); -extern "C" MENUWINDOW new_fl_menu_window2(int w, int h); -extern "C" void free_fl_menu_window(MENUWINDOW m); - -extern "C" void fl_menu_window_show(MENUWINDOW m); -extern "C" void fl_menu_window_hide(MENUWINDOW m); -extern "C" void fl_menu_window_flush(MENUWINDOW m); -extern "C" void fl_menu_window_set_overlay(MENUWINDOW m); -extern "C" void fl_menu_window_clear_overlay(MENUWINDOW m); -extern "C" unsigned int fl_menu_window_overlay(MENUWINDOW m); - - -#endif - diff --git a/c_fl_png_image.cpp b/c_fl_png_image.cpp deleted file mode 100644 index 16d5927..0000000 --- a/c_fl_png_image.cpp +++ /dev/null @@ -1,16 +0,0 @@ - - -#include -#include "c_fl_png_image.h" - - -PNG_IMAGE new_fl_png_image(const char * f) { - Fl_PNG_Image *p = new Fl_PNG_Image(f); - return p; -} - - -void free_fl_png_image(PNG_IMAGE p) { - delete reinterpret_cast(p); -} - diff --git a/c_fl_png_image.h b/c_fl_png_image.h deleted file mode 100644 index a67a5aa..0000000 --- a/c_fl_png_image.h +++ /dev/null @@ -1,15 +0,0 @@ - - -#ifndef FL_PNG_IMAGE_GUARD -#define FL_PNG_IMAGE_GUARD - - -typedef void* PNG_IMAGE; - - -extern "C" PNG_IMAGE new_fl_png_image(const char * f); -extern "C" void free_fl_png_image(PNG_IMAGE p); - - -#endif - diff --git a/c_fl_radio_button.cpp b/c_fl_radio_button.cpp deleted file mode 100644 index 1cac323..0000000 --- a/c_fl_radio_button.cpp +++ /dev/null @@ -1,16 +0,0 @@ - - -#include -#include "c_fl_radio_button.h" - - -RADIOBUTTON new_fl_radio_button(int x, int y, int w, int h, char* label) { - Fl_Radio_Button *b = new Fl_Radio_Button(x, y, w, h, label); - return b; -} - - -void free_fl_radio_button(RADIOBUTTON b) { - delete reinterpret_cast(b); -} - diff --git a/c_fl_radio_button.h b/c_fl_radio_button.h deleted file mode 100644 index d9ea819..0000000 --- a/c_fl_radio_button.h +++ /dev/null @@ -1,15 +0,0 @@ - - -#ifndef FL_RADIO_BUTTON_GUARD -#define FL_RADIO_BUTTON_GUARD - - -typedef void* RADIOBUTTON; - - -extern "C" RADIOBUTTON new_fl_radio_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_radio_button(RADIOBUTTON b); - - -#endif - diff --git a/c_fl_radio_light_button.cpp b/c_fl_radio_light_button.cpp deleted file mode 100644 index 7dd4a5f..0000000 --- a/c_fl_radio_light_button.cpp +++ /dev/null @@ -1,16 +0,0 @@ - - -#include -#include "c_fl_radio_light_button.h" - - -RADIOLIGHTBUTTON new_fl_radio_light_button(int x, int y, int w, int h, char* label) { - Fl_Radio_Light_Button *b = new Fl_Radio_Light_Button(x, y, w, h, label); - return b; -} - - -void free_fl_radio_light_button(RADIOLIGHTBUTTON b) { - delete reinterpret_cast(b); -} - diff --git a/c_fl_radio_light_button.h b/c_fl_radio_light_button.h deleted file mode 100644 index ee5f2a1..0000000 --- a/c_fl_radio_light_button.h +++ /dev/null @@ -1,15 +0,0 @@ - - -#ifndef FL_RADIO_LIGHT_BUTTON_GUARD -#define FL_RADIO_LIGHT_BUTTON_GUARD - - -typedef void* RADIOLIGHTBUTTON; - - -extern "C" RADIOLIGHTBUTTON new_fl_radio_light_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_radio_light_button(RADIOLIGHTBUTTON b); - - -#endif - diff --git a/c_fl_radio_round_button.cpp b/c_fl_radio_round_button.cpp deleted file mode 100644 index 9e94244..0000000 --- a/c_fl_radio_round_button.cpp +++ /dev/null @@ -1,16 +0,0 @@ - - -#include -#include "c_fl_radio_round_button.h" - - -RADIOROUNDBUTTON new_fl_radio_round_button(int x, int y, int w, int h, char* label) { - Fl_Radio_Round_Button *b = new Fl_Radio_Round_Button(x, y, w, h, label); - return b; -} - - -void free_fl_radio_round_button(RADIOROUNDBUTTON b) { - delete reinterpret_cast(b); -} - diff --git a/c_fl_radio_round_button.h b/c_fl_radio_round_button.h deleted file mode 100644 index 34f1189..0000000 --- a/c_fl_radio_round_button.h +++ /dev/null @@ -1,15 +0,0 @@ - - -#ifndef FL_RADIO_ROUND_BUTTON_GUARD -#define FL_RADIO_ROUND_BUTTON_GUARD - - -typedef void* RADIOROUNDBUTTON; - - -extern "C" RADIOROUNDBUTTON new_fl_radio_round_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_radio_round_button(RADIOROUNDBUTTON b); - - -#endif - diff --git a/c_fl_repeat_button.cpp b/c_fl_repeat_button.cpp deleted file mode 100644 index eafefde..0000000 --- a/c_fl_repeat_button.cpp +++ /dev/null @@ -1,16 +0,0 @@ - - -#include -#include "c_fl_repeat_button.h" - - -REPEATBUTTON new_fl_repeat_button(int x, int y, int w, int h, char* label) { - Fl_Repeat_Button *b = new Fl_Repeat_Button(x, y, w, h, label); - return b; -} - - -void free_fl_repeat_button(REPEATBUTTON b) { - delete reinterpret_cast(b); -} - diff --git a/c_fl_repeat_button.h b/c_fl_repeat_button.h deleted file mode 100644 index d899730..0000000 --- a/c_fl_repeat_button.h +++ /dev/null @@ -1,15 +0,0 @@ - - -#ifndef FL_REPEAT_BUTTON_GUARD -#define FL_REPEAT_BUTTON_GUARD - - -typedef void* REPEATBUTTON; - - -extern "C" REPEATBUTTON new_fl_repeat_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_repeat_button(REPEATBUTTON b); - - -#endif - diff --git a/c_fl_return_button.cpp b/c_fl_return_button.cpp deleted file mode 100644 index 5f87fb3..0000000 --- a/c_fl_return_button.cpp +++ /dev/null @@ -1,16 +0,0 @@ - - -#include -#include "c_fl_return_button.h" - - -RETURNBUTTON new_fl_return_button(int x, int y, int w, int h, char* label) { - Fl_Return_Button *b = new Fl_Return_Button(x, y, w, h, label); - return b; -} - - -void free_fl_return_button(RETURNBUTTON b) { - delete reinterpret_cast(b); -} - diff --git a/c_fl_return_button.h b/c_fl_return_button.h deleted file mode 100644 index 558e9dc..0000000 --- a/c_fl_return_button.h +++ /dev/null @@ -1,15 +0,0 @@ - - -#ifndef FL_RETURN_BUTTON_GUARD -#define FL_RETURN_BUTTON_GUARD - - -typedef void* RETURNBUTTON; - - -extern "C" RETURNBUTTON new_fl_return_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_return_button(RETURNBUTTON b); - - -#endif - diff --git a/c_fl_round_button.cpp b/c_fl_round_button.cpp deleted file mode 100644 index b33448f..0000000 --- a/c_fl_round_button.cpp +++ /dev/null @@ -1,16 +0,0 @@ - - -#include -#include "c_fl_round_button.h" - - -ROUNDBUTTON new_fl_round_button(int x, int y, int w, int h, char* label) { - Fl_Round_Button *b = new Fl_Round_Button(x, y, w, h, label); - return b; -} - - -void free_fl_round_button(ROUNDBUTTON b) { - delete reinterpret_cast(b); -} - diff --git a/c_fl_round_button.h b/c_fl_round_button.h deleted file mode 100644 index 36113a4..0000000 --- a/c_fl_round_button.h +++ /dev/null @@ -1,15 +0,0 @@ - - -#ifndef FL_ROUND_BUTTON_GUARD -#define FL_ROUND_BUTTON_GUARD - - -typedef void* ROUNDBUTTON; - - -extern "C" ROUNDBUTTON new_fl_round_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_round_button(ROUNDBUTTON b); - - -#endif - diff --git a/c_fl_single_window.cpp b/c_fl_single_window.cpp deleted file mode 100644 index ec9a315..0000000 --- a/c_fl_single_window.cpp +++ /dev/null @@ -1,32 +0,0 @@ - - -#include -#include "c_fl_single_window.h" - - -SINGLEWINDOW new_fl_single_window(int x, int y, int w, int h, char* label) { - Fl_Single_Window *sw = new Fl_Single_Window(x, y, w, h, label); - return sw; -} - - -SINGLEWINDOW new_fl_single_window2(int x, int y) { - Fl_Single_Window *sw = new Fl_Single_Window(x, y); - return sw; -} - - -void free_fl_single_window(SINGLEWINDOW w) { - delete reinterpret_cast(w); -} - - -void fl_single_window_show(SINGLEWINDOW w) { - reinterpret_cast(w)->show(); -} - - -void fl_single_window_flush(SINGLEWINDOW w) { - reinterpret_cast(w)->flush(); -} - diff --git a/c_fl_single_window.h b/c_fl_single_window.h deleted file mode 100644 index 96f6d5b..0000000 --- a/c_fl_single_window.h +++ /dev/null @@ -1,19 +0,0 @@ - - -#ifndef FL_SINGLE_WINDOW_GUARD -#define FL_SINGLE_WINDOW_GUARD - - -typedef void* SINGLEWINDOW; - - -extern "C" SINGLEWINDOW new_fl_single_window(int x, int y, int w, int h, char* label); -extern "C" SINGLEWINDOW new_fl_single_window2(int x, int y); -extern "C" void free_fl_single_window(SINGLEWINDOW w); - -extern "C" void fl_single_window_show(SINGLEWINDOW w); -extern "C" void fl_single_window_flush(SINGLEWINDOW w); - - -#endif - diff --git a/c_fl_text_buffer.cpp b/c_fl_text_buffer.cpp deleted file mode 100644 index 71f04d2..0000000 --- a/c_fl_text_buffer.cpp +++ /dev/null @@ -1,111 +0,0 @@ - - -#include -#include "c_fl_text_buffer.h" - - -TEXTBUFFER new_fl_text_buffer(int rs, int pgs) { - Fl_Text_Buffer *tb = new Fl_Text_Buffer(rs, pgs); - return tb; -} - - -void free_fl_text_buffer(TEXTBUFFER tb) { - delete reinterpret_cast(tb); -} - - -void fl_text_buffer_add_modify_callback(TEXTBUFFER tb, void * cb, void * ud) { - reinterpret_cast(tb)->add_modify_callback(reinterpret_cast(cb), ud); -} - - -void fl_text_buffer_add_predelete_callback(TEXTBUFFER tb, void * cb, void * ud) { - reinterpret_cast(tb)->add_predelete_callback(reinterpret_cast(cb), ud); -} - - -void fl_text_buffer_call_modify_callbacks(TEXTBUFFER tb) { - reinterpret_cast(tb)->call_modify_callbacks(); -} - - -void fl_text_buffer_call_predelete_callbacks(TEXTBUFFER tb) { - reinterpret_cast(tb)->call_predelete_callbacks(); -} - - -void fl_text_buffer_insert(TEXTBUFFER tb, int p, const char * item) { - reinterpret_cast(tb)->insert(p, item); -} - - -void fl_text_buffer_remove(TEXTBUFFER tb, int s, int f) { - reinterpret_cast(tb)->remove(s, f); -} - - -int fl_text_buffer_length(TEXTBUFFER tb) { - return reinterpret_cast(tb)->length(); -} - - -int fl_text_buffer_loadfile(TEXTBUFFER tb, char * n) { - return reinterpret_cast(tb)->loadfile(n); -} - - -void fl_text_buffer_remove_selection(TEXTBUFFER tb) { - reinterpret_cast(tb)->remove_selection(); -} - - -int fl_text_buffer_savefile(TEXTBUFFER tb, char * n) { - return reinterpret_cast(tb)->savefile(n); -} - - -int fl_text_buffer_search_forward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase) { - return reinterpret_cast(tb)->search_forward(start, item, found, mcase); -} - - -int fl_text_buffer_search_backward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase) { - return reinterpret_cast(tb)->search_backward(start, item, found, mcase); -} - - -void fl_text_buffer_select(TEXTBUFFER tb, int s, int e) { - reinterpret_cast(tb)->select(s, e); -} - - -int fl_text_buffer_selection_position(TEXTBUFFER tb, int * s, int * e) { - return reinterpret_cast(tb)->selection_position(s, e); -} - - -int fl_text_buffer_selected(TEXTBUFFER tb) { - return reinterpret_cast(tb)->selected(); -} - - -int fl_text_buffer_skip_lines(TEXTBUFFER tb, int s, int l) { - return reinterpret_cast(tb)->skip_lines(s, l); -} - - -int fl_text_buffer_rewind_lines(TEXTBUFFER tb, int s, int l) { - return reinterpret_cast(tb)->rewind_lines(s, l); -} - - -unsigned int fl_text_buffer_char_at(TEXTBUFFER tb, int p) { - return reinterpret_cast(tb)->char_at(p); -} - - -char * fl_text_buffer_text_range(TEXTBUFFER tb, int s, int f) { - return reinterpret_cast(tb)->text_range(s, f); -} - diff --git a/c_fl_text_buffer.h b/c_fl_text_buffer.h deleted file mode 100644 index 1551d2b..0000000 --- a/c_fl_text_buffer.h +++ /dev/null @@ -1,36 +0,0 @@ - - -#ifndef FL_TEXT_BUFFER_GUARD -#define FL_TEXT_BUFFER_GUARD - - -typedef void* TEXTBUFFER; - - -extern "C" TEXTBUFFER new_fl_text_buffer(int rs, int pgs); -extern "C" void free_fl_text_buffer(TEXTBUFFER tb); - - -extern "C" void fl_text_buffer_add_modify_callback(TEXTBUFFER tb, void * cb, void * ud); -extern "C" void fl_text_buffer_add_predelete_callback(TEXTBUFFER tb, void * cb, void * ud); -extern "C" void fl_text_buffer_call_modify_callbacks(TEXTBUFFER tb); -extern "C" void fl_text_buffer_call_predelete_callbacks(TEXTBUFFER tb); -extern "C" void fl_text_buffer_insert(TEXTBUFFER tb, int p, const char * item); -extern "C" void fl_text_buffer_remove(TEXTBUFFER tb, int s, int f); -extern "C" int fl_text_buffer_length(TEXTBUFFER tb); -extern "C" int fl_text_buffer_loadfile(TEXTBUFFER tb, char * n); -extern "C" void fl_text_buffer_remove_selection(TEXTBUFFER tb); -extern "C" int fl_text_buffer_savefile(TEXTBUFFER tb, char * n); -extern "C" int fl_text_buffer_search_forward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase); -extern "C" int fl_text_buffer_search_backward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase); -extern "C" void fl_text_buffer_select(TEXTBUFFER tb, int s, int e); -extern "C" int fl_text_buffer_selection_position(TEXTBUFFER tb, int * s, int * e); -extern "C" int fl_text_buffer_selected(TEXTBUFFER tb); -extern "C" int fl_text_buffer_skip_lines(TEXTBUFFER tb, int s, int l); -extern "C" int fl_text_buffer_rewind_lines(TEXTBUFFER tb, int s, int l); -extern "C" unsigned int fl_text_buffer_char_at(TEXTBUFFER tb, int p); -extern "C" char * fl_text_buffer_text_range(TEXTBUFFER tb, int s, int f); - - -#endif - diff --git a/c_fl_text_display.cpp b/c_fl_text_display.cpp deleted file mode 100644 index b9e59c6..0000000 --- a/c_fl_text_display.cpp +++ /dev/null @@ -1,105 +0,0 @@ - - -#include -#include -#include "c_fl_text_display.h" -#include "c_fl_text_buffer.h" - - -TEXTDISPLAY new_fl_text_display(int x, int y, int w, int h, char* label) { - Fl_Text_Display *td = new Fl_Text_Display(x, y, w, h, label); - return td; -} - - -void free_fl_text_display(TEXTDISPLAY td) { - delete reinterpret_cast(td); -} - - -// this actually never gets called, since an access to the text_buffer -// object is stored on the Ada side of things -TEXTBUFFER fl_text_display_get_buffer(TEXTDISPLAY td) { - return reinterpret_cast(td)->buffer(); -} - - -void fl_text_display_set_buffer(TEXTDISPLAY td, TEXTBUFFER tb) { - reinterpret_cast(td)->buffer(reinterpret_cast(tb)); -} - - -int fl_text_display_get_text_color(TEXTDISPLAY td) { - return reinterpret_cast(td)->textcolor(); -} - - -void fl_text_display_set_text_color(TEXTDISPLAY td, int c) { - reinterpret_cast(td)->textcolor(static_cast(c)); -} - - -int fl_text_display_get_text_font(TEXTDISPLAY td) { - return reinterpret_cast(td)->textfont(); -} - - -void fl_text_display_set_text_font(TEXTDISPLAY td, int f) { - reinterpret_cast(td)->textfont(static_cast(f)); -} - - -int fl_text_display_get_text_size(TEXTDISPLAY td) { - return reinterpret_cast(td)->textsize(); -} - - -void fl_text_display_set_text_size(TEXTDISPLAY td, int s) { - reinterpret_cast(td)->textsize(static_cast(s)); -} - - -int fl_text_display_get_insert_pos(TEXTDISPLAY td) { - return reinterpret_cast(td)->insert_position(); -} - - -void fl_text_display_set_insert_pos(TEXTDISPLAY td, int p) { - reinterpret_cast(td)->insert_position(p); -} - - -void fl_text_display_show_insert_pos(TEXTDISPLAY td) { - reinterpret_cast(td)->show_insert_position(); -} - - -void fl_text_display_next_word(TEXTDISPLAY td) { - reinterpret_cast(td)->next_word(); -} - - -void fl_text_display_previous_word(TEXTDISPLAY td) { - reinterpret_cast(td)->previous_word(); -} - - -void fl_text_display_wrap_mode(TEXTDISPLAY td, int w, int m) { - reinterpret_cast(td)->wrap_mode(w, m); -} - - -int fl_text_display_skip_lines(TEXTDISPLAY td, int s, int l, int p) { - return reinterpret_cast(td)->skip_lines(s, l, p); -} - - -int fl_text_display_rewind_lines(TEXTDISPLAY td, int s, int l) { - return reinterpret_cast(td)->rewind_lines(s, l); -} - - -void fl_text_display_linenumber_width(TEXTDISPLAY td, int w) { - reinterpret_cast(td)->linenumber_width(w); -} - diff --git a/c_fl_text_display.h b/c_fl_text_display.h deleted file mode 100644 index dbd683f..0000000 --- a/c_fl_text_display.h +++ /dev/null @@ -1,35 +0,0 @@ - - -#ifndef FL_TEXT_DISPLAY_GUARD -#define FL_TEXT_DISPLAY_GUARD - -#include "c_fl_text_buffer.h" - - -typedef void* TEXTDISPLAY; - - -extern "C" TEXTDISPLAY new_fl_text_display(int x, int y, int w, int h, char* label); -extern "C" void free_fl_text_display(TEXTDISPLAY td); - -extern "C" TEXTBUFFER fl_text_display_get_buffer(TEXTDISPLAY td); -extern "C" void fl_text_display_set_buffer(TEXTDISPLAY td, TEXTBUFFER tb); -extern "C" int fl_text_display_get_text_color(TEXTDISPLAY td); -extern "C" void fl_text_display_set_text_color(TEXTDISPLAY td, int c); -extern "C" int fl_text_display_get_text_font(TEXTDISPLAY td); -extern "C" void fl_text_display_set_text_font(TEXTDISPLAY td, int f); -extern "C" int fl_text_display_get_text_size(TEXTDISPLAY td); -extern "C" void fl_text_display_set_text_size(TEXTDISPLAY td, int s); -extern "C" int fl_text_display_get_insert_pos(TEXTDISPLAY td); -extern "C" void fl_text_display_set_insert_pos(TEXTDISPLAY td, int p); -extern "C" void fl_text_display_show_insert_pos(TEXTDISPLAY td); -extern "C" void fl_text_display_next_word(TEXTDISPLAY td); -extern "C" void fl_text_display_previous_word(TEXTDISPLAY td); -extern "C" void fl_text_display_wrap_mode(TEXTDISPLAY td, int w, int m); -extern "C" int fl_text_display_skip_lines(TEXTDISPLAY td, int s, int l, int p); -extern "C" int fl_text_display_rewind_lines(TEXTDISPLAY td, int s, int l); -extern "C" void fl_text_display_linenumber_width(TEXTDISPLAY td, int w); - - -#endif - diff --git a/c_fl_text_editor.cpp b/c_fl_text_editor.cpp deleted file mode 100644 index c28f6fa..0000000 --- a/c_fl_text_editor.cpp +++ /dev/null @@ -1,48 +0,0 @@ - - -#include -#include "c_fl_text_editor.h" - - -TEXTEDITOR new_fl_text_editor(int x, int y, int w, int h, char* label) { - Fl_Text_Editor *te = new Fl_Text_Editor(x, y, w, h, label); - return te; -} - - -void free_fl_text_editor(TEXTEDITOR te) { - delete reinterpret_cast(te); -} - - - - -void fl_text_editor_undo(TEXTEDITOR te) { - Fl_Text_Editor::kf_undo(0, reinterpret_cast(te)); -} - - -void fl_text_editor_cut(TEXTEDITOR te) { - Fl_Text_Editor::kf_cut(0, reinterpret_cast(te)); -} - - -void fl_text_editor_copy(TEXTEDITOR te) { - Fl_Text_Editor::kf_copy(0, reinterpret_cast(te)); -} - - -void fl_text_editor_paste(TEXTEDITOR te) { - Fl_Text_Editor::kf_paste(0, reinterpret_cast(te)); -} - - -void fl_text_editor_delete(TEXTEDITOR te) { - Fl_Text_Editor::kf_delete(0, reinterpret_cast(te)); -} - - -void fl_text_editor_remove_key_binding(TEXTEDITOR te, unsigned int k, unsigned long m) { - reinterpret_cast(te)->remove_key_binding(k, m); -} - diff --git a/c_fl_text_editor.h b/c_fl_text_editor.h deleted file mode 100644 index ebaab0d..0000000 --- a/c_fl_text_editor.h +++ /dev/null @@ -1,23 +0,0 @@ - - -#ifndef FL_TEXT_EDITOR_GUARD -#define FL_TEXT_EDITOR_GUARD - - -typedef void* TEXTEDITOR; - - -extern "C" TEXTEDITOR new_fl_text_editor(int x, int y, int w, int h, char* label); -extern "C" void free_fl_text_editor(TEXTEDITOR te); - - -extern "C" void fl_text_editor_undo(TEXTEDITOR te); -extern "C" void fl_text_editor_cut(TEXTEDITOR te); -extern "C" void fl_text_editor_copy(TEXTEDITOR te); -extern "C" void fl_text_editor_paste(TEXTEDITOR te); -extern "C" void fl_text_editor_delete(TEXTEDITOR te); -extern "C" void fl_text_editor_remove_key_binding(TEXTEDITOR te, unsigned int k, unsigned long m); - - -#endif - diff --git a/c_fl_toggle_button.cpp b/c_fl_toggle_button.cpp deleted file mode 100644 index d52e72e..0000000 --- a/c_fl_toggle_button.cpp +++ /dev/null @@ -1,16 +0,0 @@ - - -#include -#include "c_fl_toggle_button.h" - - -TOGGLEBUTTON new_fl_toggle_button(int x, int y, int w, int h, char* label) { - Fl_Toggle_Button *b = new Fl_Toggle_Button(x, y, w, h, label); - return b; -} - - -void free_fl_toggle_button(TOGGLEBUTTON b) { - delete reinterpret_cast(b); -} - diff --git a/c_fl_toggle_button.h b/c_fl_toggle_button.h deleted file mode 100644 index ed86ed4..0000000 --- a/c_fl_toggle_button.h +++ /dev/null @@ -1,15 +0,0 @@ - - -#ifndef FL_TOGGLE_BUTTON_GUARD -#define FL_TOGGLE_BUTTON_GUARD - - -typedef void* TOGGLEBUTTON; - - -extern "C" TOGGLEBUTTON new_fl_toggle_button(int x, int y, int w, int h, char* label); -extern "C" void free_fl_toggle_button(TOGGLEBUTTON b); - - -#endif - diff --git a/c_fl_widget.cpp b/c_fl_widget.cpp deleted file mode 100644 index 30c4de3..0000000 --- a/c_fl_widget.cpp +++ /dev/null @@ -1,119 +0,0 @@ - - -#include -#include -#include "c_fl_widget.h" - - - - -void * fl_widget_get_user_data(WIDGET w) { - return reinterpret_cast(w)->user_data(); -} - - -void fl_widget_set_user_data(WIDGET w, void * d) { - reinterpret_cast(w)->user_data(d); -} - - - - -int fl_widget_get_box(WIDGET w) { - return reinterpret_cast(w)->box(); -} - - -void fl_widget_set_box(WIDGET w, int b) { - reinterpret_cast(w)->box(static_cast(b)); -} - - -const char* fl_widget_get_label(WIDGET w) { - return reinterpret_cast(w)->label(); -} - - -void fl_widget_set_label(WIDGET w, const char* t) { - reinterpret_cast(w)->copy_label(t); -} - - -int fl_widget_get_label_font(WIDGET w) { - return reinterpret_cast(w)->labelfont(); -} - - -void fl_widget_set_label_font(WIDGET w, int f) { - reinterpret_cast(w)->labelfont(static_cast(f)); -} - - -int fl_widget_get_label_size(WIDGET w) { - return reinterpret_cast(w)->labelsize(); -} - - -void fl_widget_set_label_size(WIDGET w, int s) { - reinterpret_cast(w)->labelsize(static_cast(s)); -} - - -int fl_widget_get_label_type(WIDGET w) { - return reinterpret_cast(w)->labeltype(); -} - - -void fl_widget_set_label_type(WIDGET w, int l) { - reinterpret_cast(w)->labeltype(static_cast(l)); -} - - -void * fl_widget_get_parent(WIDGET w) { - return reinterpret_cast(w)->parent(); -} - - - - -void fl_widget_set_callback(WIDGET w, void * cb) { - reinterpret_cast(w)->callback(reinterpret_cast(cb)); -} - - - - -int fl_widget_get_x(WIDGET w) { - return reinterpret_cast(w)->x(); -} - - -int fl_widget_get_y(WIDGET w) { - return reinterpret_cast(w)->y(); -} - - -int fl_widget_get_w(WIDGET w) { - return reinterpret_cast(w)->w(); -} - - -int fl_widget_get_h(WIDGET w) { - return reinterpret_cast(w)->h(); -} - - -void fl_widget_size(WIDGET w, int d, int h) { - reinterpret_cast(w)->size(d, h); -} - - -void fl_widget_position(WIDGET w, int x, int y) { - reinterpret_cast(w)->position(x, y); -} - - -void fl_widget_set_image(WIDGET w, void * img) { - reinterpret_cast(w)->image(reinterpret_cast(img)); -} - diff --git a/c_fl_widget.h b/c_fl_widget.h deleted file mode 100644 index 3c20dc2..0000000 --- a/c_fl_widget.h +++ /dev/null @@ -1,40 +0,0 @@ - - -#ifndef FL_WIDGET_GUARD -#define FL_WIDGET_GUARD - - -typedef void* WIDGET; - - -extern "C" void * fl_widget_get_user_data(WIDGET w); -extern "C" void fl_widget_set_user_data(WIDGET w, void * d); - - -extern "C" int fl_widget_get_box(WIDGET w); -extern "C" void fl_widget_set_box(WIDGET w, int b); -extern "C" const char* fl_widget_get_label(WIDGET w); -extern "C" void fl_widget_set_label(WIDGET w, const char* t); -extern "C" int fl_widget_get_label_font(WIDGET w); -extern "C" void fl_widget_set_label_font(WIDGET w, int f); -extern "C" int fl_widget_get_label_size(WIDGET w); -extern "C" void fl_widget_set_label_size(WIDGET w, int s); -extern "C" int fl_widget_get_label_type(WIDGET w); -extern "C" void fl_widget_set_label_type(WIDGET w, int l); -extern "C" void * fl_widget_get_parent(WIDGET w); - - -extern "C" void fl_widget_set_callback(WIDGET w, void * cb); - - -extern "C" int fl_widget_get_x(WIDGET w); -extern "C" int fl_widget_get_y(WIDGET w); -extern "C" int fl_widget_get_w(WIDGET w); -extern "C" int fl_widget_get_h(WIDGET w); -extern "C" void fl_widget_size(WIDGET w, int d, int h); -extern "C" void fl_widget_position(WIDGET w, int x, int y); -extern "C" void fl_widget_set_image(WIDGET w, void * img); - - -#endif - diff --git a/c_fl_window.cpp b/c_fl_window.cpp deleted file mode 100644 index fbce39b..0000000 --- a/c_fl_window.cpp +++ /dev/null @@ -1,58 +0,0 @@ - - -#include -#include -#include "c_fl_window.h" - - -WINDOW new_fl_window(int x, int y, int w, int h, char* label) { - Fl_Window *n = new Fl_Window(x, y, w, h, label); - return n; -} - - -WINDOW new_fl_window2(int w, int h) { - Fl_Window *n = new Fl_Window(w, h); - return n; -} - - -void free_fl_window(WINDOW n) { - delete reinterpret_cast(n); -} - - -void fl_window_show(WINDOW n) { - reinterpret_cast(n)->show(); -} - - -void fl_window_hide(WINDOW n) { - reinterpret_cast(n)->hide(); -} - - -void fl_window_set_label(WINDOW n, char* text) { - reinterpret_cast(n)->copy_label(text); -} - - -void fl_window_size_range(WINDOW n, int lw, int lh, int hw, int hh, int dw, int dh, int a) { - reinterpret_cast(n)->size_range(lw, lh, hw, hh, dw, dh, a); -} - - -void fl_window_set_icon(WINDOW n, void * img) { - reinterpret_cast(n)->icon(reinterpret_cast(img)); -} - - -void fl_window_set_modal(WINDOW n) { - reinterpret_cast(n)->set_modal(); -} - - -void fl_window_set_non_modal(WINDOW n) { - reinterpret_cast(n)->set_non_modal(); -} - diff --git a/c_fl_window.h b/c_fl_window.h deleted file mode 100644 index c382919..0000000 --- a/c_fl_window.h +++ /dev/null @@ -1,24 +0,0 @@ - - -#ifndef FL_WINDOW_GUARD -#define FL_WINDOW_GUARD - - -typedef void* WINDOW; - - -extern "C" WINDOW new_fl_window(int x, int y, int w, int h, char* label); -extern "C" WINDOW new_fl_window2(int w, int h); -extern "C" void free_fl_window(WINDOW n); - -extern "C" void fl_window_show(WINDOW n); -extern "C" void fl_window_hide(WINDOW n); -extern "C" void fl_window_set_label(WINDOW n, char* text); -extern "C" void fl_window_size_range(WINDOW n, int lw, int lh, int hw, int hh, int dw, int dh, int a); -extern "C" void fl_window_set_icon(WINDOW n, void * img); -extern "C" void fl_window_set_modal(WINDOW n); -extern "C" void fl_window_set_non_modal(WINDOW n); - - -#endif - diff --git a/fltk-dialogs.adb b/fltk-dialogs.adb deleted file mode 100644 index 0c9adcf..0000000 --- a/fltk-dialogs.adb +++ /dev/null @@ -1,111 +0,0 @@ - - -with Interfaces.C; -with Interfaces.C.Strings; -use type Interfaces.C.Strings.chars_ptr; - - -package body FLTK.Dialogs is - - - procedure dialog_fl_alert - (M : in Interfaces.C.char_array); - pragma Import (C, dialog_fl_alert, "dialog_fl_alert"); - - 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; - pragma Import (C, dialog_fl_input, "dialog_fl_input"); - - procedure dialog_fl_message - (M : in Interfaces.C.char_array); - pragma Import (C, dialog_fl_message, "dialog_fl_message"); - - - - - procedure Alert - (Message : String) is - begin - dialog_fl_alert (Interfaces.C.To_C (Message)); - end Alert; - - - - - function Three_Way_Choice - (Message, Button1, Button2, Button3 : in String) - return Choice - is - Result : Interfaces.C.int := dialog_fl_choice - (Interfaces.C.To_C (Message), - Interfaces.C.To_C (Button1), - Interfaces.C.To_C (Button2), - Interfaces.C.To_C (Button3)); - begin - return Choice'Val (Result); - end Three_Way_Choice; - - - - - 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 Text_Input - (Message : in String; - Default : in String := "") - return String - is - Result : Interfaces.C.Strings.chars_ptr := dialog_fl_input - (Interfaces.C.To_C (Message), - 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 Text_Input; - - - - - procedure Message_Box - (Message : in String) is - begin - dialog_fl_message (Interfaces.C.To_C (Message)); - end Message_Box; - - -end FLTK.Dialogs; - diff --git a/fltk-dialogs.ads b/fltk-dialogs.ads deleted file mode 100644 index cb5b966..0000000 --- a/fltk-dialogs.ads +++ /dev/null @@ -1,33 +0,0 @@ - - -package FLTK.Dialogs is - - - procedure Alert - (Message : String); - - - type Choice is (First, Second, Third); - function Three_Way_Choice - (Message, Button1, Button2, Button3 : in String) - return Choice; - - - function File_Chooser - (Message, Filter_Pattern, Default : in String; - Relative : in Boolean := False) - return String; - - - function Text_Input - (Message : in String; - Default : in String := "") - return String; - - - procedure Message_Box - (Message : in String); - - -end FLTK.Dialogs; - diff --git a/fltk-enum_values.ads b/fltk-enum_values.ads deleted file mode 100644 index 068d5c1..0000000 --- a/fltk-enum_values.ads +++ /dev/null @@ -1,7 +0,0 @@ - - -private package FLTK.Enum_Values is - - -end FLTK.Enum_Values; - diff --git a/fltk-enums.adb b/fltk-enums.adb deleted file mode 100644 index 292e5ff..0000000 --- a/fltk-enums.adb +++ /dev/null @@ -1,71 +0,0 @@ - - -with Interfaces.C; -use type Interfaces.C.unsigned_long; - - -package body FLTK.Enums is - - - function Shortcut - (Key : Pressable_Key) - return Shortcut_Key is - begin - return This : Shortcut_Key do - This.Modifier := Mod_None; - This.Keypress := Key; - end return; - end Shortcut; - - - - - function Key_To_C - (Key : Shortcut_Key) - return Interfaces.C.unsigned_long is - begin - return Interfaces.C.unsigned_long (Key.Modifier) * - 65536 + Character'Pos (Key.Keypress); - end Key_To_C; - - - - - function "+" - (Left, Right : in Modifier_Key) - return Modifier_Key is - begin - return Left or Right; - end "+"; - - - - - function "+" - (Left : in Modifier_Key; - Right : in Pressable_Key) - return Shortcut_Key is - begin - return This : Shortcut_Key do - This.Modifier := Left; - This.Keypress := Right; - end return; - end "+"; - - - - - function "+" - (Left : in Modifier_Key; - Right : in Shortcut_Key) - return Shortcut_Key is - begin - return This : Shortcut_Key do - This.Modifier := Left or Right.Modifier; - This.Keypress := Right.Keypress; - end return; - end "+"; - - -end FLTK.Enums; - diff --git a/fltk-enums.ads b/fltk-enums.ads deleted file mode 100644 index 91f7353..0000000 --- a/fltk-enums.ads +++ /dev/null @@ -1,146 +0,0 @@ - - -with Interfaces.C; -private with FLTK.Enum_Values; - - -package FLTK.Enums is - - - type Box_Kind is - (No_Box, - Flat_Box, - Up_Box, - Down_Box, - Up_Frame, - Down_Frame, - Thin_Up_Box, - Thin_Down_Box, - Thin_Up_Frame, - Thin_Down_Frame, - Engraved_Box, - Embossed_Box, - Engraved_Frame, - Embossed_Frame, - Border_Box, - Shadow_Box, - Border_Frame, - Shadow_Frame, - Rounded_Box, - RShadow_Box, - Rounded_Frame, - RFlat_Box, - Round_Up_Box, - Round_Down_Box, - Diamond_Up_Box, - Diamond_Down_Box, - Oval_Box, - OShadow_Box, - Oval_Frame, - OFlat_Box, - Plastic_Up_Box, - Plastic_Down_Box, - Plastic_Up_Frame, - Plastic_Down_Frame, - Plastic_Thin_Up_Box, - Plastic_Thin_Down_Box, - Plastic_Round_Up_Box, - Plastic_Round_Down_Box, - Gtk_Up_Box, - Gtk_Down_Box, - Gtk_Up_Frame, - Gtk_Down_Frame, - Gtk_Thin_Up_Box, - Gtk_Thin_Down_Box, - Gtk_Thin_Up_Frame, - Gtk_Thin_Down_Frame, - Gtk_Round_Up_Box, - Gtk_Round_Down_Box, - Gleam_Up_Box, - Gleam_Down_Box, - Gleam_Up_Frame, - Gleam_Down_Frame, - Gleam_Thin_Up_Box, - Gleam_Thin_Down_Box, - Gleam_Round_Up_Box, - Gleam_Round_Down_Box, - Free_Box); - - - type Font_Kind is - (Helvetica, - Helvetica_Bold, - Helvetica_Italic, - Helvetica_Bold_Italic, - Courier, - Courier_Bold, - Courier_Italic, - Courier_Bold_Italic, - Times, - Times_Bold, - Times_Italic, - Times_Bold_Italic, - Symbol, - Screen, - Screen_Bold, - Zapf_Dingbats, - Free_Font); - - - type Label_Kind is - (Normal_Label, - No_Label, - Shadow_Label, - Engraved_Label, - Embossed_Label, - Multi_Label, - Icon_Label, - Image_Label, - Free_Label); - - - -- type Modifier_Key is private; - type Modifier_Key is new Interfaces.Unsigned_8; - - -- type Shortcut_Key is private; - type Shortcut_Key is - record - Modifier : Modifier_Key; - Keypress : Character; - end record; - - subtype Pressable_Key is Character range Character'Val (32) .. Character'Val (126); - function Shortcut (Key : Pressable_Key) return Shortcut_Key; - No_Key : constant Shortcut_Key; - - - function "+" (Left, Right : in Modifier_Key) return Modifier_Key; - function "+" (Left : in Modifier_Key; Right : in Pressable_Key) return Shortcut_Key; - function "+" (Left : in Modifier_Key; Right : in Shortcut_Key) return Shortcut_Key; - Mod_None : constant Modifier_Key; - Mod_Shift : constant Modifier_Key; - Mod_Ctrl : constant Modifier_Key; - Mod_Alt : constant Modifier_Key; - - - function Key_To_C - (Key : Shortcut_Key) - return Interfaces.C.unsigned_long; - - -private - - - -- these values designed to align with FLTK enumeration types - Mod_None : constant Modifier_Key := 2#00000000#; - Mod_Shift : constant Modifier_Key := 2#00000001#; - Mod_Ctrl : constant Modifier_Key := 2#00000100#; - Mod_Alt : constant Modifier_Key := 2#00001000#; - - - No_Key : constant Shortcut_Key := - (Modifier => Mod_None, Keypress => Character'Val (0)); - - -end FLTK.Enums; - diff --git a/fltk-images-rgb-png.adb b/fltk-images-rgb-png.adb deleted file mode 100644 index ecb2f5e..0000000 --- a/fltk-images-rgb-png.adb +++ /dev/null @@ -1,49 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Images.RGB.PNG is - - - function new_fl_png_image - (F : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_png_image, "new_fl_png_image"); - - procedure free_fl_png_image - (P : in System.Address); - pragma Import (C, free_fl_png_image, "free_fl_png_image"); - - - - - overriding procedure Finalize - (This : in out PNG_Image) is - begin - Finalize (RGB_Image (This)); - if This.Void_Ptr /= System.Null_Address then - if This in PNG_Image then - free_fl_png_image (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (Filename : in String) - return PNG_Image is - begin - return This : PNG_Image do - This.Void_Ptr := new_fl_png_image - (Interfaces.C.To_C (Filename)); - end return; - end Create; - - -end FLTK.Images.RGB.PNG; - diff --git a/fltk-images-rgb-png.ads b/fltk-images-rgb-png.ads deleted file mode 100644 index 0b44cb0..0000000 --- a/fltk-images-rgb-png.ads +++ /dev/null @@ -1,25 +0,0 @@ - - -package FLTK.Images.RGB.PNG is - - - type PNG_Image is new RGB_Image with private; - - - function Create - (Filename : in String) - return PNG_Image; - - -private - - - type PNG_Image is new RGB_Image with null record; - - - overriding procedure Finalize - (This : in out PNG_Image); - - -end FLTK.Images.RGB.PNG; - diff --git a/fltk-images-rgb.adb b/fltk-images-rgb.adb deleted file mode 100644 index 3556f74..0000000 --- a/fltk-images-rgb.adb +++ /dev/null @@ -1,14 +0,0 @@ - - -package body FLTK.Images.RGB is - - - overriding procedure Finalize - (This : in out RGB_Image) is - begin - Finalize (Image (This)); - end Finalize; - - -end FLTK.Images.RGB; - diff --git a/fltk-images-rgb.ads b/fltk-images-rgb.ads deleted file mode 100644 index ba47793..0000000 --- a/fltk-images-rgb.ads +++ /dev/null @@ -1,20 +0,0 @@ - - -package FLTK.Images.RGB is - - - type RGB_Image is new Image with private; - - -private - - - type RGB_Image is new Image with null record; - - - overriding procedure Finalize - (This : in out RGB_Image); - - -end FLTK.Images.RGB; - diff --git a/fltk-images.adb b/fltk-images.adb deleted file mode 100644 index bbd87c9..0000000 --- a/fltk-images.adb +++ /dev/null @@ -1,96 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Images is - - - function new_fl_image - (W, H, D : in Interfaces.C.int) - return System.Address; - pragma Import (C, new_fl_image, "new_fl_image"); - - procedure free_fl_image - (I : in System.Address); - pragma Import (C, free_fl_image, "free_fl_image"); - - function fl_image_w - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_image_w, "fl_image_w"); - - function fl_image_h - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_image_h, "fl_image_h"); - - function fl_image_d - (I : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_image_d, "fl_image_d"); - - - - - overriding procedure Finalize - (This : in out Image) is - begin - Finalize (Wrapper (This)); - if This.Void_Ptr /= System.Null_Address then - if This in Image then - free_fl_image (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (Width, Height, Depth : in Natural) - return Image is - begin - return This : Image do - This.Void_Ptr := new_fl_image - (Interfaces.C.int (Width), - Interfaces.C.int (Height), - Interfaces.C.int (Depth)); - end return; - end Create; - - - - - function Get_W - (This : in Image) - return Natural is - begin - return Natural (fl_image_w (This.Void_Ptr)); - end Get_W; - - - - - function Get_H - (This : in Image) - return Natural is - begin - return Natural (fl_image_h (This.Void_Ptr)); - end Get_H; - - - - - function Get_D - (This : in Image) - return Natural is - begin - return Natural (fl_image_d (This.Void_Ptr)); - end Get_D; - - -end FLTK.Images; - diff --git a/fltk-images.ads b/fltk-images.ads deleted file mode 100644 index f005443..0000000 --- a/fltk-images.ads +++ /dev/null @@ -1,40 +0,0 @@ - - -package FLTK.Images is - - - type Image is new Wrapper with private; - - - function Create - (Width, Height, Depth : in Natural) - return Image; - - - function Get_W - (This : in Image) - return Natural; - - - function Get_H - (This : in Image) - return Natural; - - - function Get_D - (This : in Image) - return Natural; - - -private - - - type Image is new Wrapper with null record; - - - overriding procedure Finalize - (This : in out Image); - - -end FLTK.Images; - diff --git a/fltk-text_buffers.adb b/fltk-text_buffers.adb deleted file mode 100644 index 52f12e0..0000000 --- a/fltk-text_buffers.adb +++ /dev/null @@ -1,540 +0,0 @@ - - -with Interfaces.C.Strings; -with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; -with Ada.Containers; -with System; -use type System.Address; -use type Interfaces.C.int; -use type Interfaces.C.Strings.chars_ptr; -use type Ada.Containers.Count_Type; - - -package body FLTK.Text_Buffers is - - - function new_fl_text_buffer - (RS, PGS : in Interfaces.C.int) - return System.Address; - pragma Import (C, new_fl_text_buffer, "new_fl_text_buffer"); - - procedure free_fl_text_buffer - (TB : in System.Address); - pragma Import (C, free_fl_text_buffer, "free_fl_text_buffer"); - - procedure fl_text_buffer_add_modify_callback - (TB, CB, UD : in System.Address); - pragma Import (C, fl_text_buffer_add_modify_callback, - "fl_text_buffer_add_modify_callback"); - - procedure fl_text_buffer_add_predelete_callback - (TB, CB, UD : in System.Address); - pragma Import (C, fl_text_buffer_add_predelete_callback, - "fl_text_buffer_add_predelete_callback"); - - procedure fl_text_buffer_call_modify_callbacks - (TB : in System.Address); - pragma Import (C, fl_text_buffer_call_modify_callbacks, - "fl_text_buffer_call_modify_callbacks"); - - procedure fl_text_buffer_call_predelete_callbacks - (TB : in System.Address); - pragma Import (C, fl_text_buffer_call_predelete_callbacks, - "fl_text_buffer_call_predelete_callbacks"); - - procedure fl_text_buffer_insert - (TB : in System.Address; - P : in Interfaces.C.int; - I : in Interfaces.C.char_array); - pragma Import (C, fl_text_buffer_insert, "fl_text_buffer_insert"); - - procedure fl_text_buffer_remove - (TB : in System.Address; - S, F : in Interfaces.C.int); - pragma Import (C, fl_text_buffer_remove, "fl_text_buffer_remove"); - - function fl_text_buffer_length - (TB : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_length, "fl_text_buffer_length"); - - function fl_text_buffer_loadfile - (TB : in System.Address; - N : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_loadfile, "fl_text_buffer_loadfile"); - - procedure fl_text_buffer_remove_selection - (TB : in System.Address); - pragma Import (C, fl_text_buffer_remove_selection, "fl_text_buffer_remove_selection"); - - function fl_text_buffer_savefile - (TB : in System.Address; - N : in Interfaces.C.char_array) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_savefile, "fl_text_buffer_savefile"); - - function fl_text_buffer_search_forward - (TB : in System.Address; - SP : in Interfaces.C.int; - IT : in Interfaces.C.char_array; - FP : out Interfaces.C.int; - CA : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_search_forward, "fl_text_buffer_search_forward"); - - function fl_text_buffer_search_backward - (TB : in System.Address; - SP : in Interfaces.C.int; - IT : in Interfaces.C.char_array; - FP : out Interfaces.C.int; - CA : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_search_backward, "fl_text_buffer_search_backward"); - - procedure fl_text_buffer_select - (TB : in System.Address; - S, E : in Interfaces.C.int); - pragma Import (C, fl_text_buffer_select, "fl_text_buffer_select"); - - function fl_text_buffer_selection_position - (TB : in System.Address; - S, E : out Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_selection_position, "fl_text_buffer_selection_position"); - - function fl_text_buffer_selected - (TB : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_selected, "fl_text_buffer_selected"); - - function fl_text_buffer_skip_lines - (TB : in System.Address; - S, L : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_skip_lines, "fl_text_buffer_skip_lines"); - - function fl_text_buffer_rewind_lines - (TB : in System.Address; - S, L : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_buffer_rewind_lines, "fl_text_buffer_rewind_lines"); - - function fl_text_buffer_char_at - (TB : in System.Address; - P : in Interfaces.C.int) - return Interfaces.C.unsigned; - pragma Import (C, fl_text_buffer_char_at, "fl_text_buffer_char_at"); - - function fl_text_buffer_text_range - (TB : in System.Address; - S, F : in Interfaces.C.int) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_text_buffer_text_range, "fl_text_buffer_text_range"); - - - - - procedure Finalize - (This : in out Text_Buffer) is - begin - if This.Void_Ptr /= System.Null_Address then - if This in Text_Buffer then - free_fl_text_buffer (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - procedure Modify_Callback_Hook - (Pos, Inserted, Deleted, Restyled : in Interfaces.C.int; - Text : in Interfaces.C.Strings.chars_ptr; - UD : in System.Address); - pragma Convention (C, Modify_Callback_Hook); - - procedure Modify_Callback_Hook - (Pos : in Interfaces.C.int; - Inserted, Deleted, Restyled : in Interfaces.C.int; - Text : in Interfaces.C.Strings.chars_ptr; - UD : in System.Address) - is - Action : Modification; - Place : Position := Position (Pos); - Length : Natural; - Deleted_Text : Unbounded_String := To_Unbounded_String (""); - - Ada_Text_Buffer : access Text_Buffer := - Text_Buffer_Convert.To_Pointer (UD); - begin - if Ada_Text_Buffer.CB_Active then - if Inserted > 0 then - Length := Natural (Inserted); - Action := Insert; - elsif Deleted > 0 then - Length := Natural (Deleted); - Action := Delete; - if Text /= Interfaces.C.Strings.Null_Ptr then - Deleted_Text := To_Unbounded_String (Interfaces.C.Strings.Value (Text)); - end if; - elsif Restyled > 0 then - Length := Natural (Restyled); - Action := Restyle; - else - Length := 0; - Action := None; - end if; - - for CB of Ada_Text_Buffer.Modify_CBs loop - CB.all (Action, Place, Length, To_String (Deleted_Text)); - end loop; - end if; - end Modify_Callback_Hook; - - - - - procedure Predelete_Callback_Hook - (Pos, Deleted : in Interfaces.C.int; - UD : in System.Address); - pragma Convention (C, Predelete_Callback_Hook); - - procedure Predelete_Callback_Hook - (Pos, Deleted : in Interfaces.C.int; - UD : in System.Address) - is - Place : Position := Position (Pos); - Length : Natural := Natural (Deleted); - - Ada_Text_Buffer : access Text_Buffer := - Text_Buffer_Convert.To_Pointer (UD); - begin - if Ada_Text_Buffer.CB_Active then - for CB of Ada_Text_Buffer.Predelete_CBs loop - CB.all (Place, Length); - end loop; - end if; - end Predelete_Callback_Hook; - - - - - function Create - (Requested_Size : in Natural := 0; - Preferred_Gap_Size : in Natural := 1024) - return Text_Buffer is - begin - return This : Text_Buffer do - This.Void_Ptr := new_fl_text_buffer - (Interfaces.C.int (Requested_Size), - Interfaces.C.int (Preferred_Gap_Size)); - - This.Modify_CBs := Modify_Vectors.Empty_Vector; - This.Predelete_CBs := Predelete_Vectors.Empty_Vector; - This.CB_Active := True; - end return; - end Create; - - - - - procedure Add_Modify_Callback - (This : in out Text_Buffer; - Func : in Modify_Callback) is - begin - if This.Modify_CBs.Length = 0 then - fl_text_buffer_add_modify_callback - (This.Void_Ptr, - Modify_Callback_Hook'Address, - This'Address); - end if; - This.Modify_CBs.Append (Func); - end Add_Modify_Callback; - - - - - procedure Add_Predelete_Callback - (This : in out Text_Buffer; - Func : in Predelete_Callback) is - begin - if This.Predelete_CBs.Length = 0 then - fl_text_buffer_add_predelete_callback - (This.Void_Ptr, - Predelete_Callback_Hook'Address, - This'Address); - end if; - This.Predelete_CBs.Append (Func); - end Add_Predelete_Callback; - - - - - procedure Call_Modify_Callbacks - (This : in out Text_Buffer) is - begin - fl_text_buffer_call_modify_callbacks (This.Void_Ptr); - end Call_Modify_Callbacks; - - - - - procedure Call_Predelete_Callbacks - (This : in out Text_Buffer) is - begin - fl_text_buffer_call_predelete_callbacks (This.Void_Ptr); - end Call_Predelete_Callbacks; - - - - - procedure Enable_Callbacks - (This : in out Text_Buffer) is - begin - This.CB_Active := True; - end Enable_Callbacks; - - - - - procedure Disable_Callbacks - (This : in out Text_Buffer) is - begin - This.CB_Active := False; - end Disable_Callbacks; - - - - - procedure Insert_Text - (This : in out Text_Buffer; - Pos : in Natural; - Item : in String) is - begin - fl_text_buffer_insert - (This.Void_Ptr, - Interfaces.C.int (Pos), - Interfaces.C.To_C (Item)); - end Insert_Text; - - - - - procedure Remove_Text - (This : in out Text_Buffer; - Start, Finish : in Natural) is - begin - fl_text_buffer_remove - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish)); - end Remove_Text; - - - - - function Length - (This : in Text_Buffer) - return Natural is - begin - return Natural (fl_text_buffer_length (This.Void_Ptr)); - end Length; - - - - - procedure Load_File - (This : in Text_Buffer; - Name : in String) - is - Err_No : Interfaces.C.int := fl_text_buffer_loadfile - (This.Void_Ptr, - Interfaces.C.To_C (Name)); - begin - if Err_No /= 0 then - raise Storage_Error; - end if; - end Load_File; - - - - - procedure Remove_Selected_Text - (This : in out Text_Buffer) is - begin - fl_text_buffer_remove_selection (This.Void_Ptr); - end Remove_Selected_Text; - - - - - procedure Save_File - (This : in Text_Buffer; - Name : in String) - is - Err_No : Interfaces.C.int := fl_text_buffer_savefile - (This.Void_Ptr, - Interfaces.C.To_C (Name)); - begin - if Err_No /= 0 then - raise Storage_Error; - end if; - end Save_File; - - - - - function Search_Forward - (This : in Text_Buffer; - Start_At : in Natural; - Item : in String; - Found_At : out Natural; - Match_Case : in Boolean) - return Boolean - is - Found_Raw, Result : Interfaces.C.int; - begin - Result := fl_text_buffer_search_forward - (This.Void_Ptr, - Interfaces.C.int (Start_At), - Interfaces.C.To_C (Item), - Found_Raw, - Boolean'Pos (Match_Case)); - if Result /= 0 then - Found_At := Natural (Found_Raw); - end if; - return Result /= 0; - end Search_Forward; - - - - - function Search_Backward - (This : in Text_Buffer; - Start_At : in Natural; - Item : in String; - Found_At : out Natural; - Match_Case : in Boolean) - return Boolean - is - Found_Raw, Result : Interfaces.C.int; - begin - Result := fl_text_buffer_search_backward - (This.Void_Ptr, - Interfaces.C.int (Start_At), - Interfaces.C.To_C (Item), - Found_Raw, - Boolean'Pos (Match_Case)); - if Result /= 0 then - Found_At := Natural (Found_Raw); - end if; - return Result /= 0; - end Search_Backward; - - - - - procedure Set_Selection - (This : in out Text_Buffer; - Start, Finish : in Natural) is - begin - fl_text_buffer_select - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish)); - end Set_Selection; - - - - - function Get_Selection - (This : in Text_Buffer; - Start, Finish : out Natural) - return Boolean - is - Result, Start_Raw, Finish_Raw : Interfaces.C.int; - begin - Result := fl_text_buffer_selection_position - (This.Void_Ptr, - Start_Raw, - Finish_Raw); - if Result /= 0 then - Start := Natural (Start_Raw); - Finish := Natural (Finish_Raw); - end if; - return Result /= 0; - end Get_Selection; - - - - - function Has_Selection - (This : in Text_Buffer) - return Boolean is - begin - return fl_text_buffer_selected (This.Void_Ptr) /= 0; - end Has_Selection; - - - - - function Skip_Lines - (This : in out Text_Buffer; - Start, Lines : in Natural) - return Natural is - begin - return Natural (fl_text_buffer_skip_lines - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Lines))); - end Skip_Lines; - - - - - function Rewind_Lines - (This : in out Text_Buffer; - Start, Lines : in Natural) - return Natural is - begin - return Natural (fl_text_buffer_rewind_lines - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Lines))); - end Rewind_Lines; - - - - - function Character_At - (This : in Text_Buffer; - Pos : in Natural) - return Character is - begin - return Character'Val (fl_text_buffer_char_at - (This.Void_Ptr, - Interfaces.C.int (Pos))); - end Character_At; - - - - - function Text_At - (This : in Text_Buffer; - Start, Finish : in Natural) - return String - is - C_Str : Interfaces.C.Strings.chars_ptr := fl_text_buffer_text_range - (This.Void_Ptr, - Interfaces.C.int (Start), - Interfaces.C.int (Finish)); - The_Text : String := Interfaces.C.Strings.Value (C_Str); - begin - Interfaces.C.Strings.Free (C_Str); - return The_Text; - end Text_At; - - -end FLTK.Text_Buffers; - diff --git a/fltk-text_buffers.ads b/fltk-text_buffers.ads deleted file mode 100644 index d3e1bab..0000000 --- a/fltk-text_buffers.ads +++ /dev/null @@ -1,180 +0,0 @@ - - -private with Ada.Containers.Vectors; -private with System.Address_To_Access_Conversions; - - -package FLTK.Text_Buffers is - - - type Text_Buffer is new Wrapper with private; - type Text_Buffer_Cursor (Data : access Text_Buffer'Class) is limited null record - with Implicit_Dereference => Data; - - - type Position is new Natural; - type Modification is (Insert, Restyle, Delete, None); - - - type Modify_Callback is access procedure - (Action : in Modification; - Place : in Position; - Length : in Natural; - Deleted_Text : in String); - - - type Predelete_Callback is access procedure - (Place : in Position; - Length : in Natural); - - - function Create - (Requested_Size : in Natural := 0; - Preferred_Gap_Size : in Natural := 1024) - return Text_Buffer; - - - procedure Add_Modify_Callback - (This : in out Text_Buffer; - Func : in Modify_Callback); - - - procedure Add_Predelete_Callback - (This : in out Text_Buffer; - Func : in Predelete_Callback); - - - procedure Call_Modify_Callbacks - (This : in out Text_Buffer); - - - procedure Call_Predelete_Callbacks - (This : in out Text_Buffer); - - - procedure Enable_Callbacks - (This : in out Text_Buffer); - - - procedure Disable_Callbacks - (This : in out Text_Buffer); - - - procedure Insert_Text - (This : in out Text_Buffer; - Pos : in Natural; - Item : in String); - - - procedure Remove_Text - (This : in out Text_Buffer; - Start, Finish : in Natural); - - - function Length - (This : in Text_Buffer) - return Natural; - - - procedure Load_File - (This : in Text_Buffer; - Name : in String); - - - procedure Remove_Selected_Text - (This : in out Text_Buffer); - - - procedure Save_File - (This : in Text_Buffer; - Name : in String); - - - function Search_Forward - (This : in Text_Buffer; - Start_At : in Natural; - Item : in String; - Found_At : out Natural; - Match_Case : in Boolean) - return Boolean; - - - function Search_Backward - (This : in Text_Buffer; - Start_At : in Natural; - Item : in String; - Found_At : out Natural; - Match_Case : in Boolean) - return Boolean; - - - procedure Set_Selection - (This : in out Text_Buffer; - Start, Finish : in Natural); - - - function Get_Selection - (This : in Text_Buffer; - Start, Finish : out Natural) - return Boolean; - - - function Has_Selection - (This : in Text_Buffer) - return Boolean; - - - -- only takes into account newline characters, not word wrap - function Skip_Lines - (This : in out Text_Buffer; - Start, Lines : in Natural) - return Natural; - - - -- only takes into account newline characters, not word wrap - function Rewind_Lines - (This : in out Text_Buffer; - Start, Lines : in Natural) - return Natural; - - - function Character_At - (This : in Text_Buffer; - Pos : in Natural) - return Character; - - - function Text_At - (This : in Text_Buffer; - Start, Finish : in Natural) - return String; - - -private - - - package Modify_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, - Element_Type => Modify_Callback); - package Predelete_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, - Element_Type => Predelete_Callback); - - - type Text_Buffer is new Wrapper with - record - CB_Active : Boolean; - Modify_CBs : Modify_Vectors.Vector; - Predelete_CBs : Predelete_Vectors.Vector; - end record; - - - overriding procedure Finalize - (This : in out Text_Buffer); - - - package Text_Buffer_Convert is new System.Address_To_Access_Conversions (Text_Buffer); - - -end FLTK.Text_Buffers; - diff --git a/fltk-widgets-boxes.adb b/fltk-widgets-boxes.adb deleted file mode 100644 index 7b70f01..0000000 --- a/fltk-widgets-boxes.adb +++ /dev/null @@ -1,58 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widgets.Boxes is - - - function new_fl_box - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_box, "new_fl_box"); - - procedure free_fl_box - (B : in System.Address); - pragma Import (C, free_fl_box, "free_fl_box"); - - - - - procedure Finalize - (This : in out Box) is - begin - Finalize (Widget (This)); - if (This.Void_Ptr /= System.Null_Address) then - if This in Box then - free_fl_box (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Box is - begin - return This : Box do - This.Void_Ptr := new_fl_box - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - -end FLTK.Widgets.Boxes; - diff --git a/fltk-widgets-boxes.ads b/fltk-widgets-boxes.ads deleted file mode 100644 index 00f84d4..0000000 --- a/fltk-widgets-boxes.ads +++ /dev/null @@ -1,26 +0,0 @@ - - -package FLTK.Widgets.Boxes is - - - type Box is new Widget with private; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Box; - - -private - - - type Box is new Widget with null record; - - - overriding procedure Finalize - (This : in out Box); - - -end FLTK.Widgets.Boxes; - diff --git a/fltk-widgets-buttons-enter.adb b/fltk-widgets-buttons-enter.adb deleted file mode 100644 index bbef830..0000000 --- a/fltk-widgets-buttons-enter.adb +++ /dev/null @@ -1,58 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widgets.Buttons.Enter is - - - function new_fl_return_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_return_button, "new_fl_return_button"); - - procedure free_fl_return_button - (B : in System.Address); - pragma Import (C, free_fl_return_button, "free_fl_return_button"); - - - - - procedure Finalize - (This : in out Enter_Button) is - begin - Finalize (Button (This)); - if (This.Void_Ptr /= System.Null_Address) then - if This in Enter_Button then - free_fl_return_button (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Enter_Button is - begin - return This : Enter_Button do - This.Void_Ptr := new_fl_return_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - -end FLTK.Widgets.Buttons.Enter; - diff --git a/fltk-widgets-buttons-enter.ads b/fltk-widgets-buttons-enter.ads deleted file mode 100644 index 1db7308..0000000 --- a/fltk-widgets-buttons-enter.ads +++ /dev/null @@ -1,29 +0,0 @@ - - --- Return Buttons, but return is a reserved word, so they're Enter Buttons instead - - -package FLTK.Widgets.Buttons.Enter is - - - type Enter_Button is new Button with private; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Enter_Button; - - -private - - - type Enter_Button is new Button with null record; - - - overriding procedure Finalize - (This : in out Enter_Button); - - -end FLTK.Widgets.Buttons.Enter; - diff --git a/fltk-widgets-buttons-light-check.adb b/fltk-widgets-buttons-light-check.adb deleted file mode 100644 index 7f16c9d..0000000 --- a/fltk-widgets-buttons-light-check.adb +++ /dev/null @@ -1,58 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widgets.Buttons.Light.Check is - - - function new_fl_check_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_check_button, "new_fl_check_button"); - - procedure free_fl_check_button - (B : in System.Address); - pragma Import (C, free_fl_check_button, "free_fl_check_button"); - - - - - procedure Finalize - (This : in out Check_Button) is - begin - Finalize (Light_Button (This)); - if (This.Void_Ptr /= System.Null_Address) then - if This in Check_Button then - free_fl_check_button (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Check_Button is - begin - return This : Check_Button do - This.Void_Ptr := new_fl_check_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - -end FLTK.Widgets.Buttons.Light.Check; - diff --git a/fltk-widgets-buttons-light-check.ads b/fltk-widgets-buttons-light-check.ads deleted file mode 100644 index 1ab34f0..0000000 --- a/fltk-widgets-buttons-light-check.ads +++ /dev/null @@ -1,26 +0,0 @@ - - -package FLTK.Widgets.Buttons.Light.Check is - - - type Check_Button is new Light_Button with private; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Check_Button; - - -private - - - type Check_Button is new Light_Button with null record; - - - overriding procedure Finalize - (This : in out Check_Button); - - -end FLTK.Widgets.Buttons.Light.Check; - diff --git a/fltk-widgets-buttons-light-radio.adb b/fltk-widgets-buttons-light-radio.adb deleted file mode 100644 index 1a741b9..0000000 --- a/fltk-widgets-buttons-light-radio.adb +++ /dev/null @@ -1,58 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widgets.Buttons.Light.Radio is - - - function new_fl_radio_light_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_radio_light_button, "new_fl_radio_light_button"); - - procedure free_fl_radio_light_button - (B : in System.Address); - pragma Import (C, free_fl_radio_light_button, "free_fl_radio_light_button"); - - - - - procedure Finalize - (This : in out Radio_Light_Button) is - begin - Finalize (Light_Button (This)); - if (This.Void_Ptr /= System.Null_Address) then - if This in Radio_Light_Button then - free_fl_radio_light_button (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Radio_Light_Button is - begin - return This : Radio_Light_Button do - This.Void_Ptr := new_fl_radio_light_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - -end FLTK.Widgets.Buttons.Light.Radio; - diff --git a/fltk-widgets-buttons-light-radio.ads b/fltk-widgets-buttons-light-radio.ads deleted file mode 100644 index bad0a92..0000000 --- a/fltk-widgets-buttons-light-radio.ads +++ /dev/null @@ -1,26 +0,0 @@ - - -package FLTK.Widgets.Buttons.Light.Radio is - - - type Radio_Light_Button is new Light_Button with private; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Radio_Light_Button; - - -private - - - type Radio_Light_Button is new Light_Button with null record; - - - overriding procedure Finalize - (This : in out Radio_Light_Button); - - -end FLTK.Widgets.Buttons.Light.Radio; - diff --git a/fltk-widgets-buttons-light-round-radio.adb b/fltk-widgets-buttons-light-round-radio.adb deleted file mode 100644 index c61430f..0000000 --- a/fltk-widgets-buttons-light-round-radio.adb +++ /dev/null @@ -1,58 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widgets.Buttons.Light.Round.Radio is - - - function new_fl_radio_round_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_radio_round_button, "new_fl_radio_round_button"); - - procedure free_fl_radio_round_button - (B : in System.Address); - pragma Import (C, free_fl_radio_round_button, "free_fl_radio_round_button"); - - - - - procedure Finalize - (This : in out Radio_Round_Button) is - begin - Finalize (Round_Button (This)); - if (This.Void_Ptr /= System.Null_Address) then - if This in Radio_Round_Button then - free_fl_radio_round_button (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Radio_Round_Button is - begin - return This : Radio_Round_Button do - This.Void_Ptr := new_fl_radio_round_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - -end FLTK.Widgets.Buttons.Light.Round.Radio; - diff --git a/fltk-widgets-buttons-light-round-radio.ads b/fltk-widgets-buttons-light-round-radio.ads deleted file mode 100644 index ad1eec7..0000000 --- a/fltk-widgets-buttons-light-round-radio.ads +++ /dev/null @@ -1,26 +0,0 @@ - - -package FLTK.Widgets.Buttons.Light.Round.Radio is - - - type Radio_Round_Button is new Round_Button with private; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Radio_Round_Button; - - -private - - - type Radio_Round_Button is new Round_Button with null record; - - - overriding procedure Finalize - (This : in out Radio_Round_Button); - - -end FLTK.Widgets.Buttons.Light.Round.Radio; - diff --git a/fltk-widgets-buttons-light-round.adb b/fltk-widgets-buttons-light-round.adb deleted file mode 100644 index 8be6a4e..0000000 --- a/fltk-widgets-buttons-light-round.adb +++ /dev/null @@ -1,58 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widgets.Buttons.Light.Round is - - - function new_fl_round_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_round_button, "new_fl_round_button"); - - procedure free_fl_round_button - (B : in System.Address); - pragma Import (C, free_fl_round_button, "free_fl_round_button"); - - - - - procedure Finalize - (This : in out Round_Button) is - begin - Finalize (Light_Button (This)); - if (This.Void_Ptr /= System.Null_Address) then - if This in Round_Button then - free_fl_round_button (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Round_Button is - begin - return This : Round_Button do - This.Void_Ptr := new_fl_round_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - -end FLTK.Widgets.Buttons.Light.Round; - diff --git a/fltk-widgets-buttons-light-round.ads b/fltk-widgets-buttons-light-round.ads deleted file mode 100644 index 7cb99b8..0000000 --- a/fltk-widgets-buttons-light-round.ads +++ /dev/null @@ -1,26 +0,0 @@ - - -package FLTK.Widgets.Buttons.Light.Round is - - - type Round_Button is new Light_Button with private; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Round_Button; - - -private - - - type Round_Button is new Light_Button with null record; - - - overriding procedure Finalize - (This : in out Round_Button); - - -end FLTK.Widgets.Buttons.Light.Round; - diff --git a/fltk-widgets-buttons-light.adb b/fltk-widgets-buttons-light.adb deleted file mode 100644 index cefc9ef..0000000 --- a/fltk-widgets-buttons-light.adb +++ /dev/null @@ -1,58 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widgets.Buttons.Light is - - - function new_fl_light_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_light_button, "new_fl_light_button"); - - procedure free_fl_light_button - (B : in System.Address); - pragma Import (C, free_fl_light_button, "free_fl_light_button"); - - - - - procedure Finalize - (This : in out Light_Button) is - begin - Finalize (Button (This)); - if (This.Void_Ptr /= System.Null_Address) then - if This in Light_Button then - free_fl_light_button (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Light_Button is - begin - return This : Light_Button do - This.Void_Ptr := new_fl_light_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - -end FLTK.Widgets.Buttons.Light; - diff --git a/fltk-widgets-buttons-light.ads b/fltk-widgets-buttons-light.ads deleted file mode 100644 index 6fe7a76..0000000 --- a/fltk-widgets-buttons-light.ads +++ /dev/null @@ -1,26 +0,0 @@ - - -package FLTK.Widgets.Buttons.Light is - - - type Light_Button is new Button with private; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Light_Button; - - -private - - - type Light_Button is new Button with null record; - - - overriding procedure Finalize - (This : in out Light_Button); - - -end FLTK.Widgets.Buttons.Light; - diff --git a/fltk-widgets-buttons-radio.adb b/fltk-widgets-buttons-radio.adb deleted file mode 100644 index d3fd405..0000000 --- a/fltk-widgets-buttons-radio.adb +++ /dev/null @@ -1,58 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widgets.Buttons.Radio is - - - function new_fl_radio_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_radio_button, "new_fl_radio_button"); - - procedure free_fl_radio_button - (B : in System.Address); - pragma Import (C, free_fl_radio_button, "free_fl_radio_button"); - - - - - procedure Finalize - (This : in out Radio_Button) is - begin - Finalize (Button (This)); - if This.Void_Ptr /= System.Null_Address then - if This in Radio_Button then - free_fl_radio_button (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Radio_Button is - begin - return This : Radio_Button do - This.Void_Ptr := new_fl_radio_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - -end FLTK.Widgets.Buttons.Radio; - diff --git a/fltk-widgets-buttons-radio.ads b/fltk-widgets-buttons-radio.ads deleted file mode 100644 index cf14eeb..0000000 --- a/fltk-widgets-buttons-radio.ads +++ /dev/null @@ -1,26 +0,0 @@ - - -package FLTK.Widgets.Buttons.Radio is - - - type Radio_Button is new Button with private; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Radio_Button; - - -private - - - type Radio_Button is new Button with null record; - - - overriding procedure Finalize - (This : in out Radio_Button); - - -end FLTK.Widgets.Buttons.Radio; - diff --git a/fltk-widgets-buttons-repeat.adb b/fltk-widgets-buttons-repeat.adb deleted file mode 100644 index 8e81a8e..0000000 --- a/fltk-widgets-buttons-repeat.adb +++ /dev/null @@ -1,58 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widgets.Buttons.Repeat is - - - function new_fl_repeat_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_repeat_button, "new_fl_repeat_button"); - - procedure free_fl_repeat_button - (B : in System.Address); - pragma Import (C, free_fl_repeat_button, "free_fl_repeat_button"); - - - - - procedure Finalize - (This : in out Repeat_Button) is - begin - Finalize (Button (This)); - if This.Void_Ptr /= System.Null_Address then - if This in Repeat_Button then - free_fl_repeat_button (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Repeat_Button is - begin - return This : Repeat_Button do - This.Void_Ptr := new_fl_repeat_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - -end FLTK.Widgets.Buttons.Repeat; - diff --git a/fltk-widgets-buttons-repeat.ads b/fltk-widgets-buttons-repeat.ads deleted file mode 100644 index 5c27b40..0000000 --- a/fltk-widgets-buttons-repeat.ads +++ /dev/null @@ -1,26 +0,0 @@ - - -package FLTK.Widgets.Buttons.Repeat is - - - type Repeat_Button is new Button with private; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Repeat_Button; - - -private - - - type Repeat_Button is new Button with null record; - - - overriding procedure Finalize - (This : in out Repeat_Button); - - -end FLTK.Widgets.Buttons.Repeat; - diff --git a/fltk-widgets-buttons-toggle.adb b/fltk-widgets-buttons-toggle.adb deleted file mode 100644 index 9b8ce83..0000000 --- a/fltk-widgets-buttons-toggle.adb +++ /dev/null @@ -1,58 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widgets.Buttons.Toggle is - - - function new_fl_toggle_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_toggle_button, "new_fl_toggle_button"); - - procedure free_fl_toggle_button - (B : in System.Address); - pragma Import (C, free_fl_toggle_button, "free_fl_toggle_button"); - - - - - procedure Finalize - (This : in out Toggle_Button) is - begin - Finalize (Button (This)); - if This.Void_Ptr /= System.Null_Address then - if This in Toggle_Button then - free_fl_toggle_button (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Toggle_Button is - begin - return This : Toggle_Button do - This.Void_Ptr := new_fl_toggle_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - -end FLTK.Widgets.Buttons.Toggle; - diff --git a/fltk-widgets-buttons-toggle.ads b/fltk-widgets-buttons-toggle.ads deleted file mode 100644 index a8f4181..0000000 --- a/fltk-widgets-buttons-toggle.ads +++ /dev/null @@ -1,26 +0,0 @@ - - -package FLTK.Widgets.Buttons.Toggle is - - - type Toggle_Button is new Button with private; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Toggle_Button; - - -private - - - type Toggle_Button is new Button with null record; - - - overriding procedure Finalize - (This : in out Toggle_Button); - - -end FLTK.Widgets.Buttons.Toggle; - diff --git a/fltk-widgets-buttons.adb b/fltk-widgets-buttons.adb deleted file mode 100644 index bc79b9c..0000000 --- a/fltk-widgets-buttons.adb +++ /dev/null @@ -1,101 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widgets.Buttons is - - - function new_fl_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_button, "new_fl_button"); - - procedure free_fl_button - (B : in System.Address); - pragma Import (C, free_fl_button, "free_fl_button"); - - function fl_button_get_state - (B : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_button_get_state, "fl_button_get_state"); - - procedure fl_button_set_state - (B : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_button_set_state, "fl_button_set_state"); - - procedure fl_button_set_only - (B : in System.Address); - pragma Import (C, fl_button_set_only, "fl_button_set_only"); - - - - - procedure Finalize - (This : in out Button) is - begin - Finalize (Widget (This)); - if This.Void_Ptr /= System.Null_Address then - if This in Button then - free_fl_button (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Button is - begin - return This : Button do - This.Void_Ptr := new_fl_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - - - - function Get_State - (This : in Button) - return State is - begin - return State'Val (fl_button_get_state (This.Void_Ptr)); - end Get_State; - - - - - procedure Set_State - (This : in out Button; - St : in State) is - begin - fl_button_set_state (This.Void_Ptr, State'Pos (St)); - end Set_State; - - - - - procedure Set_Only - (This : in out Button) is - begin - fl_button_set_only (This.Void_Ptr); - end Set_Only; - - -end FLTK.Widgets.Buttons; - diff --git a/fltk-widgets-buttons.ads b/fltk-widgets-buttons.ads deleted file mode 100644 index 403ad1a..0000000 --- a/fltk-widgets-buttons.ads +++ /dev/null @@ -1,43 +0,0 @@ - - -package FLTK.Widgets.Buttons is - - - type Button is new Widget with private; - - - type State is (Off, On); - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Button; - - - function Get_State - (This : in Button) - return State; - - - procedure Set_State - (This : in out Button; - St : in State); - - - procedure Set_Only - (This : in out Button); - - -private - - - type Button is new Widget with null record; - - - overriding procedure Finalize - (This : in out Button); - - -end FLTK.Widgets.Buttons; - diff --git a/fltk-widgets-groups-text_displays-text_editors.adb b/fltk-widgets-groups-text_displays-text_editors.adb deleted file mode 100644 index 0172128..0000000 --- a/fltk-widgets-groups-text_displays-text_editors.adb +++ /dev/null @@ -1,145 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is - - - function new_fl_text_editor - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_text_editor, "new_fl_text_editor"); - - procedure free_fl_text_editor - (TE : in System.Address); - pragma Import (C, free_fl_text_editor, "free_fl_text_editor"); - - procedure fl_text_editor_undo - (TE : in System.Address); - pragma Import (C, fl_text_editor_undo, "fl_text_editor_undo"); - - procedure fl_text_editor_cut - (TE : in System.Address); - pragma Import (C, fl_text_editor_cut, "fl_text_editor_cut"); - - procedure fl_text_editor_copy - (TE : in System.Address); - pragma Import (C, fl_text_editor_copy, "fl_text_editor_copy"); - - procedure fl_text_editor_paste - (TE : in System.Address); - pragma Import (C, fl_text_editor_paste, "fl_text_editor_paste"); - - procedure fl_text_editor_delete - (TE : in System.Address); - pragma Import (C, fl_text_editor_delete, "fl_text_editor_delete"); - - procedure fl_text_editor_remove_key_binding - (TE : in System.Address; - K : in Interfaces.C.unsigned; - M : in Interfaces.C.unsigned_long); - pragma Import (C, fl_text_editor_remove_key_binding, "fl_text_editor_remove_key_binding"); - - - - - procedure Finalize - (This : in out Text_Editor) is - begin - Finalize (Text_Display (This)); - if This.Void_Ptr /= System.Null_Address then - if This in Text_Editor then - free_fl_text_editor (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Text_Editor is - begin - return This : Text_Editor do - This.Void_Ptr := new_fl_text_editor - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - - - - procedure Undo - (This : in out Text_Editor) is - begin - fl_text_editor_undo (This.Void_Ptr); - end Undo; - - - - - procedure Cut - (This : in out Text_Editor) is - begin - fl_text_editor_cut (This.Void_Ptr); - end Cut; - - - - - procedure Copy - (This : in out Text_Editor) is - begin - fl_text_editor_copy (This.Void_Ptr); - end Copy; - - - - - procedure Paste - (This : in out Text_Editor) is - begin - fl_text_editor_paste (This.Void_Ptr); - end Paste; - - - - - procedure Delete - (This : in out Text_Editor) is - begin - fl_text_editor_delete (This.Void_Ptr); - end Delete; - - - - - procedure Remove_Key_Binding - (This : in out Text_Editor; - Key : in Shortcut_Key) - is - use type Interfaces.C.unsigned_long; - begin - fl_text_editor_remove_key_binding - (This.Void_Ptr, - Character'Pos (Key.Keypress), - Interfaces.C.unsigned_long (Key.Modifier) * 65536); - end Remove_Key_Binding; - - -end FLTK.Widgets.Groups.Text_Displays.Text_Editors; - diff --git a/fltk-widgets-groups-text_displays-text_editors.ads b/fltk-widgets-groups-text_displays-text_editors.ads deleted file mode 100644 index d4c9b85..0000000 --- a/fltk-widgets-groups-text_displays-text_editors.ads +++ /dev/null @@ -1,54 +0,0 @@ - - -with FLTK.Enums; use FLTK.Enums; - - -package FLTK.Widgets.Groups.Text_Displays.Text_Editors is - - - type Text_Editor is new Text_Display with private; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Text_Editor; - - - procedure Undo - (This : in out Text_Editor); - - - procedure Cut - (This : in out Text_Editor); - - - procedure Copy - (This : in out Text_Editor); - - - procedure Paste - (This : in out Text_Editor); - - - procedure Delete - (This : in out Text_Editor); - - - procedure Remove_Key_Binding - (This : in out Text_Editor; - Key : in Shortcut_Key); - - -private - - - type Text_Editor is new Text_Display with null record; - - - overriding procedure Finalize - (This : in out Text_Editor); - - -end FLTK.Widgets.Groups.Text_Displays.Text_Editors; - diff --git a/fltk-widgets-groups-text_displays.adb b/fltk-widgets-groups-text_displays.adb deleted file mode 100644 index 1aa5962..0000000 --- a/fltk-widgets-groups-text_displays.adb +++ /dev/null @@ -1,327 +0,0 @@ - - -with Interfaces.C; -with System; -with FLTK.Text_Buffers; -use type System.Address; - - -package body FLTK.Widgets.Groups.Text_Displays is - - - function new_fl_text_display - (X, Y, W, H : in Interfaces.C.int; - Label : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_text_display, "new_fl_text_display"); - - procedure free_fl_text_display - (TD : in System.Address); - pragma Import (C, free_fl_text_display, "free_fl_text_display"); - - function fl_text_display_get_buffer - (TD : in System.Address) - return System.Address; - pragma Import (C, fl_text_display_get_buffer, "fl_text_display_get_buffer"); - - procedure fl_text_display_set_buffer - (TD, TB : in System.Address); - pragma Import (C, fl_text_display_set_buffer, "fl_text_display_set_buffer"); - - function fl_text_display_get_text_color - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_display_get_text_color, "fl_text_display_get_text_color"); - - procedure fl_text_display_set_text_color - (TD : in System.Address; - C : in Interfaces.C.int); - pragma Import (C, fl_text_display_set_text_color, "fl_text_display_set_text_color"); - - function fl_text_display_get_text_font - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_display_get_text_font, "fl_text_display_get_text_font"); - - procedure fl_text_display_set_text_font - (TD : in System.Address; - F : in Interfaces.C.int); - pragma Import (C, fl_text_display_set_text_font, "fl_text_display_set_text_font"); - - function fl_text_display_get_text_size - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_display_get_text_size, "fl_text_display_get_text_size"); - - procedure fl_text_display_set_text_size - (TD : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_text_display_set_text_size, "fl_text_display_set_text_size"); - - function fl_text_display_get_insert_pos - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_display_get_insert_pos, "fl_text_display_get_insert_pos"); - - procedure fl_text_display_set_insert_pos - (TD : in System.Address; - P : in Interfaces.C.int); - pragma Import (C, fl_text_display_set_insert_pos, "fl_text_display_set_insert_pos"); - - procedure fl_text_display_show_insert_pos - (TD : in System.Address); - pragma Import (C, fl_text_display_show_insert_pos, "fl_text_display_show_insert_pos"); - - procedure fl_text_display_next_word - (TD : in System.Address); - pragma Import (C, fl_text_display_next_word, "fl_text_display_next_word"); - - procedure fl_text_display_previous_word - (TD : in System.Address); - pragma Import (C, fl_text_display_previous_word, "fl_text_display_previous_word"); - - procedure fl_text_display_wrap_mode - (TD : in System.Address; - W, M : in Interfaces.C.int); - pragma Import (C, fl_text_display_wrap_mode, "fl_text_display_wrap_mode"); - - function fl_text_display_skip_lines - (TD : in System.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"); - - function fl_text_display_rewind_lines - (TD : in System.Address; - S, L : in Interfaces.C.int) - return Interfaces.C.int; - pragma Import (C, fl_text_display_rewind_lines, "fl_text_display_rewind_lines"); - - procedure fl_text_display_linenumber_width - (TD : in System.Address; - W : in Interfaces.C.int); - pragma Import (C, fl_text_display_linenumber_width, "fl_text_display_linenumber_width"); - - - - - procedure Finalize - (This : in out Text_Display) is - begin - Finalize (Group (This)); - if (This.Void_Ptr /= System.Null_Address) then - if This in Text_Display then - free_fl_text_display (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - 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)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - - - - function Get_Buffer - (This : in Text_Display) - return FLTK.Text_Buffers.Text_Buffer_Cursor is - begin - return Ref : FLTK.Text_Buffers.Text_Buffer_Cursor (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); - end Set_Buffer; - - - - - 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.int (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; - - - - - 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; - - - - - 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 Skip_Lines - (This : in out 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 out 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; - - - - - procedure Set_Linenumber_Width - (This : in out Text_Display; - Width : in Natural) is - begin - fl_text_display_linenumber_width - (This.Void_Ptr, - Interfaces.C.int (Width)); - end Set_Linenumber_Width; - - -end FLTK.Widgets.Groups.Text_Displays; - diff --git a/fltk-widgets-groups-text_displays.ads b/fltk-widgets-groups-text_displays.ads deleted file mode 100644 index 0e136ff..0000000 --- a/fltk-widgets-groups-text_displays.ads +++ /dev/null @@ -1,124 +0,0 @@ - - -with FLTK.Text_Buffers; -with FLTK.Enums; use FLTK.Enums; - - -package FLTK.Widgets.Groups.Text_Displays is - - - type Text_Display is new Group with private; - - - type Wrap_Mode is (Wrap_None, Wrap_At_Column, Wrap_At_Pixel, Wrap_At_Bounds); - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Text_Display; - - - function Get_Buffer - (This : in Text_Display) - return FLTK.Text_Buffers.Text_Buffer_Cursor; - - - procedure Set_Buffer - (This : in out Text_Display; - Buff : in out FLTK.Text_Buffers.Text_Buffer); - - - function Get_Text_Color - (This : in Text_Display) - return Color; - - - procedure Set_Text_Color - (This : in out Text_Display; - Col : in Color); - - - function Get_Text_Font - (This : in Text_Display) - return Font_Kind; - - - procedure Set_Text_Font - (This : in out Text_Display; - Font : in Font_Kind); - - - function Get_Text_Size - (This : in Text_Display) - return Font_Size; - - - procedure Set_Text_Size - (This : in out Text_Display; - Size : in Font_Size); - - - function Get_Insert_Position - (This : in Text_Display) - return Natural; - - - procedure Set_Insert_Position - (This : in out Text_Display; - Pos : in Natural); - - - procedure Show_Insert_Position - (This : in out Text_Display); - - - procedure Next_Word - (This : in out Text_Display); - - - procedure Previous_Word - (This : in out Text_Display); - - - procedure Set_Wrap_Mode - (This : in out Text_Display; - Mode : in Wrap_Mode; - Margin : in Natural := 0); - - - -- takes into account word wrap as well as newline characters - function Skip_Lines - (This : in out Text_Display; - Start, Lines : in Natural; - Start_Pos_Is_Line_Start : in Boolean := False) - return Natural; - - - -- takes into account word wrap as well as newline characters - function Rewind_Lines - (This : in out Text_Display; - Start, Lines : in Natural) - return Natural; - - - procedure Set_Linenumber_Width - (This : in out Text_Display; - Width : in Natural); - - -private - - - type Text_Display is new Group with - record - Buffer : access FLTK.Text_Buffers.Text_Buffer; - end record; - - - overriding procedure Finalize - (This : in out Text_Display); - - -end FLTK.Widgets.Groups.Text_Displays; - diff --git a/fltk-widgets-groups-windows-double.adb b/fltk-widgets-groups-windows-double.adb deleted file mode 100644 index 407c018..0000000 --- a/fltk-widgets-groups-windows-double.adb +++ /dev/null @@ -1,108 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widgets.Groups.Windows.Double is - - - function new_fl_double_window - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_double_window, "new_fl_double_window"); - - function new_fl_double_window2 - (X, Y : in Interfaces.C.int) - return System.Address; - pragma Import (C, new_fl_double_window2, "new_fl_double_window2"); - - procedure free_fl_double_window - (W : in System.Address); - pragma Import (C, free_fl_double_window, "free_fl_double_window"); - - procedure fl_double_window_show - (W : in System.Address); - pragma Import (C, fl_double_window_show, "fl_double_window_show"); - - procedure fl_double_window_hide - (W : in System.Address); - pragma Import (C, fl_double_window_hide, "fl_double_window_hide"); - - - - - procedure Finalize - (This : in out Double_Window) is - begin - Finalize (Window (This)); - if This.Void_Ptr /= System.Null_Address then - if This in Double_Window then - free_fl_double_window (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Double_Window is - begin - return This : Double_Window do - This.Void_Ptr := new_fl_double_window - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - - - - function Create - (W, H : in Integer) - return Double_Window is - begin - return This : Double_Window do - This.Void_Ptr := new_fl_double_window2 - (Interfaces.C.int (W), - Interfaces.C.int (H)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - - - - procedure Show - (This : in Double_Window) is - begin - fl_double_window_show (This.Void_Ptr); - end Show; - - - - - procedure Hide - (This : in Double_Window) is - begin - fl_double_window_hide (This.Void_Ptr); - end Hide; - - -end FLTK.Widgets.Groups.Windows.Double; - diff --git a/fltk-widgets-groups-windows-double.ads b/fltk-widgets-groups-windows-double.ads deleted file mode 100644 index 214f698..0000000 --- a/fltk-widgets-groups-windows-double.ads +++ /dev/null @@ -1,39 +0,0 @@ - - -package FLTK.Widgets.Groups.Windows.Double is - - - type Double_Window is new Window with private; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Double_Window; - - - function Create - (W, H : in Integer) - return Double_Window; - - - procedure Show - (This : in Double_Window); - - - procedure Hide - (This : in Double_Window); - - -private - - - type Double_Window is new Window with null record; - - - overriding procedure Finalize - (This : in out Double_Window); - - -end FLTK.Widgets.Groups.Windows.Double; - diff --git a/fltk-widgets-groups-windows-single-menu.adb b/fltk-widgets-groups-windows-single-menu.adb deleted file mode 100644 index 8345308..0000000 --- a/fltk-widgets-groups-windows-single-menu.adb +++ /dev/null @@ -1,158 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; -use type Interfaces.C.unsigned; - - -package body FLTK.Widgets.Groups.Windows.Single.Menu is - - - function new_fl_menu_window - (X, Y, W, H : in Interfaces.C.int; - Label : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_menu_window, "new_fl_menu_window"); - - function new_fl_menu_window2 - (W, H : in Interfaces.C.int) - return System.Address; - pragma Import (C, new_fl_menu_window2, "new_fl_menu_window2"); - - procedure free_fl_menu_window - (M : in System.Address); - pragma Import (C, free_fl_menu_window, "free_fl_menu_window"); - - procedure fl_menu_window_show - (M : in System.Address); - pragma Import (C, fl_menu_window_show, "fl_menu_window_show"); - - procedure fl_menu_window_hide - (M : in System.Address); - pragma Import (C, fl_menu_window_hide, "fl_menu_window_hide"); - - procedure fl_menu_window_flush - (M : in System.Address); - pragma Import (C, fl_menu_window_flush, "fl_menu_window_flush"); - - procedure fl_menu_window_set_overlay - (M : in System.Address); - pragma Import (C, fl_menu_window_set_overlay, "fl_menu_window_set_overlay"); - - procedure fl_menu_window_clear_overlay - (M : in System.Address); - pragma Import (C, fl_menu_window_clear_overlay, "fl_menu_window_clear_overlay"); - - function fl_menu_window_overlay - (M : in System.Address) - return Interfaces.C.unsigned; - pragma Import (C, fl_menu_window_overlay, "fl_menu_window_overlay"); - - - - - procedure Finalize - (This : in out Menu_Window) is - begin - Finalize (Single_Window (This)); - if This.Void_Ptr /= System.Null_Address then - if This in Menu_Window then - free_fl_menu_window (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Menu_Window is - begin - return This : Menu_Window do - This.Void_Ptr := new_fl_menu_window - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - - - - function Create - (W, H : in Integer) - return Menu_Window is - begin - return This : Menu_Window do - This.Void_Ptr := new_fl_menu_window2 - (Interfaces.C.int (W), - Interfaces.C.int (H)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - - - - procedure Show - (This : in Menu_Window) is - begin - fl_menu_window_show (This.Void_Ptr); - end Show; - - - - - procedure Hide - (This : in Menu_Window) is - begin - fl_menu_window_hide (This.Void_Ptr); - end Hide; - - - - - procedure Flush - (This : in out Menu_Window) is - begin - fl_menu_window_flush (This.Void_Ptr); - end Flush; - - - - - function Get_Overlay - (This : in Menu_Window) - return Boolean is - begin - return fl_menu_window_overlay (This.Void_Ptr) /= 0; - end Get_Overlay; - - - - procedure Set_Overlay - (This : in out Menu_Window; - Value : in Boolean) is - begin - if Value then - fl_menu_window_set_overlay (This.Void_Ptr); - else - fl_menu_window_clear_overlay (This.Void_Ptr); - end if; - end Set_Overlay; - - -end FLTK.Widgets.Groups.Windows.Single.Menu; - diff --git a/fltk-widgets-groups-windows-single-menu.ads b/fltk-widgets-groups-windows-single-menu.ads deleted file mode 100644 index f5d88e7..0000000 --- a/fltk-widgets-groups-windows-single-menu.ads +++ /dev/null @@ -1,53 +0,0 @@ - - -package FLTK.Widgets.Groups.Windows.Single.Menu is - - - type Menu_Window is new Single_Window with private; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Menu_Window; - - - function Create - (W, H : in Integer) - return Menu_Window; - - - procedure Show - (This : in Menu_Window); - - - procedure Hide - (This : in Menu_Window); - - - procedure Flush - (This : in out Menu_Window); - - - function Get_Overlay - (This : in Menu_Window) - return Boolean; - - - procedure Set_Overlay - (This : in out Menu_Window; - Value : in Boolean); - - -private - - - type Menu_Window is new Single_Window with null record; - - - overriding procedure Finalize - (This : in out Menu_Window); - - -end FLTK.Widgets.Groups.Windows.Single.Menu; - diff --git a/fltk-widgets-groups-windows-single.adb b/fltk-widgets-groups-windows-single.adb deleted file mode 100644 index 16c5f44..0000000 --- a/fltk-widgets-groups-windows-single.adb +++ /dev/null @@ -1,108 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widgets.Groups.Windows.Single is - - - function new_fl_single_window - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_single_window, "new_fl_single_window"); - - function new_fl_single_window2 - (W, H : in Interfaces.C.int) - return System.Address; - pragma Import (C, new_fl_single_window2, "new_fl_single_window2"); - - procedure free_fl_single_window - (S : in System.Address); - pragma Import (C, free_fl_single_window, "free_fl_single_window"); - - procedure fl_single_window_show - (S : in System.Address); - pragma Import (C, fl_single_window_show, "fl_single_window_show"); - - procedure fl_single_window_flush - (S : in System.Address); - pragma Import (C, fl_single_window_flush, "fl_single_window_flush"); - - - - - procedure Finalize - (This : in out Single_Window) is - begin - Finalize (Window (This)); - if This.Void_Ptr /= System.Null_Address then - if This in Single_Window then - free_fl_single_window (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Single_Window is - begin - return This : Single_Window do - This.Void_Ptr := new_fl_single_window - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - - - - function Create - (W, H : in Integer) - return Single_Window is - begin - return This : Single_Window do - This.Void_Ptr := new_fl_single_window2 - (Interfaces.C.int (W), - Interfaces.C.int (H)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - - - - procedure Show - (This : in Single_Window) is - begin - fl_single_window_show (This.Void_Ptr); - end Show; - - - - - procedure Flush - (This : in out Single_Window) is - begin - fl_single_window_flush (This.Void_Ptr); - end Flush; - - -end FLTK.Widgets.Groups.Windows.Single; - diff --git a/fltk-widgets-groups-windows-single.ads b/fltk-widgets-groups-windows-single.ads deleted file mode 100644 index 07a2bca..0000000 --- a/fltk-widgets-groups-windows-single.ads +++ /dev/null @@ -1,39 +0,0 @@ - - -package FLTK.Widgets.Groups.Windows.Single is - - - type Single_Window is new Window with private; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Single_Window; - - - function Create - (W, H : in Integer) - return Single_Window; - - - procedure Show - (This : in Single_Window); - - - procedure Flush - (This : in out Single_Window); - - -private - - - type Single_Window is new Window with null record; - - - overriding procedure Finalize - (This : in out Single_Window); - - -end FLTK.Widgets.Groups.Windows.Single; - diff --git a/fltk-widgets-groups-windows.adb b/fltk-widgets-groups-windows.adb deleted file mode 100644 index 2d93bdd..0000000 --- a/fltk-widgets-groups-windows.adb +++ /dev/null @@ -1,191 +0,0 @@ - - -with Interfaces.C; -with System; -with FLTK.Images.RGB; -use type System.Address; - - -package body FLTK.Widgets.Groups.Windows is - - - function new_fl_window - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_window, "new_fl_window"); - - function new_fl_window2 - (W, H : in Interfaces.C.int) - return System.Address; - pragma Import (C, new_fl_window2, "new_fl_window2"); - - procedure free_fl_window - (W : in System.Address); - pragma Import (C, free_fl_window, "free_fl_window"); - - procedure fl_window_show - (W : in System.Address); - pragma Import (C, fl_window_show, "fl_window_show"); - - procedure fl_window_hide - (W : in System.Address); - pragma Import (C, fl_window_hide, "fl_window_hide"); - - procedure fl_window_set_label - (W : in System.Address; - T : in Interfaces.C.char_array); - pragma Import (C, fl_window_set_label, "fl_window_set_label"); - - procedure fl_window_size_range - (W : in System.Address; - LW, LH, HW, HH, DW, DH, A : in Interfaces.C.int); - pragma Import (C, fl_window_size_range, "fl_window_size_range"); - - procedure fl_window_set_icon - (W, P : in System.Address); - pragma Import (C, fl_window_set_icon, "fl_window_set_icon"); - - procedure fl_window_set_modal - (W : in System.Address); - pragma Import (C, fl_window_set_modal, "fl_window_set_modal"); - - procedure fl_window_set_non_modal - (W : in System.Address); - pragma Import (C, fl_window_set_non_modal, "fl_window_set_non_modal"); - - - - - procedure Finalize - (This : in out Window) is - begin - Finalize (Group (This)); - if This.Void_Ptr /= System.Null_Address then - if This in Window then - free_fl_window (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Window is - begin - return This : Window do - This.Void_Ptr := new_fl_window - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - - - - function Create - (W, H : in Integer) - return Window is - begin - return This : Window do - This.Void_Ptr := new_fl_window2 - (Interfaces.C.int (W), - Interfaces.C.int (H)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - - - - procedure Show - (This : in Window) is - begin - fl_window_show (This.Void_Ptr); - end Show; - - - - - procedure Hide - (This : in Window) is - begin - fl_window_hide (This.Void_Ptr); - end Hide; - - - - - procedure Set_Label - (This : in out Window; - Text : in String) is - begin - fl_window_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end Set_Label; - - - - - procedure Set_Size_Range - (This : in out Window; - Min_W, Min_H : in Integer; - Max_W, Max_H, Incre_W, Incre_H : in Integer := 0; - Keep_Aspect : in Boolean := False) is - begin - fl_window_size_range - (This.Void_Ptr, - Interfaces.C.int (Min_W), - Interfaces.C.int (Min_H), - Interfaces.C.int (Max_W), - Interfaces.C.int (Max_H), - Interfaces.C.int (Incre_W), - Interfaces.C.int (Incre_H), - Boolean'Pos (Keep_Aspect)); - end Set_Size_Range; - - - - - procedure Set_Icon - (This : in out Window; - Pic : in out FLTK.Images.RGB.RGB_Image'Class) is - begin - fl_window_set_icon - (This.Void_Ptr, - Wrapper (Pic).Void_Ptr); - end Set_Icon; - - - - - procedure Set_Modal - (This : in out Window) is - begin - fl_window_set_modal (This.Void_Ptr); - end Set_Modal; - - - - - procedure Set_Non_Modal - (This : in out Window) is - begin - fl_window_set_non_modal (This.Void_Ptr); - end Set_Non_Modal; - - -end FLTK.Widgets.Groups.Windows; - diff --git a/fltk-widgets-groups-windows.ads b/fltk-widgets-groups-windows.ads deleted file mode 100644 index 96047ee..0000000 --- a/fltk-widgets-groups-windows.ads +++ /dev/null @@ -1,67 +0,0 @@ - - -with FLTK.Images.RGB; - - -package FLTK.Widgets.Groups.Windows is - - - type Window is new Group with private; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Window; - - - function Create - (W, H : in Integer) - return Window; - - - procedure Show - (This : in Window); - - - procedure Hide - (This : in Window); - - - procedure Set_Label - (This : in out Window; - Text : in String); - - - procedure Set_Size_Range - (This : in out Window; - Min_W, Min_H : in Integer; - Max_W, Max_H, Incre_W, Incre_H : in Integer := 0; - Keep_Aspect : in Boolean := False); - - - procedure Set_Icon - (This : in out Window; - Pic : in out FLTK.Images.RGB.RGB_Image'Class); - - - procedure Set_Modal - (This : in out Window); - - - procedure Set_Non_Modal - (This : in out Window); - - -private - - - type Window is new Group with null record; - - - overriding procedure Finalize - (This : in out Window); - - -end FLTK.Widgets.Groups.Windows; - diff --git a/fltk-widgets-groups.adb b/fltk-widgets-groups.adb deleted file mode 100644 index 067407d..0000000 --- a/fltk-widgets-groups.adb +++ /dev/null @@ -1,202 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widgets.Groups is - - - function new_fl_group - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_group, "new_fl_group"); - - procedure free_fl_group - (G : in System.Address); - pragma Import (C, free_fl_group, "free_fl_group"); - - procedure fl_group_add - (G, W : in System.Address); - pragma Import (C, fl_group_add, "fl_group_add"); - - function fl_group_find - (G, W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_group_find, "fl_group_find"); - - procedure fl_group_insert - (G, W : in System.Address; - P : in Interfaces.C.int); - pragma Import (C, fl_group_insert, "fl_group_insert"); - - procedure fl_group_remove - (G, W : in System.Address); - pragma Import (C, fl_group_remove, "fl_group_remove"); - - procedure fl_group_remove2 - (G : in System.Address; - P : in Interfaces.C.int); - pragma Import (C, fl_group_remove2, "fl_group_remove2"); - - function fl_group_children - (G : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_group_children, "fl_group_children"); - - function fl_group_child - (G : in System.Address; - I : in Interfaces.C.int) - return System.Address; - pragma Import (C, fl_group_child, "fl_group_child"); - - procedure fl_group_resizable - (G, W : in System.Address); - pragma Import (C, fl_group_resizable, "fl_group_resizable"); - - - - - procedure Finalize - (This : in out Group) is - begin - Finalize (Widget (This)); - if This.Void_Ptr /= System.Null_Address then - This.Clear; - if This in Group then - free_fl_group (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Group is - begin - return This : Group do - This.Void_Ptr := new_fl_group - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_group_end (This.Void_Ptr); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - - - - procedure Add - (This : in out Group; - Item : in out Widget'Class) is - begin - fl_group_add (This.Void_Ptr, Item.Void_Ptr); - end Add; - - - - - function Child - (This : in Group; - Place : in Index) - return access Widget'Class - is - Widget_Ptr : System.Address := - fl_group_child (This.Void_Ptr, Interfaces.C.int (Place - 1)); - - Actual_Widget : access Widget'Class := - Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); - begin - return Actual_Widget; - end Child; - - - - - function Number_Of_Children - (This : in Group) - return Natural is - begin - return Natural (fl_group_children (This.Void_Ptr)); - end Number_Of_Children; - - - - - procedure Clear - (This : in out Group) is - begin - for I in reverse 1 .. This.Number_Of_Children loop - This.Remove (Index (I)); - end loop; - end Clear; - - - - - function Find - (This : in Group; - Item : in out Widget'Class) - return Index is - begin - -- should set this up to throw an exception if not found - return Index (fl_group_find (This.Void_Ptr, Item.Void_Ptr)); - end Find; - - - - - procedure Insert - (This : in out Group; - Item : in out Widget'Class; - Place : in Index) is - begin - fl_group_insert - (This.Void_Ptr, - Item.Void_Ptr, - Interfaces.C.int (Place)); - end Insert; - - - - - procedure Remove - (This : in out Group; - Item : in out Widget'Class) is - begin - fl_group_remove (This.Void_Ptr, Item.Void_Ptr); - end Remove; - - - - - procedure Remove - (This : in out Group; - Place : in Index) is - begin - fl_group_remove2 (This.Void_Ptr, Interfaces.C.int (Place)); - end Remove; - - - - - procedure Set_Resizable - (This : in out Group; - Item : in Widget'Class) is - begin - fl_group_resizable (This.Void_Ptr, Item.Void_Ptr); - end Set_Resizable; - - -end FLTK.Widgets.Groups; - diff --git a/fltk-widgets-groups.ads b/fltk-widgets-groups.ads deleted file mode 100644 index 57faf87..0000000 --- a/fltk-widgets-groups.ads +++ /dev/null @@ -1,82 +0,0 @@ - - -private with System; - - -package FLTK.Widgets.Groups is - - - type Group is new Widget with private; - type Index is new Positive; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Group; - - - procedure Add - (This : in out Group; - Item : in out Widget'Class); - - - function Child - (This : in Group; - Place : in Index) - return access Widget'Class; - - - function Number_Of_Children - (This : in Group) - return Natural; - - - procedure Clear - (This : in out Group); - - - function Find - (This : in Group; - Item : in out Widget'Class) - return Index; - - - procedure Insert - (This : in out Group; - Item : in out Widget'Class; - Place : in Index); - - - procedure Remove - (This : in out Group; - Item : in out Widget'Class); - - - procedure Remove - (This : in out Group; - Place : in Index); - - - procedure Set_Resizable - (This : in out Group; - Item : in Widget'Class); - - -private - - - type Group is new Widget with null record; - - - overriding procedure Finalize - (This : in out Group); - - - procedure fl_group_end - (G : in System.Address); - pragma Import (C, fl_group_end, "fl_group_end"); - - -end FLTK.Widgets.Groups; - diff --git a/fltk-widgets-inputs-int.adb b/fltk-widgets-inputs-int.adb deleted file mode 100644 index 30f3d01..0000000 --- a/fltk-widgets-inputs-int.adb +++ /dev/null @@ -1,75 +0,0 @@ - - -with Interfaces.C.Strings; -with System; -use type System.Address; - - -package body FLTK.Widgets.Inputs.Int is - - - function new_fl_int_input - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_int_input, "new_fl_int_input"); - - procedure free_fl_int_input - (F : in System.Address); - pragma Import (C, free_fl_int_input, "free_fl_int_input"); - - function fl_int_input_get_value - (F : in System.Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_int_input_get_value, "fl_int_input_get_value"); - - - - - procedure Finalize - (This : in out Integer_Input) is - begin - Finalize (Input (This)); - if This.Void_Ptr /= System.Null_Address then - if This in Integer_Input then - free_fl_int_input (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Integer_Input is - begin - return This : Integer_Input do - This.Void_Ptr := new_fl_int_input - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - - - - function Get_Value - (This : in Integer_Input) - return Integer is - begin - return Integer'Value - (Interfaces.C.Strings.Value - (fl_int_input_get_value (This.Void_Ptr))); - end Get_Value; - - -end FLTK.Widgets.Inputs.Int; - diff --git a/fltk-widgets-inputs-int.ads b/fltk-widgets-inputs-int.ads deleted file mode 100644 index 2777f54..0000000 --- a/fltk-widgets-inputs-int.ads +++ /dev/null @@ -1,31 +0,0 @@ - - -package FLTK.Widgets.Inputs.Int is - - - type Integer_Input is new Input with private; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Integer_Input; - - - function Get_Value - (This : in Integer_Input) - return Integer; - - -private - - - type Integer_Input is new Input with null record; - - - overriding procedure Finalize - (This : in out Integer_Input); - - -end FLTK.Widgets.Inputs.Int; - diff --git a/fltk-widgets-inputs.adb b/fltk-widgets-inputs.adb deleted file mode 100644 index 9af8e87..0000000 --- a/fltk-widgets-inputs.adb +++ /dev/null @@ -1,74 +0,0 @@ - - -with Interfaces.C; -with Interfaces.C.Strings; -with System; -use type System.Address; - - -package body FLTK.Widgets.Inputs is - - - function new_fl_input - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_input, "new_fl_input"); - - procedure free_fl_input - (F : in System.Address); - pragma Import (C, free_fl_input, "free_fl_input"); - - function fl_input_get_value - (F : in System.Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_input_get_value, "fl_input_get_value"); - - - - - procedure Finalize - (This : in out Input) is - begin - Finalize (Widget (This)); - if This.Void_Ptr /= System.Null_Address then - if This in Input then - free_fl_input (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Input is - begin - return This : Input do - This.Void_Ptr := new_fl_input - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - - - - function Get_Value - (This : in Input) - return String is - begin - return Interfaces.C.Strings.Value (fl_input_get_value (This.Void_Ptr)); - end Get_Value; - - -end FLTK.Widgets.Inputs; - diff --git a/fltk-widgets-inputs.ads b/fltk-widgets-inputs.ads deleted file mode 100644 index 0f818ac..0000000 --- a/fltk-widgets-inputs.ads +++ /dev/null @@ -1,31 +0,0 @@ - - -package FLTK.Widgets.Inputs is - - - type Input is new Widget with private; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Input; - - - function Get_Value - (This : in Input) - return String; - - -private - - - type Input is new Widget with null record; - - - overriding procedure Finalize - (This : in out Input); - - -end FLTK.Widgets.Inputs; - diff --git a/fltk-widgets-menus-menu_bars.adb b/fltk-widgets-menus-menu_bars.adb deleted file mode 100644 index 19d44e0..0000000 --- a/fltk-widgets-menus-menu_bars.adb +++ /dev/null @@ -1,58 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widgets.Menus.Menu_Bars is - - - function new_fl_menu_bar - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_menu_bar, "new_fl_menu_bar"); - - procedure free_fl_menu_bar - (M : in System.Address); - pragma Import (C, free_fl_menu_bar, "free_fl_menu_bar"); - - - - - procedure Finalize - (This : in out Menu_Bar) is - begin - Finalize (Menu (This)); - if This.Void_Ptr /= System.Null_Address then - if This in Menu_Bar then - free_fl_menu_bar (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Menu_Bar is - begin - return This : Menu_Bar do - This.Void_Ptr := new_fl_menu_bar - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - -end FLTK.Widgets.Menus.Menu_Bars; - diff --git a/fltk-widgets-menus-menu_bars.ads b/fltk-widgets-menus-menu_bars.ads deleted file mode 100644 index 0f975b3..0000000 --- a/fltk-widgets-menus-menu_bars.ads +++ /dev/null @@ -1,26 +0,0 @@ - - -package FLTK.Widgets.Menus.Menu_Bars is - - - type Menu_Bar is new Menu with private; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Menu_Bar; - - -private - - - type Menu_Bar is new Menu with null record; - - - overriding procedure Finalize - (This : in out Menu_Bar); - - -end FLTK.Widgets.Menus.Menu_Bars; - diff --git a/fltk-widgets-menus-menu_buttons.adb b/fltk-widgets-menus-menu_buttons.adb deleted file mode 100644 index 8347099..0000000 --- a/fltk-widgets-menus-menu_buttons.adb +++ /dev/null @@ -1,73 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widgets.Menus.Menu_Buttons is - - - function new_fl_menu_button - (X, Y, W, H : in Interfaces.C.int; - Text : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_menu_button, "new_fl_menu_button"); - - procedure free_fl_menu_button - (M : in System.Address); - pragma Import (C, free_fl_menu_button, "free_fl_menu_button"); - - procedure fl_menu_button_type - (M : in System.Address; - T : in Interfaces.C.unsigned); - pragma Import (C, fl_menu_button_type, "fl_menu_button_type"); - - - - - procedure Finalize - (This : in out Menu_Button) is - begin - Finalize (Menu (This)); - if This.Void_Ptr /= System.Null_Address then - if This in Menu_Button then - free_fl_menu_button (This.Void_Ptr); - end if; - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Menu_Button is - begin - return This : Menu_Button do - This.Void_Ptr := new_fl_menu_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Text)); - fl_widget_set_user_data - (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - end return; - end Create; - - - - - procedure Set_Popup_Kind - (This : in out Menu_Button; - Pop : in Popup_Buttons) is - begin - fl_menu_button_type (This.Void_Ptr, Popup_Buttons'Pos (Pop)); - end Set_Popup_Kind; - - -end FLTK.Widgets.Menus.Menu_Buttons; - diff --git a/fltk-widgets-menus-menu_buttons.ads b/fltk-widgets-menus-menu_buttons.ads deleted file mode 100644 index 5527abc..0000000 --- a/fltk-widgets-menus-menu_buttons.ads +++ /dev/null @@ -1,35 +0,0 @@ - - -package FLTK.Widgets.Menus.Menu_Buttons is - - - type Menu_Button is new Menu with private; - - - -- signifies which mouse buttons cause the menu to appear - type Popup_Buttons is (No_Popup, Popup1, Popup2, Popup12, Popup3, Popup13, Popup23, Popup123); - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Menu_Button; - - - procedure Set_Popup_Kind - (This : in out Menu_Button; - Pop : in Popup_Buttons); - - -private - - - type Menu_Button is new Menu with null record; - - - overriding procedure Finalize - (This : in out Menu_Button); - - -end FLTK.Widgets.Menus.Menu_Buttons; - diff --git a/fltk-widgets-menus.adb b/fltk-widgets-menus.adb deleted file mode 100644 index b92f0a1..0000000 --- a/fltk-widgets-menus.adb +++ /dev/null @@ -1,160 +0,0 @@ - - -with FLTK.Enums; use FLTK.Enums; -with Interfaces.C; -with System; -use type System.Address; -use type Interfaces.C.int; -use type Interfaces.C.unsigned_long; - - -package body FLTK.Widgets.Menus is - - - function "+" - (Left, Right : in Menu_Flag) - return Menu_Flag is - begin - return Left or Right; - end "+"; - - - - - function fl_menu_add - (M : in System.Address; - T : in Interfaces.C.char_array; - S : in Interfaces.C.unsigned_long; - C, U : in System.Address; - F : in Interfaces.C.unsigned_long) - return Interfaces.C.int; - pragma Import (C, fl_menu_add, "fl_menu_add"); - - function fl_menu_find_item - (M : in System.Address; - T : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, fl_menu_find_item, "fl_menu_find_item"); - - function fl_menu_mvalue - (M : in System.Address) - return System.Address; - pragma Import (C, fl_menu_mvalue, "fl_menu_mvalue"); - - function fl_menuitem_value - (MI : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_menuitem_value, "fl_menuitem_value"); - - procedure fl_menuitem_activate - (MI : in System.Address); - pragma Import (C, fl_menuitem_activate, "fl_menuitem_activate"); - - procedure fl_menuitem_deactivate - (MI : in System.Address); - pragma Import (C, fl_menuitem_deactivate, "fl_menuitem_deactivate"); - - - - - procedure Item_Hook (M, U : in System.Address); - pragma Convention (C, Item_Hook); - - procedure Item_Hook - (M, U : in System.Address) - is - Ada_Widget : access Widget'Class := - Widget_Convert.To_Pointer (fl_widget_get_user_data (M)); - Action : Widget_Callback := Callback_Convert.To_Pointer (U); - begin - Action.all (Ada_Widget.all); - end Item_Hook; - - - - - procedure Add - (This : in out Menu; - Text : in String; - Action : in Widget_Callback := null; - Shortcut : in Shortcut_Key := No_Key; - Flags : in Menu_Flag := Flag_Normal) - is - Place : Interfaces.C.int; - Callback, User_Data : System.Address; - begin - if Action = null then - Callback := System.Null_Address; - User_Data := System.Null_Address; - else - Callback := Item_Hook'Address; - User_Data := Callback_Convert.To_Address (Action); - end if; - - Place := fl_menu_add - (This.Void_Ptr, - Interfaces.C.To_C (Text), - Key_To_C (Shortcut), - Callback, - User_Data, - Interfaces.C.unsigned_long (Flags)); - end Add; - - - - - function Find_Item - (This : in Menu'Class; - Name : in String) - return Menu_Item is - begin - return Item : Menu_Item do - Item.Void_Ptr := fl_menu_find_item - (This.Void_Ptr, - Interfaces.C.To_C (Name)); - end return; - end Find_Item; - - - - - function Chosen - (This : in Menu'Class) - return Menu_Item is - begin - return Item : Menu_Item do - Item.Void_Ptr := fl_menu_mvalue (This.Void_Ptr); - end return; - end Chosen; - - - - - function Value - (Item : in Menu_Item) - return Boolean is - begin - return fl_menuitem_value (Item.Void_Ptr) /= 0; - end Value; - - - - - procedure Activate - (Item : in Menu_Item) is - begin - fl_menuitem_activate (Item.Void_Ptr); - end Activate; - - - - - procedure Deactivate - (Item : in Menu_Item) is - begin - fl_menuitem_deactivate (Item.Void_Ptr); - end Deactivate; - - -end FLTK.Widgets.Menus; - diff --git a/fltk-widgets-menus.ads b/fltk-widgets-menus.ads deleted file mode 100644 index d01f02e..0000000 --- a/fltk-widgets-menus.ads +++ /dev/null @@ -1,97 +0,0 @@ - - -with FLTK.Enums; use FLTK.Enums; -private with Interfaces; -private with System; - - -package FLTK.Widgets.Menus is - - - type Menu is abstract new Widget with private; - type Menu_Cursor (Data : access Menu'Class) is limited null record - with Implicit_Dereference => Data; - - - type Menu_Item is tagged limited private; - - - type Index is new Positive; - - - type Menu_Flag is private; - function "+" (Left, Right : in Menu_Flag) return Menu_Flag; - Flag_Normal : constant Menu_Flag; - Flag_Inactive : constant Menu_Flag; - Flag_Toggle : constant Menu_Flag; - Flag_Value : constant Menu_Flag; - Flag_Radio : constant Menu_Flag; - Flag_Invisible : constant Menu_Flag; - Flag_Submenu : constant Menu_Flag; - Flag_Divider : constant Menu_Flag; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Menu is abstract; - - - procedure Add - (This : in out Menu; - Text : in String; - Action : in Widget_Callback := null; - Shortcut : in Shortcut_Key := No_Key; - Flags : in Menu_Flag := Flag_Normal); - - - function Find_Item - (This : in Menu'Class; - Name : in String) - return Menu_Item; - - - function Chosen - (This : in Menu'Class) - return Menu_Item; - - - function Value - (Item : in Menu_Item) - return Boolean; - - - procedure Activate - (Item : in Menu_Item); - - - procedure Deactivate - (Item : in Menu_Item); - - -private - - - type Menu is abstract new Widget with null record; - - - type Menu_Item is tagged limited - record - Void_Ptr : System.Address; - end record; - - - type Menu_Flag is new Interfaces.Unsigned_8; - Flag_Normal : constant Menu_Flag := 2#00000000#; - Flag_Inactive : constant Menu_Flag := 2#00000001#; - Flag_Toggle : constant Menu_Flag := 2#00000010#; - Flag_Value : constant Menu_Flag := 2#00000100#; - Flag_Radio : constant Menu_Flag := 2#00001000#; - Flag_Invisible : constant Menu_Flag := 2#00010000#; - -- Flag_Submenu_Pointer unlikely to be used - Flag_Submenu : constant Menu_Flag := 2#01000000#; - Flag_Divider : constant Menu_Flag := 2#10000000#; - - -end FLTK.Widgets.Menus; - diff --git a/fltk-widgets.adb b/fltk-widgets.adb deleted file mode 100644 index 9ec2350..0000000 --- a/fltk-widgets.adb +++ /dev/null @@ -1,352 +0,0 @@ - - -with Interfaces.C; -with Interfaces.C.Strings; -with System; -with System.Address_To_Access_Conversions; -with FLTK.Widgets.Groups; -with FLTK.Images; -use type System.Address; - - -package body FLTK.Widgets is - - - package Group_Convert is new - System.Address_To_Access_Conversions (FLTK.Widgets.Groups.Group'Class); - - - - - function fl_widget_get_box - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_box, "fl_widget_get_box"); - - procedure fl_widget_set_box - (W : in System.Address; - B : in Interfaces.C.int); - pragma Import (C, fl_widget_set_box, "fl_widget_set_box"); - - function fl_widget_get_label - (W : in System.Address) - return Interfaces.C.Strings.chars_ptr; - pragma Import (C, fl_widget_get_label, "fl_widget_get_label"); - - procedure fl_widget_set_label - (W : in System.Address; - T : in Interfaces.C.char_array); - pragma Import (C, fl_widget_set_label, "fl_widget_set_label"); - - function fl_widget_get_label_font - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_label_font, "fl_widget_get_label_font"); - - procedure fl_widget_set_label_font - (W : in System.Address; - F : in Interfaces.C.int); - pragma Import (C, fl_widget_set_label_font, "fl_widget_set_label_font"); - - function fl_widget_get_label_size - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_label_size, "fl_widget_get_label_size"); - - procedure fl_widget_set_label_size - (W : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_widget_set_label_size, "fl_widget_set_label_size"); - - function fl_widget_get_label_type - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_label_type, "fl_widget_get_label_type"); - - procedure fl_widget_set_label_type - (W : in System.Address; - L : in Interfaces.C.int); - pragma Import (C, fl_widget_set_label_type, "fl_widget_set_label_type"); - - function fl_widget_get_parent - (W : in System.Address) - return System.Address; - pragma Import (C, fl_widget_get_parent, "fl_widget_get_parent"); - - procedure fl_widget_set_callback - (W, C : in System.Address); - pragma Import (C, fl_widget_set_callback, "fl_widget_set_callback"); - - function fl_widget_get_x - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_x, "fl_widget_get_x"); - - function fl_widget_get_y - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_y, "fl_widget_get_y"); - - function fl_widget_get_w - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_w, "fl_widget_get_w"); - - function fl_widget_get_h - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_h, "fl_widget_get_h"); - - procedure fl_widget_size - (W : in System.Address; - D, H : in Interfaces.C.int); - pragma Import (C, fl_widget_size, "fl_widget_size"); - - procedure fl_widget_position - (W : in System.Address; - X, Y : in Interfaces.C.int); - pragma Import (C, fl_widget_position, "fl_widget_position"); - - procedure fl_widget_set_image - (W, I : in System.Address); - pragma Import (C, fl_widget_set_image, "fl_widget_set_image"); - - - - - function Parent - (This : in Widget) - return access FLTK.Widgets.Groups.Group'Class - is - Parent_Ptr : System.Address; - Actual_Parent : access FLTK.Widgets.Groups.Group'Class; - begin - Parent_Ptr := fl_widget_get_parent (This.Void_Ptr); - if Parent_Ptr /= System.Null_Address then - Actual_Parent := Group_Convert.To_Pointer (fl_widget_get_user_data (Parent_Ptr)); - end if; - return Actual_Parent; - end Parent; - - - - - function Get_Box - (This : in Widget) - return Box_Kind is - begin - return Box_Kind'Val (fl_widget_get_box (This.Void_Ptr)); - end Get_Box; - - - - - procedure Set_Box - (This : in out Widget; - Box : in Box_Kind) is - begin - fl_widget_set_box (This.Void_Ptr, Box_Kind'Pos (Box)); - end Set_Box; - - - - - function Get_Label - (This : in out Widget) - return String is - begin - return Interfaces.C.Strings.Value (fl_widget_get_label (This.Void_Ptr)); - end Get_Label; - - - - - procedure Set_Label - (This : in out Widget; - Text : in String) is - begin - fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); - end Set_Label; - - - - - function Get_Label_Font - (This : in Widget) - return Font_Kind is - begin - return Font_Kind'Val (fl_widget_get_label_font (This.Void_Ptr)); - end Get_Label_Font; - - - - - procedure Set_Label_Font - (This : in out Widget; - Font : in Font_Kind) is - begin - fl_widget_set_label_font (This.Void_Ptr, Font_Kind'Pos (Font)); - end Set_Label_Font; - - - - - function Get_Label_Size - (This : in Widget) - return Font_Size is - begin - return Font_Size (fl_widget_get_label_size (This.Void_Ptr)); - end Get_Label_Size; - - - - - procedure Set_Label_Size - (This : in out Widget; - Size : in Font_Size) is - begin - fl_widget_set_label_size (This.Void_Ptr, Interfaces.C.int (Size)); - end Set_Label_Size; - - - - - function Get_Label_Type - (This : in Widget) - return Label_Kind is - begin - return Label_Kind'Val (fl_widget_get_label_type (This.Void_Ptr)); - end Get_Label_Type; - - - - - procedure Set_Label_Type - (This : in out Widget; - Label : in Label_Kind) is - begin - fl_widget_set_label_type (This.Void_Ptr, Label_Kind'Pos (Label)); - end Set_Label_Type; - - - - - -- this is the part called by FLTK callbacks - -- note that the user data portion is a reference back to the Ada binding - procedure Callback_Hook (W, U : in System.Address); - pragma Convention (C, Callback_Hook); - - procedure Callback_Hook - (W, U : in System.Address) - is - Ada_Widget : access Widget'Class := - Widget_Convert.To_Pointer (U); - begin - Ada_Widget.Callback.all (Ada_Widget.all); - end Callback_Hook; - - - - - procedure Set_Callback - (This : in out Widget; - Func : in Widget_Callback) is - begin - if Func /= null then - This.Callback := Func; - fl_widget_set_callback (This.Void_Ptr, Callback_Hook'Address); - end if; - end Set_Callback; - - - - - function Get_X - (This : in Widget) - return Integer is - begin - return Integer (fl_widget_get_x (This.Void_Ptr)); - end Get_X; - - - - - function Get_Y - (This : in Widget) - return Integer is - begin - return Integer (fl_widget_get_y (This.Void_Ptr)); - end Get_Y; - - - - - function Get_W - (This : in Widget) - return Integer is - begin - return Integer (fl_widget_get_w (This.Void_Ptr)); - end Get_W; - - - - - function Get_H - (This : in Widget) - return Integer is - begin - return Integer (fl_widget_get_h (This.Void_Ptr)); - end Get_H; - - - - - procedure Resize - (This : in out Widget; - W, H : in Integer) is - begin - fl_widget_size - (This.Void_Ptr, - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Resize; - - - - - procedure Reposition - (This : in out Widget; - X, Y : in Integer) is - begin - fl_widget_position - (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y)); - end Reposition; - - - - - function Get_Image - (This : in Widget) - return access FLTK.Images.Image'Class is - begin - return This.Current_Image; - end Get_Image; - - - - - procedure Set_Image - (This : in out Widget; - Pic : in out FLTK.Images.Image'Class) is - begin - This.Current_Image := Pic'Unchecked_Access; - fl_widget_set_image - (This.Void_Ptr, - Wrapper (Pic).Void_Ptr); - end Set_Image; - - -end FLTK.Widgets; - diff --git a/fltk-widgets.ads b/fltk-widgets.ads deleted file mode 100644 index d1c4b89..0000000 --- a/fltk-widgets.ads +++ /dev/null @@ -1,162 +0,0 @@ - - -with FLTK.Enums; use FLTK.Enums; -with FLTK.Images; -limited with FLTK.Widgets.Groups; -private with System; -private with System.Address_To_Access_Conversions; -private with Ada.Unchecked_Conversion; - - -package FLTK.Widgets is - - - type Widget is abstract new Wrapper with private; - - - type Widget_Callback is access procedure - (Item : in out Widget'Class); - - - type Font_Size is new Natural; - Normal_Size : constant Font_Size := 14; - type Color is new Natural; - - - function Create - (X, Y, W, H : in Integer; - Text : in String) - return Widget is abstract; - - - function Parent - (This : in Widget) - return access FLTK.Widgets.Groups.Group'Class; - - - function Get_Box - (This : in Widget) - return Box_Kind; - - - procedure Set_Box - (This : in out Widget; - Box : in Box_Kind); - - - function Get_Label - (This : in out Widget) - return String; - - - procedure Set_Label - (This : in out Widget; - Text : in String); - - - function Get_Label_Font - (This : in Widget) - return Font_Kind; - - - procedure Set_Label_Font - (This : in out Widget; - Font : in Font_Kind); - - - function Get_Label_Size - (This : in Widget) - return Font_Size; - - - procedure Set_Label_Size - (This : in out Widget; - Size : in Font_Size); - - - function Get_Label_Type - (This : in Widget) - return Label_Kind; - - - procedure Set_Label_Type - (This : in out Widget; - Label : in Label_Kind); - - - procedure Set_Callback - (This : in out Widget; - Func : in Widget_Callback); - - - function Get_X - (This : in Widget) - return Integer; - - - function Get_Y - (This : in Widget) - return Integer; - - - function Get_W - (This : in Widget) - return Integer; - - - function Get_H - (This : in Widget) - return Integer; - - - procedure Resize - (This : in out Widget; - W, H : in Integer); - - - procedure Reposition - (This : in out Widget; - X, Y : in Integer); - - - function Get_Image - (This : in Widget) - return access FLTK.Images.Image'Class; - - - procedure Set_Image - (This : in out Widget; - Pic : in out FLTK.Images.Image'Class); - - -private - - - type Widget is abstract new Wrapper with - record - Callback : Widget_Callback; - Current_Image : access FLTK.Images.Image'Class; - end record; - - - package Widget_Convert is new System.Address_To_Access_Conversions (Widget'Class); - -- package Callback_Convert is new System.Address_To_Access_Conversions (Widget_Callback); - package Callback_Convert is - function To_Pointer is new Ada.Unchecked_Conversion (System.Address, Widget_Callback); - function To_Address is new Ada.Unchecked_Conversion (Widget_Callback, System.Address); - end Callback_Convert; - - - function fl_widget_get_user_data - (W : in System.Address) - return System.Address; - pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data"); - - - procedure fl_widget_set_user_data - (W, D : in System.Address); - pragma Import (C, fl_widget_set_user_data, "fl_widget_set_user_data"); - - -end FLTK.Widgets; - diff --git a/fltk.adb b/fltk.adb deleted file mode 100644 index 983f308..0000000 --- a/fltk.adb +++ /dev/null @@ -1,44 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK is - - - function fl_run return Interfaces.C.int; - pragma Import (C, fl_run, "fl_run"); - - - - - function Run - return Integer is - begin - return Integer (fl_run); - end Run; - - - - - function Has_Valid_Ptr - (This : in Wrapper) - return Boolean is - begin - return This.Void_Ptr /= System.Null_Address; - end Has_Valid_Ptr; - - - - - procedure Initialize - (This : in out Wrapper) is - begin - This.Void_Ptr := System.Null_Address; - end Initialize; - - -end FLTK; - diff --git a/fltk.ads b/fltk.ads deleted file mode 100644 index 490050d..0000000 --- a/fltk.ads +++ /dev/null @@ -1,43 +0,0 @@ - - -with Ada.Finalization; -private with System; - - -package FLTK is - - - function Run return Integer; - - - -- ugly implementation detail, never use this - -- just ignore the hand moving behind the curtain - -- (this is necessary so things like text_buffers and - -- widgets can talk to each other behind the binding) - type Wrapper is abstract new Ada.Finalization.Limited_Controlled with private; - - -private - - - function Has_Valid_Ptr - (This : in Wrapper) - return Boolean; - - - type Wrapper is abstract new Ada.Finalization.Limited_Controlled with - record - Void_Ptr : System.Address; - end record; - -- with Type_Invariant => Has_Valid_Ptr (Wrapper); - - -- unsure if the above invariant is doing what I'm after - -- oh well, something to work on - - - overriding procedure Initialize - (This : in out Wrapper); - - -end FLTK; - diff --git a/lib/.gitignore b/lib/.gitignore new file mode 100644 index 0000000..ea7f887 --- /dev/null +++ b/lib/.gitignore @@ -0,0 +1,4 @@ + + +* +!.gitignore diff --git a/obj/.gitignore b/obj/.gitignore new file mode 100644 index 0000000..ea7f887 --- /dev/null +++ b/obj/.gitignore @@ -0,0 +1,4 @@ + + +* +!.gitignore diff --git a/src/c_fl.cpp b/src/c_fl.cpp new file mode 100644 index 0000000..b628c41 --- /dev/null +++ b/src/c_fl.cpp @@ -0,0 +1,10 @@ + + +#include +#include "c_fl.h" + + +int fl_run(void) { + return Fl::run(); +} + diff --git a/src/c_fl.h b/src/c_fl.h new file mode 100644 index 0000000..69e2e72 --- /dev/null +++ b/src/c_fl.h @@ -0,0 +1,11 @@ + + +#ifndef FL_GUARD +#define FL_GUARD + + +extern "C" int fl_run(void); + + +#endif + diff --git a/src/c_fl_box.cpp b/src/c_fl_box.cpp new file mode 100644 index 0000000..eeee320 --- /dev/null +++ b/src/c_fl_box.cpp @@ -0,0 +1,16 @@ + + +#include +#include "c_fl_box.h" + + +BOX new_fl_box(int x, int y, int w, int h, char* label) { + Fl_Box *b = new Fl_Box(x, y, w, h, label); + return b; +} + + +void free_fl_box(BOX b) { + delete reinterpret_cast(b); +} + diff --git a/src/c_fl_box.h b/src/c_fl_box.h new file mode 100644 index 0000000..df7b629 --- /dev/null +++ b/src/c_fl_box.h @@ -0,0 +1,15 @@ + + +#ifndef FL_BOX_GUARD +#define FL_BOX_GUARD + + +typedef void* BOX; + + +extern "C" BOX new_fl_box(int x, int y, int w, int h, char * label); +extern "C" void free_fl_box(BOX b); + + +#endif + diff --git a/src/c_fl_button.cpp b/src/c_fl_button.cpp new file mode 100644 index 0000000..621656c --- /dev/null +++ b/src/c_fl_button.cpp @@ -0,0 +1,31 @@ + + +#include +#include "c_fl_button.h" + + +BUTTON new_fl_button(int x, int y, int w, int h, char* label) { + Fl_Button *b = new Fl_Button(x, y, w, h, label); + return b; +} + + +void free_fl_button(BUTTON b) { + delete reinterpret_cast(b); +} + + +int fl_button_get_state(BUTTON b) { + return reinterpret_cast(b)->value(); +} + + +void fl_button_set_state(BUTTON b, int s) { + reinterpret_cast(b)->value(s); +} + + +void fl_button_set_only(BUTTON b) { + reinterpret_cast(b)->setonly(); +} + diff --git a/src/c_fl_button.h b/src/c_fl_button.h new file mode 100644 index 0000000..239689a --- /dev/null +++ b/src/c_fl_button.h @@ -0,0 +1,19 @@ + + +#ifndef FL_BUTTON_GUARD +#define FL_BUTTON_GUARD + + +typedef void* BUTTON; + + +extern "C" BUTTON new_fl_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_button(BUTTON b); + +extern "C" int fl_button_get_state(BUTTON b); +extern "C" void fl_button_set_state(BUTTON b, int s); +extern "C" void fl_button_set_only(BUTTON b); + + +#endif + diff --git a/src/c_fl_check_button.cpp b/src/c_fl_check_button.cpp new file mode 100644 index 0000000..e737942 --- /dev/null +++ b/src/c_fl_check_button.cpp @@ -0,0 +1,16 @@ + + +#include +#include "c_fl_check_button.h" + + +CHECKBUTTON new_fl_check_button(int x, int y, int w, int h, char* label) { + Fl_Check_Button *b = new Fl_Check_Button(x, y, w, h, label); + return b; +} + + +void free_fl_check_button(CHECKBUTTON b) { + delete reinterpret_cast(b); +} + diff --git a/src/c_fl_check_button.h b/src/c_fl_check_button.h new file mode 100644 index 0000000..f44b5ec --- /dev/null +++ b/src/c_fl_check_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_CHECK_BUTTON_GUARD +#define FL_CHECK_BUTTON_GUARD + + +typedef void* CHECKBUTTON; + + +extern "C" CHECKBUTTON new_fl_check_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_check_button(CHECKBUTTON b); + + +#endif + diff --git a/src/c_fl_dialog.cpp b/src/c_fl_dialog.cpp new file mode 100644 index 0000000..cb6d305 --- /dev/null +++ b/src/c_fl_dialog.cpp @@ -0,0 +1,32 @@ + + +#include +#include +#include +#include "c_fl_dialog.h" + + +void dialog_fl_alert(const char * m) { + fl_alert(m); +} + + +int dialog_fl_choice(const char * m, const char * a, const char * b, const char * c) { + return fl_choice(m, a, b, c); +} + + +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); +} + + +void dialog_fl_message(const char * m) { + fl_message(m); +} + diff --git a/src/c_fl_dialog.h b/src/c_fl_dialog.h new file mode 100644 index 0000000..6804022 --- /dev/null +++ b/src/c_fl_dialog.h @@ -0,0 +1,15 @@ + + +#ifndef FL_DIALOG_GUARD +#define FL_DIALOG_GUARD + + +extern "C" void dialog_fl_alert(const char * m); +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); + + +#endif + diff --git a/src/c_fl_double_window.cpp b/src/c_fl_double_window.cpp new file mode 100644 index 0000000..7f29af8 --- /dev/null +++ b/src/c_fl_double_window.cpp @@ -0,0 +1,32 @@ + + +#include +#include "c_fl_double_window.h" + + +DOUBLEWINDOW new_fl_double_window(int x, int y, int w, int h, char* label) { + Fl_Double_Window *d = new Fl_Double_Window(x, y, w, h, label); + return d; +} + + +DOUBLEWINDOW new_fl_double_window2(int w, int h) { + Fl_Double_Window *d = new Fl_Double_Window(w, h); + return d; +} + + +void free_fl_double_window(DOUBLEWINDOW d) { + delete reinterpret_cast(d); +} + + +void fl_double_window_show(DOUBLEWINDOW d) { + reinterpret_cast(d)->show(); +} + + +void fl_double_window_hide(DOUBLEWINDOW d) { + reinterpret_cast(d)->hide(); +} + diff --git a/src/c_fl_double_window.h b/src/c_fl_double_window.h new file mode 100644 index 0000000..3be3588 --- /dev/null +++ b/src/c_fl_double_window.h @@ -0,0 +1,19 @@ + + +#ifndef FL_DOUBLE_WINDOW_GUARD +#define FL_DOUBLE_WINDOW_GUARD + + +typedef void* DOUBLEWINDOW; + + +extern "C" DOUBLEWINDOW new_fl_double_window(int x, int y, int w, int h, char* label); +extern "C" DOUBLEWINDOW new_fl_double_window2(int w, int h); +extern "C" void free_fl_double_window(DOUBLEWINDOW d); + +extern "C" void fl_double_window_show(DOUBLEWINDOW d); +extern "C" void fl_double_window_hide(DOUBLEWINDOW d); + + +#endif + diff --git a/src/c_fl_group.cpp b/src/c_fl_group.cpp new file mode 100644 index 0000000..9ea2764 --- /dev/null +++ b/src/c_fl_group.cpp @@ -0,0 +1,69 @@ + + +#include +#include +#include "c_fl_group.h" +#include "c_fl_widget.h" + + +GROUP new_fl_group(int x, int y, int w, int h, char* label) { + Fl_Group *g = new Fl_Group(x, y, w, h, label); + return g; +} + + +void free_fl_group(GROUP g) { + delete reinterpret_cast(g); +} + + + + +void fl_group_end(GROUP g) { + reinterpret_cast(g)->end(); +} + + + + +void fl_group_add(GROUP g, WIDGET item) { + reinterpret_cast(g)->add(reinterpret_cast(item)); +} + + +int fl_group_find(GROUP g, WIDGET item) { + return reinterpret_cast(g)->find(reinterpret_cast(item)); +} + + +void fl_group_insert(GROUP g, WIDGET item, int place) { + reinterpret_cast(g)->insert(*(reinterpret_cast(item)), place); +} + + +void fl_group_remove(GROUP g, WIDGET item) { + reinterpret_cast(g)->remove(reinterpret_cast(item)); +} + + +void fl_group_remove2(GROUP g, int place) { + reinterpret_cast(g)->remove(place); +} + + +void fl_group_resizable(GROUP g, WIDGET item) { + reinterpret_cast(g)->resizable(reinterpret_cast(item)); +} + + + + +int fl_group_children(GROUP g) { + return reinterpret_cast(g)->children(); +} + + +void * fl_group_child(GROUP g, int place) { + return reinterpret_cast(g)->child(place); +} + diff --git a/src/c_fl_group.h b/src/c_fl_group.h new file mode 100644 index 0000000..9b58f8c --- /dev/null +++ b/src/c_fl_group.h @@ -0,0 +1,29 @@ + + +#ifndef FL_GROUP_GUARD +#define FL_GROUP_GUARD + +#include "c_fl_widget.h" + + +typedef void* GROUP; + + +extern "C" GROUP new_fl_group(int x, int y, int w, int h, char* label); +extern "C" void free_fl_group(GROUP g); + +extern "C" void fl_group_end(GROUP g); + +extern "C" void fl_group_add(GROUP g, WIDGET item); +extern "C" int fl_group_find(GROUP g, WIDGET item); +extern "C" void fl_group_insert(GROUP g, WIDGET item, int place); +extern "C" void fl_group_remove(GROUP g, WIDGET item); +extern "C" void fl_group_remove2(GROUP g, int place); +extern "C" void fl_group_resizable(GROUP g, WIDGET item); + +extern "C" int fl_group_children(GROUP g); +extern "C" void * fl_group_child(GROUP g, int place); + + +#endif + diff --git a/src/c_fl_image.cpp b/src/c_fl_image.cpp new file mode 100644 index 0000000..8222392 --- /dev/null +++ b/src/c_fl_image.cpp @@ -0,0 +1,33 @@ + + +#include +#include "c_fl_image.h" + + +IMAGE new_fl_image(int w, int h, int d) { + Fl_Image *i = new Fl_Image(w, h, d); + return i; +} + + +void free_fl_image(IMAGE i) { + delete reinterpret_cast(i); +} + + + + +int fl_image_w(IMAGE i) { + return reinterpret_cast(i)->w(); +} + + +int fl_image_h(IMAGE i) { + return reinterpret_cast(i)->h(); +} + + +int fl_image_d(IMAGE i) { + return reinterpret_cast(i)->d(); +} + diff --git a/src/c_fl_image.h b/src/c_fl_image.h new file mode 100644 index 0000000..a4be6df --- /dev/null +++ b/src/c_fl_image.h @@ -0,0 +1,20 @@ + + +#ifndef FL_IMAGE_GUARD +#define FL_IMAGE_GUARD + + +typedef void* IMAGE; + + +extern "C" IMAGE new_fl_image(int w, int h, int d); +extern "C" void free_fl_image(IMAGE i); + + +extern "C" int fl_image_w(IMAGE i); +extern "C" int fl_image_h(IMAGE i); +extern "C" int fl_image_d(IMAGE i); + + +#endif + diff --git a/src/c_fl_input.cpp b/src/c_fl_input.cpp new file mode 100644 index 0000000..4f19bd1 --- /dev/null +++ b/src/c_fl_input.cpp @@ -0,0 +1,21 @@ + + +#include +#include "c_fl_input.h" + + +INPUT new_fl_input(int x, int y, int w, int h, char* label) { + Fl_Input *i = new Fl_Input(x, y, w, h, label); + return i; +} + + +void free_fl_input(INPUT i) { + delete reinterpret_cast(i); +} + + +const char * fl_input_get_value(INPUT i) { + return reinterpret_cast(i)->value(); +} + diff --git a/src/c_fl_input.h b/src/c_fl_input.h new file mode 100644 index 0000000..cb40d42 --- /dev/null +++ b/src/c_fl_input.h @@ -0,0 +1,18 @@ + + +#ifndef FL_INPUT_GUARD +#define FL_INPUT_GUARD + + +typedef void* INPUT; + + +extern "C" INPUT new_fl_input(int x, int y, int w, int h, char* label); +extern "C" void free_fl_input(INPUT i); + + +extern "C" const char * fl_input_get_value(INPUT i); + + +#endif + diff --git a/src/c_fl_int_input.cpp b/src/c_fl_int_input.cpp new file mode 100644 index 0000000..2224857 --- /dev/null +++ b/src/c_fl_int_input.cpp @@ -0,0 +1,21 @@ + + +#include +#include "c_fl_int_input.h" + + +INT_INPUT new_fl_int_input(int x, int y, int w, int h, char* label) { + Fl_Int_Input *i = new Fl_Int_Input(x, y, w, h, label); + return i; +} + + +void free_fl_int_input(INT_INPUT i) { + delete reinterpret_cast(i); +} + + +const char * fl_int_input_get_value(INT_INPUT i) { + return reinterpret_cast(i)->value(); +} + diff --git a/src/c_fl_int_input.h b/src/c_fl_int_input.h new file mode 100644 index 0000000..5d99c3f --- /dev/null +++ b/src/c_fl_int_input.h @@ -0,0 +1,18 @@ + + +#ifndef FL_INT_INPUT_GUARD +#define FL_INT_INPUT_GUARD + + +typedef void* INT_INPUT; + + +extern "C" INT_INPUT new_fl_int_input(int x, int y, int w, int h, char* label); +extern "C" void free_fl_int_input(INT_INPUT i); + + +extern "C" const char * fl_int_input_get_value(INT_INPUT i); + + +#endif + diff --git a/src/c_fl_light_button.cpp b/src/c_fl_light_button.cpp new file mode 100644 index 0000000..daa99ef --- /dev/null +++ b/src/c_fl_light_button.cpp @@ -0,0 +1,16 @@ + + +#include +#include "c_fl_light_button.h" + + +LIGHTBUTTON new_fl_light_button(int x, int y, int w, int h, char* label) { + Fl_Light_Button *b = new Fl_Light_Button(x, y, w, h, label); + return b; +} + + +void free_fl_light_button(LIGHTBUTTON b) { + delete reinterpret_cast(b); +} + diff --git a/src/c_fl_light_button.h b/src/c_fl_light_button.h new file mode 100644 index 0000000..f8c005d --- /dev/null +++ b/src/c_fl_light_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_LIGHT_BUTTON_GUARD +#define FL_LIGHT_BUTTON_GUARD + + +typedef void* LIGHTBUTTON; + + +extern "C" LIGHTBUTTON new_fl_light_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_light_button(LIGHTBUTTON b); + + +#endif + diff --git a/src/c_fl_menu.cpp b/src/c_fl_menu.cpp new file mode 100644 index 0000000..f8c7b9e --- /dev/null +++ b/src/c_fl_menu.cpp @@ -0,0 +1,38 @@ + + +#include +#include +#include "c_fl_menu.h" + + +int fl_menu_add(MENU m, const char * t, unsigned long s, void * c, void * u, unsigned long f) { + return reinterpret_cast(m)->add(t, s, reinterpret_cast(c), u, f); +} + + +const void * fl_menu_find_item(MENU m, const char * t) { + return reinterpret_cast(m)->find_item(t); +} + + +const void * fl_menu_mvalue(MENU m) { + return reinterpret_cast(m)->mvalue(); +} + + + + +int fl_menuitem_value(void * mi) { + return reinterpret_cast(mi)->value(); +} + + +void fl_menuitem_activate(void * mi) { + reinterpret_cast(mi)->activate(); +} + + +void fl_menuitem_deactivate(void * mi) { + reinterpret_cast(mi)->deactivate(); +} + diff --git a/src/c_fl_menu.h b/src/c_fl_menu.h new file mode 100644 index 0000000..2b9aa68 --- /dev/null +++ b/src/c_fl_menu.h @@ -0,0 +1,22 @@ + + +#ifndef FL_MENU_GUARD +#define FL_MENU_GUARD + + +typedef void* MENU; +// typedef void* MENUITEM; + + +extern "C" int fl_menu_add(MENU m, const char * t, unsigned long s, void * c, void * u, unsigned long f); +extern "C" const void * fl_menu_find_item(MENU m, const char * t); +extern "C" const void * fl_menu_mvalue(MENU m); + + +extern "C" int fl_menuitem_value(void * mi); +extern "C" void fl_menuitem_activate(void * mi); +extern "C" void fl_menuitem_deactivate(void * mi); + + +#endif + diff --git a/src/c_fl_menu_bar.cpp b/src/c_fl_menu_bar.cpp new file mode 100644 index 0000000..3349008 --- /dev/null +++ b/src/c_fl_menu_bar.cpp @@ -0,0 +1,16 @@ + + +#include +#include "c_fl_menu_bar.h" + + +MENUBAR new_fl_menu_bar(int x, int y, int w, int h, char* label) { + Fl_Menu_Bar *m = new Fl_Menu_Bar(x, y, w, h, label); + return m; +} + + +void free_fl_menu_bar(MENUBAR m) { + delete reinterpret_cast(m); +} + diff --git a/src/c_fl_menu_bar.h b/src/c_fl_menu_bar.h new file mode 100644 index 0000000..a09d22b --- /dev/null +++ b/src/c_fl_menu_bar.h @@ -0,0 +1,15 @@ + + +#ifndef FL_MENU_BAR_GUARD +#define FL_MENU_BAR_GUARD + + +typedef void* MENUBAR; + + +extern "C" MENUBAR new_fl_menu_bar(int x, int y, int w, int h, char* label); +extern "C" void free_fl_menu_bar(MENUBAR m); + + +#endif + diff --git a/src/c_fl_menu_button.cpp b/src/c_fl_menu_button.cpp new file mode 100644 index 0000000..864dd3e --- /dev/null +++ b/src/c_fl_menu_button.cpp @@ -0,0 +1,21 @@ + + +#include +#include "c_fl_menu_button.h" + + +MENUBUTTON new_fl_menu_button(int x, int y, int w, int h, char* label) { + Fl_Menu_Button *m = new Fl_Menu_Button(x, y, w, h, label); + return m; +} + + +void free_fl_menu_button(MENUBUTTON m) { + delete reinterpret_cast(m); +} + + +void fl_menu_button_type(MENUBUTTON m, unsigned int t) { + reinterpret_cast(m)->type(t); +} + diff --git a/src/c_fl_menu_button.h b/src/c_fl_menu_button.h new file mode 100644 index 0000000..8c089b6 --- /dev/null +++ b/src/c_fl_menu_button.h @@ -0,0 +1,18 @@ + + +#ifndef FL_MENU_BUTTON_GUARD +#define FL_MENU_BUTTON_GUARD + + +typedef void* MENUBUTTON; + + +extern "C" MENUBUTTON new_fl_menu_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_menu_button(MENUBUTTON m); + + +extern "C" void fl_menu_button_type(MENUBUTTON m, unsigned int t); + + +#endif + diff --git a/src/c_fl_menu_window.cpp b/src/c_fl_menu_window.cpp new file mode 100644 index 0000000..66ad6f3 --- /dev/null +++ b/src/c_fl_menu_window.cpp @@ -0,0 +1,52 @@ + + +#include +#include "c_fl_menu_window.h" + + +MENUWINDOW new_fl_menu_window(int x, int y, int w, int h, char* label) { + Fl_Menu_Window *m = new Fl_Menu_Window(x, y, w, h, label); + return m; +} + + +MENUWINDOW new_fl_menu_window2(int w, int h) { + Fl_Menu_Window *m = new Fl_Menu_Window(w, h); + return m; +} + + +void free_fl_menu_window(MENUWINDOW m) { + delete reinterpret_cast(m); +} + + +void fl_menu_window_show(MENUWINDOW m) { + reinterpret_cast(m)->show(); +} + + +void fl_menu_window_hide(MENUWINDOW m) { + reinterpret_cast(m)->hide(); +} + + +void fl_menu_window_flush(MENUWINDOW m) { + reinterpret_cast(m)->flush(); +} + + +void fl_menu_window_set_overlay(MENUWINDOW m) { + reinterpret_cast(m)->set_overlay(); +} + + +void fl_menu_window_clear_overlay(MENUWINDOW m) { + reinterpret_cast(m)->clear_overlay(); +} + + +unsigned int fl_menu_window_overlay(MENUWINDOW m) { + return reinterpret_cast(m)->overlay(); +} + diff --git a/src/c_fl_menu_window.h b/src/c_fl_menu_window.h new file mode 100644 index 0000000..3322b29 --- /dev/null +++ b/src/c_fl_menu_window.h @@ -0,0 +1,23 @@ + + +#ifndef FL_MENU_WINDOW_GUARD +#define FL_MENU_WINDOW_GUARD + + +typedef void* MENUWINDOW; + + +extern "C" MENUWINDOW new_fl_menu_window(int x, int y, int w, int h, char* label); +extern "C" MENUWINDOW new_fl_menu_window2(int w, int h); +extern "C" void free_fl_menu_window(MENUWINDOW m); + +extern "C" void fl_menu_window_show(MENUWINDOW m); +extern "C" void fl_menu_window_hide(MENUWINDOW m); +extern "C" void fl_menu_window_flush(MENUWINDOW m); +extern "C" void fl_menu_window_set_overlay(MENUWINDOW m); +extern "C" void fl_menu_window_clear_overlay(MENUWINDOW m); +extern "C" unsigned int fl_menu_window_overlay(MENUWINDOW m); + + +#endif + diff --git a/src/c_fl_png_image.cpp b/src/c_fl_png_image.cpp new file mode 100644 index 0000000..16d5927 --- /dev/null +++ b/src/c_fl_png_image.cpp @@ -0,0 +1,16 @@ + + +#include +#include "c_fl_png_image.h" + + +PNG_IMAGE new_fl_png_image(const char * f) { + Fl_PNG_Image *p = new Fl_PNG_Image(f); + return p; +} + + +void free_fl_png_image(PNG_IMAGE p) { + delete reinterpret_cast(p); +} + diff --git a/src/c_fl_png_image.h b/src/c_fl_png_image.h new file mode 100644 index 0000000..a67a5aa --- /dev/null +++ b/src/c_fl_png_image.h @@ -0,0 +1,15 @@ + + +#ifndef FL_PNG_IMAGE_GUARD +#define FL_PNG_IMAGE_GUARD + + +typedef void* PNG_IMAGE; + + +extern "C" PNG_IMAGE new_fl_png_image(const char * f); +extern "C" void free_fl_png_image(PNG_IMAGE p); + + +#endif + diff --git a/src/c_fl_radio_button.cpp b/src/c_fl_radio_button.cpp new file mode 100644 index 0000000..1cac323 --- /dev/null +++ b/src/c_fl_radio_button.cpp @@ -0,0 +1,16 @@ + + +#include +#include "c_fl_radio_button.h" + + +RADIOBUTTON new_fl_radio_button(int x, int y, int w, int h, char* label) { + Fl_Radio_Button *b = new Fl_Radio_Button(x, y, w, h, label); + return b; +} + + +void free_fl_radio_button(RADIOBUTTON b) { + delete reinterpret_cast(b); +} + diff --git a/src/c_fl_radio_button.h b/src/c_fl_radio_button.h new file mode 100644 index 0000000..d9ea819 --- /dev/null +++ b/src/c_fl_radio_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_RADIO_BUTTON_GUARD +#define FL_RADIO_BUTTON_GUARD + + +typedef void* RADIOBUTTON; + + +extern "C" RADIOBUTTON new_fl_radio_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_radio_button(RADIOBUTTON b); + + +#endif + diff --git a/src/c_fl_radio_light_button.cpp b/src/c_fl_radio_light_button.cpp new file mode 100644 index 0000000..7dd4a5f --- /dev/null +++ b/src/c_fl_radio_light_button.cpp @@ -0,0 +1,16 @@ + + +#include +#include "c_fl_radio_light_button.h" + + +RADIOLIGHTBUTTON new_fl_radio_light_button(int x, int y, int w, int h, char* label) { + Fl_Radio_Light_Button *b = new Fl_Radio_Light_Button(x, y, w, h, label); + return b; +} + + +void free_fl_radio_light_button(RADIOLIGHTBUTTON b) { + delete reinterpret_cast(b); +} + diff --git a/src/c_fl_radio_light_button.h b/src/c_fl_radio_light_button.h new file mode 100644 index 0000000..ee5f2a1 --- /dev/null +++ b/src/c_fl_radio_light_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_RADIO_LIGHT_BUTTON_GUARD +#define FL_RADIO_LIGHT_BUTTON_GUARD + + +typedef void* RADIOLIGHTBUTTON; + + +extern "C" RADIOLIGHTBUTTON new_fl_radio_light_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_radio_light_button(RADIOLIGHTBUTTON b); + + +#endif + diff --git a/src/c_fl_radio_round_button.cpp b/src/c_fl_radio_round_button.cpp new file mode 100644 index 0000000..9e94244 --- /dev/null +++ b/src/c_fl_radio_round_button.cpp @@ -0,0 +1,16 @@ + + +#include +#include "c_fl_radio_round_button.h" + + +RADIOROUNDBUTTON new_fl_radio_round_button(int x, int y, int w, int h, char* label) { + Fl_Radio_Round_Button *b = new Fl_Radio_Round_Button(x, y, w, h, label); + return b; +} + + +void free_fl_radio_round_button(RADIOROUNDBUTTON b) { + delete reinterpret_cast(b); +} + diff --git a/src/c_fl_radio_round_button.h b/src/c_fl_radio_round_button.h new file mode 100644 index 0000000..34f1189 --- /dev/null +++ b/src/c_fl_radio_round_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_RADIO_ROUND_BUTTON_GUARD +#define FL_RADIO_ROUND_BUTTON_GUARD + + +typedef void* RADIOROUNDBUTTON; + + +extern "C" RADIOROUNDBUTTON new_fl_radio_round_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_radio_round_button(RADIOROUNDBUTTON b); + + +#endif + diff --git a/src/c_fl_repeat_button.cpp b/src/c_fl_repeat_button.cpp new file mode 100644 index 0000000..eafefde --- /dev/null +++ b/src/c_fl_repeat_button.cpp @@ -0,0 +1,16 @@ + + +#include +#include "c_fl_repeat_button.h" + + +REPEATBUTTON new_fl_repeat_button(int x, int y, int w, int h, char* label) { + Fl_Repeat_Button *b = new Fl_Repeat_Button(x, y, w, h, label); + return b; +} + + +void free_fl_repeat_button(REPEATBUTTON b) { + delete reinterpret_cast(b); +} + diff --git a/src/c_fl_repeat_button.h b/src/c_fl_repeat_button.h new file mode 100644 index 0000000..d899730 --- /dev/null +++ b/src/c_fl_repeat_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_REPEAT_BUTTON_GUARD +#define FL_REPEAT_BUTTON_GUARD + + +typedef void* REPEATBUTTON; + + +extern "C" REPEATBUTTON new_fl_repeat_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_repeat_button(REPEATBUTTON b); + + +#endif + diff --git a/src/c_fl_return_button.cpp b/src/c_fl_return_button.cpp new file mode 100644 index 0000000..5f87fb3 --- /dev/null +++ b/src/c_fl_return_button.cpp @@ -0,0 +1,16 @@ + + +#include +#include "c_fl_return_button.h" + + +RETURNBUTTON new_fl_return_button(int x, int y, int w, int h, char* label) { + Fl_Return_Button *b = new Fl_Return_Button(x, y, w, h, label); + return b; +} + + +void free_fl_return_button(RETURNBUTTON b) { + delete reinterpret_cast(b); +} + diff --git a/src/c_fl_return_button.h b/src/c_fl_return_button.h new file mode 100644 index 0000000..558e9dc --- /dev/null +++ b/src/c_fl_return_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_RETURN_BUTTON_GUARD +#define FL_RETURN_BUTTON_GUARD + + +typedef void* RETURNBUTTON; + + +extern "C" RETURNBUTTON new_fl_return_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_return_button(RETURNBUTTON b); + + +#endif + diff --git a/src/c_fl_round_button.cpp b/src/c_fl_round_button.cpp new file mode 100644 index 0000000..b33448f --- /dev/null +++ b/src/c_fl_round_button.cpp @@ -0,0 +1,16 @@ + + +#include +#include "c_fl_round_button.h" + + +ROUNDBUTTON new_fl_round_button(int x, int y, int w, int h, char* label) { + Fl_Round_Button *b = new Fl_Round_Button(x, y, w, h, label); + return b; +} + + +void free_fl_round_button(ROUNDBUTTON b) { + delete reinterpret_cast(b); +} + diff --git a/src/c_fl_round_button.h b/src/c_fl_round_button.h new file mode 100644 index 0000000..36113a4 --- /dev/null +++ b/src/c_fl_round_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_ROUND_BUTTON_GUARD +#define FL_ROUND_BUTTON_GUARD + + +typedef void* ROUNDBUTTON; + + +extern "C" ROUNDBUTTON new_fl_round_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_round_button(ROUNDBUTTON b); + + +#endif + diff --git a/src/c_fl_single_window.cpp b/src/c_fl_single_window.cpp new file mode 100644 index 0000000..ec9a315 --- /dev/null +++ b/src/c_fl_single_window.cpp @@ -0,0 +1,32 @@ + + +#include +#include "c_fl_single_window.h" + + +SINGLEWINDOW new_fl_single_window(int x, int y, int w, int h, char* label) { + Fl_Single_Window *sw = new Fl_Single_Window(x, y, w, h, label); + return sw; +} + + +SINGLEWINDOW new_fl_single_window2(int x, int y) { + Fl_Single_Window *sw = new Fl_Single_Window(x, y); + return sw; +} + + +void free_fl_single_window(SINGLEWINDOW w) { + delete reinterpret_cast(w); +} + + +void fl_single_window_show(SINGLEWINDOW w) { + reinterpret_cast(w)->show(); +} + + +void fl_single_window_flush(SINGLEWINDOW w) { + reinterpret_cast(w)->flush(); +} + diff --git a/src/c_fl_single_window.h b/src/c_fl_single_window.h new file mode 100644 index 0000000..96f6d5b --- /dev/null +++ b/src/c_fl_single_window.h @@ -0,0 +1,19 @@ + + +#ifndef FL_SINGLE_WINDOW_GUARD +#define FL_SINGLE_WINDOW_GUARD + + +typedef void* SINGLEWINDOW; + + +extern "C" SINGLEWINDOW new_fl_single_window(int x, int y, int w, int h, char* label); +extern "C" SINGLEWINDOW new_fl_single_window2(int x, int y); +extern "C" void free_fl_single_window(SINGLEWINDOW w); + +extern "C" void fl_single_window_show(SINGLEWINDOW w); +extern "C" void fl_single_window_flush(SINGLEWINDOW w); + + +#endif + diff --git a/src/c_fl_text_buffer.cpp b/src/c_fl_text_buffer.cpp new file mode 100644 index 0000000..71f04d2 --- /dev/null +++ b/src/c_fl_text_buffer.cpp @@ -0,0 +1,111 @@ + + +#include +#include "c_fl_text_buffer.h" + + +TEXTBUFFER new_fl_text_buffer(int rs, int pgs) { + Fl_Text_Buffer *tb = new Fl_Text_Buffer(rs, pgs); + return tb; +} + + +void free_fl_text_buffer(TEXTBUFFER tb) { + delete reinterpret_cast(tb); +} + + +void fl_text_buffer_add_modify_callback(TEXTBUFFER tb, void * cb, void * ud) { + reinterpret_cast(tb)->add_modify_callback(reinterpret_cast(cb), ud); +} + + +void fl_text_buffer_add_predelete_callback(TEXTBUFFER tb, void * cb, void * ud) { + reinterpret_cast(tb)->add_predelete_callback(reinterpret_cast(cb), ud); +} + + +void fl_text_buffer_call_modify_callbacks(TEXTBUFFER tb) { + reinterpret_cast(tb)->call_modify_callbacks(); +} + + +void fl_text_buffer_call_predelete_callbacks(TEXTBUFFER tb) { + reinterpret_cast(tb)->call_predelete_callbacks(); +} + + +void fl_text_buffer_insert(TEXTBUFFER tb, int p, const char * item) { + reinterpret_cast(tb)->insert(p, item); +} + + +void fl_text_buffer_remove(TEXTBUFFER tb, int s, int f) { + reinterpret_cast(tb)->remove(s, f); +} + + +int fl_text_buffer_length(TEXTBUFFER tb) { + return reinterpret_cast(tb)->length(); +} + + +int fl_text_buffer_loadfile(TEXTBUFFER tb, char * n) { + return reinterpret_cast(tb)->loadfile(n); +} + + +void fl_text_buffer_remove_selection(TEXTBUFFER tb) { + reinterpret_cast(tb)->remove_selection(); +} + + +int fl_text_buffer_savefile(TEXTBUFFER tb, char * n) { + return reinterpret_cast(tb)->savefile(n); +} + + +int fl_text_buffer_search_forward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase) { + return reinterpret_cast(tb)->search_forward(start, item, found, mcase); +} + + +int fl_text_buffer_search_backward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase) { + return reinterpret_cast(tb)->search_backward(start, item, found, mcase); +} + + +void fl_text_buffer_select(TEXTBUFFER tb, int s, int e) { + reinterpret_cast(tb)->select(s, e); +} + + +int fl_text_buffer_selection_position(TEXTBUFFER tb, int * s, int * e) { + return reinterpret_cast(tb)->selection_position(s, e); +} + + +int fl_text_buffer_selected(TEXTBUFFER tb) { + return reinterpret_cast(tb)->selected(); +} + + +int fl_text_buffer_skip_lines(TEXTBUFFER tb, int s, int l) { + return reinterpret_cast(tb)->skip_lines(s, l); +} + + +int fl_text_buffer_rewind_lines(TEXTBUFFER tb, int s, int l) { + return reinterpret_cast(tb)->rewind_lines(s, l); +} + + +unsigned int fl_text_buffer_char_at(TEXTBUFFER tb, int p) { + return reinterpret_cast(tb)->char_at(p); +} + + +char * fl_text_buffer_text_range(TEXTBUFFER tb, int s, int f) { + return reinterpret_cast(tb)->text_range(s, f); +} + diff --git a/src/c_fl_text_buffer.h b/src/c_fl_text_buffer.h new file mode 100644 index 0000000..1551d2b --- /dev/null +++ b/src/c_fl_text_buffer.h @@ -0,0 +1,36 @@ + + +#ifndef FL_TEXT_BUFFER_GUARD +#define FL_TEXT_BUFFER_GUARD + + +typedef void* TEXTBUFFER; + + +extern "C" TEXTBUFFER new_fl_text_buffer(int rs, int pgs); +extern "C" void free_fl_text_buffer(TEXTBUFFER tb); + + +extern "C" void fl_text_buffer_add_modify_callback(TEXTBUFFER tb, void * cb, void * ud); +extern "C" void fl_text_buffer_add_predelete_callback(TEXTBUFFER tb, void * cb, void * ud); +extern "C" void fl_text_buffer_call_modify_callbacks(TEXTBUFFER tb); +extern "C" void fl_text_buffer_call_predelete_callbacks(TEXTBUFFER tb); +extern "C" void fl_text_buffer_insert(TEXTBUFFER tb, int p, const char * item); +extern "C" void fl_text_buffer_remove(TEXTBUFFER tb, int s, int f); +extern "C" int fl_text_buffer_length(TEXTBUFFER tb); +extern "C" int fl_text_buffer_loadfile(TEXTBUFFER tb, char * n); +extern "C" void fl_text_buffer_remove_selection(TEXTBUFFER tb); +extern "C" int fl_text_buffer_savefile(TEXTBUFFER tb, char * n); +extern "C" int fl_text_buffer_search_forward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase); +extern "C" int fl_text_buffer_search_backward(TEXTBUFFER tb, int start, const char * item, int * found, int mcase); +extern "C" void fl_text_buffer_select(TEXTBUFFER tb, int s, int e); +extern "C" int fl_text_buffer_selection_position(TEXTBUFFER tb, int * s, int * e); +extern "C" int fl_text_buffer_selected(TEXTBUFFER tb); +extern "C" int fl_text_buffer_skip_lines(TEXTBUFFER tb, int s, int l); +extern "C" int fl_text_buffer_rewind_lines(TEXTBUFFER tb, int s, int l); +extern "C" unsigned int fl_text_buffer_char_at(TEXTBUFFER tb, int p); +extern "C" char * fl_text_buffer_text_range(TEXTBUFFER tb, int s, int f); + + +#endif + diff --git a/src/c_fl_text_display.cpp b/src/c_fl_text_display.cpp new file mode 100644 index 0000000..b9e59c6 --- /dev/null +++ b/src/c_fl_text_display.cpp @@ -0,0 +1,105 @@ + + +#include +#include +#include "c_fl_text_display.h" +#include "c_fl_text_buffer.h" + + +TEXTDISPLAY new_fl_text_display(int x, int y, int w, int h, char* label) { + Fl_Text_Display *td = new Fl_Text_Display(x, y, w, h, label); + return td; +} + + +void free_fl_text_display(TEXTDISPLAY td) { + delete reinterpret_cast(td); +} + + +// this actually never gets called, since an access to the text_buffer +// object is stored on the Ada side of things +TEXTBUFFER fl_text_display_get_buffer(TEXTDISPLAY td) { + return reinterpret_cast(td)->buffer(); +} + + +void fl_text_display_set_buffer(TEXTDISPLAY td, TEXTBUFFER tb) { + reinterpret_cast(td)->buffer(reinterpret_cast(tb)); +} + + +int fl_text_display_get_text_color(TEXTDISPLAY td) { + return reinterpret_cast(td)->textcolor(); +} + + +void fl_text_display_set_text_color(TEXTDISPLAY td, int c) { + reinterpret_cast(td)->textcolor(static_cast(c)); +} + + +int fl_text_display_get_text_font(TEXTDISPLAY td) { + return reinterpret_cast(td)->textfont(); +} + + +void fl_text_display_set_text_font(TEXTDISPLAY td, int f) { + reinterpret_cast(td)->textfont(static_cast(f)); +} + + +int fl_text_display_get_text_size(TEXTDISPLAY td) { + return reinterpret_cast(td)->textsize(); +} + + +void fl_text_display_set_text_size(TEXTDISPLAY td, int s) { + reinterpret_cast(td)->textsize(static_cast(s)); +} + + +int fl_text_display_get_insert_pos(TEXTDISPLAY td) { + return reinterpret_cast(td)->insert_position(); +} + + +void fl_text_display_set_insert_pos(TEXTDISPLAY td, int p) { + reinterpret_cast(td)->insert_position(p); +} + + +void fl_text_display_show_insert_pos(TEXTDISPLAY td) { + reinterpret_cast(td)->show_insert_position(); +} + + +void fl_text_display_next_word(TEXTDISPLAY td) { + reinterpret_cast(td)->next_word(); +} + + +void fl_text_display_previous_word(TEXTDISPLAY td) { + reinterpret_cast(td)->previous_word(); +} + + +void fl_text_display_wrap_mode(TEXTDISPLAY td, int w, int m) { + reinterpret_cast(td)->wrap_mode(w, m); +} + + +int fl_text_display_skip_lines(TEXTDISPLAY td, int s, int l, int p) { + return reinterpret_cast(td)->skip_lines(s, l, p); +} + + +int fl_text_display_rewind_lines(TEXTDISPLAY td, int s, int l) { + return reinterpret_cast(td)->rewind_lines(s, l); +} + + +void fl_text_display_linenumber_width(TEXTDISPLAY td, int w) { + reinterpret_cast(td)->linenumber_width(w); +} + diff --git a/src/c_fl_text_display.h b/src/c_fl_text_display.h new file mode 100644 index 0000000..dbd683f --- /dev/null +++ b/src/c_fl_text_display.h @@ -0,0 +1,35 @@ + + +#ifndef FL_TEXT_DISPLAY_GUARD +#define FL_TEXT_DISPLAY_GUARD + +#include "c_fl_text_buffer.h" + + +typedef void* TEXTDISPLAY; + + +extern "C" TEXTDISPLAY new_fl_text_display(int x, int y, int w, int h, char* label); +extern "C" void free_fl_text_display(TEXTDISPLAY td); + +extern "C" TEXTBUFFER fl_text_display_get_buffer(TEXTDISPLAY td); +extern "C" void fl_text_display_set_buffer(TEXTDISPLAY td, TEXTBUFFER tb); +extern "C" int fl_text_display_get_text_color(TEXTDISPLAY td); +extern "C" void fl_text_display_set_text_color(TEXTDISPLAY td, int c); +extern "C" int fl_text_display_get_text_font(TEXTDISPLAY td); +extern "C" void fl_text_display_set_text_font(TEXTDISPLAY td, int f); +extern "C" int fl_text_display_get_text_size(TEXTDISPLAY td); +extern "C" void fl_text_display_set_text_size(TEXTDISPLAY td, int s); +extern "C" int fl_text_display_get_insert_pos(TEXTDISPLAY td); +extern "C" void fl_text_display_set_insert_pos(TEXTDISPLAY td, int p); +extern "C" void fl_text_display_show_insert_pos(TEXTDISPLAY td); +extern "C" void fl_text_display_next_word(TEXTDISPLAY td); +extern "C" void fl_text_display_previous_word(TEXTDISPLAY td); +extern "C" void fl_text_display_wrap_mode(TEXTDISPLAY td, int w, int m); +extern "C" int fl_text_display_skip_lines(TEXTDISPLAY td, int s, int l, int p); +extern "C" int fl_text_display_rewind_lines(TEXTDISPLAY td, int s, int l); +extern "C" void fl_text_display_linenumber_width(TEXTDISPLAY td, int w); + + +#endif + diff --git a/src/c_fl_text_editor.cpp b/src/c_fl_text_editor.cpp new file mode 100644 index 0000000..c28f6fa --- /dev/null +++ b/src/c_fl_text_editor.cpp @@ -0,0 +1,48 @@ + + +#include +#include "c_fl_text_editor.h" + + +TEXTEDITOR new_fl_text_editor(int x, int y, int w, int h, char* label) { + Fl_Text_Editor *te = new Fl_Text_Editor(x, y, w, h, label); + return te; +} + + +void free_fl_text_editor(TEXTEDITOR te) { + delete reinterpret_cast(te); +} + + + + +void fl_text_editor_undo(TEXTEDITOR te) { + Fl_Text_Editor::kf_undo(0, reinterpret_cast(te)); +} + + +void fl_text_editor_cut(TEXTEDITOR te) { + Fl_Text_Editor::kf_cut(0, reinterpret_cast(te)); +} + + +void fl_text_editor_copy(TEXTEDITOR te) { + Fl_Text_Editor::kf_copy(0, reinterpret_cast(te)); +} + + +void fl_text_editor_paste(TEXTEDITOR te) { + Fl_Text_Editor::kf_paste(0, reinterpret_cast(te)); +} + + +void fl_text_editor_delete(TEXTEDITOR te) { + Fl_Text_Editor::kf_delete(0, reinterpret_cast(te)); +} + + +void fl_text_editor_remove_key_binding(TEXTEDITOR te, unsigned int k, unsigned long m) { + reinterpret_cast(te)->remove_key_binding(k, m); +} + diff --git a/src/c_fl_text_editor.h b/src/c_fl_text_editor.h new file mode 100644 index 0000000..ebaab0d --- /dev/null +++ b/src/c_fl_text_editor.h @@ -0,0 +1,23 @@ + + +#ifndef FL_TEXT_EDITOR_GUARD +#define FL_TEXT_EDITOR_GUARD + + +typedef void* TEXTEDITOR; + + +extern "C" TEXTEDITOR new_fl_text_editor(int x, int y, int w, int h, char* label); +extern "C" void free_fl_text_editor(TEXTEDITOR te); + + +extern "C" void fl_text_editor_undo(TEXTEDITOR te); +extern "C" void fl_text_editor_cut(TEXTEDITOR te); +extern "C" void fl_text_editor_copy(TEXTEDITOR te); +extern "C" void fl_text_editor_paste(TEXTEDITOR te); +extern "C" void fl_text_editor_delete(TEXTEDITOR te); +extern "C" void fl_text_editor_remove_key_binding(TEXTEDITOR te, unsigned int k, unsigned long m); + + +#endif + diff --git a/src/c_fl_toggle_button.cpp b/src/c_fl_toggle_button.cpp new file mode 100644 index 0000000..d52e72e --- /dev/null +++ b/src/c_fl_toggle_button.cpp @@ -0,0 +1,16 @@ + + +#include +#include "c_fl_toggle_button.h" + + +TOGGLEBUTTON new_fl_toggle_button(int x, int y, int w, int h, char* label) { + Fl_Toggle_Button *b = new Fl_Toggle_Button(x, y, w, h, label); + return b; +} + + +void free_fl_toggle_button(TOGGLEBUTTON b) { + delete reinterpret_cast(b); +} + diff --git a/src/c_fl_toggle_button.h b/src/c_fl_toggle_button.h new file mode 100644 index 0000000..ed86ed4 --- /dev/null +++ b/src/c_fl_toggle_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_TOGGLE_BUTTON_GUARD +#define FL_TOGGLE_BUTTON_GUARD + + +typedef void* TOGGLEBUTTON; + + +extern "C" TOGGLEBUTTON new_fl_toggle_button(int x, int y, int w, int h, char* label); +extern "C" void free_fl_toggle_button(TOGGLEBUTTON b); + + +#endif + diff --git a/src/c_fl_widget.cpp b/src/c_fl_widget.cpp new file mode 100644 index 0000000..30c4de3 --- /dev/null +++ b/src/c_fl_widget.cpp @@ -0,0 +1,119 @@ + + +#include +#include +#include "c_fl_widget.h" + + + + +void * fl_widget_get_user_data(WIDGET w) { + return reinterpret_cast(w)->user_data(); +} + + +void fl_widget_set_user_data(WIDGET w, void * d) { + reinterpret_cast(w)->user_data(d); +} + + + + +int fl_widget_get_box(WIDGET w) { + return reinterpret_cast(w)->box(); +} + + +void fl_widget_set_box(WIDGET w, int b) { + reinterpret_cast(w)->box(static_cast(b)); +} + + +const char* fl_widget_get_label(WIDGET w) { + return reinterpret_cast(w)->label(); +} + + +void fl_widget_set_label(WIDGET w, const char* t) { + reinterpret_cast(w)->copy_label(t); +} + + +int fl_widget_get_label_font(WIDGET w) { + return reinterpret_cast(w)->labelfont(); +} + + +void fl_widget_set_label_font(WIDGET w, int f) { + reinterpret_cast(w)->labelfont(static_cast(f)); +} + + +int fl_widget_get_label_size(WIDGET w) { + return reinterpret_cast(w)->labelsize(); +} + + +void fl_widget_set_label_size(WIDGET w, int s) { + reinterpret_cast(w)->labelsize(static_cast(s)); +} + + +int fl_widget_get_label_type(WIDGET w) { + return reinterpret_cast(w)->labeltype(); +} + + +void fl_widget_set_label_type(WIDGET w, int l) { + reinterpret_cast(w)->labeltype(static_cast(l)); +} + + +void * fl_widget_get_parent(WIDGET w) { + return reinterpret_cast(w)->parent(); +} + + + + +void fl_widget_set_callback(WIDGET w, void * cb) { + reinterpret_cast(w)->callback(reinterpret_cast(cb)); +} + + + + +int fl_widget_get_x(WIDGET w) { + return reinterpret_cast(w)->x(); +} + + +int fl_widget_get_y(WIDGET w) { + return reinterpret_cast(w)->y(); +} + + +int fl_widget_get_w(WIDGET w) { + return reinterpret_cast(w)->w(); +} + + +int fl_widget_get_h(WIDGET w) { + return reinterpret_cast(w)->h(); +} + + +void fl_widget_size(WIDGET w, int d, int h) { + reinterpret_cast(w)->size(d, h); +} + + +void fl_widget_position(WIDGET w, int x, int y) { + reinterpret_cast(w)->position(x, y); +} + + +void fl_widget_set_image(WIDGET w, void * img) { + reinterpret_cast(w)->image(reinterpret_cast(img)); +} + diff --git a/src/c_fl_widget.h b/src/c_fl_widget.h new file mode 100644 index 0000000..3c20dc2 --- /dev/null +++ b/src/c_fl_widget.h @@ -0,0 +1,40 @@ + + +#ifndef FL_WIDGET_GUARD +#define FL_WIDGET_GUARD + + +typedef void* WIDGET; + + +extern "C" void * fl_widget_get_user_data(WIDGET w); +extern "C" void fl_widget_set_user_data(WIDGET w, void * d); + + +extern "C" int fl_widget_get_box(WIDGET w); +extern "C" void fl_widget_set_box(WIDGET w, int b); +extern "C" const char* fl_widget_get_label(WIDGET w); +extern "C" void fl_widget_set_label(WIDGET w, const char* t); +extern "C" int fl_widget_get_label_font(WIDGET w); +extern "C" void fl_widget_set_label_font(WIDGET w, int f); +extern "C" int fl_widget_get_label_size(WIDGET w); +extern "C" void fl_widget_set_label_size(WIDGET w, int s); +extern "C" int fl_widget_get_label_type(WIDGET w); +extern "C" void fl_widget_set_label_type(WIDGET w, int l); +extern "C" void * fl_widget_get_parent(WIDGET w); + + +extern "C" void fl_widget_set_callback(WIDGET w, void * cb); + + +extern "C" int fl_widget_get_x(WIDGET w); +extern "C" int fl_widget_get_y(WIDGET w); +extern "C" int fl_widget_get_w(WIDGET w); +extern "C" int fl_widget_get_h(WIDGET w); +extern "C" void fl_widget_size(WIDGET w, int d, int h); +extern "C" void fl_widget_position(WIDGET w, int x, int y); +extern "C" void fl_widget_set_image(WIDGET w, void * img); + + +#endif + diff --git a/src/c_fl_window.cpp b/src/c_fl_window.cpp new file mode 100644 index 0000000..fbce39b --- /dev/null +++ b/src/c_fl_window.cpp @@ -0,0 +1,58 @@ + + +#include +#include +#include "c_fl_window.h" + + +WINDOW new_fl_window(int x, int y, int w, int h, char* label) { + Fl_Window *n = new Fl_Window(x, y, w, h, label); + return n; +} + + +WINDOW new_fl_window2(int w, int h) { + Fl_Window *n = new Fl_Window(w, h); + return n; +} + + +void free_fl_window(WINDOW n) { + delete reinterpret_cast(n); +} + + +void fl_window_show(WINDOW n) { + reinterpret_cast(n)->show(); +} + + +void fl_window_hide(WINDOW n) { + reinterpret_cast(n)->hide(); +} + + +void fl_window_set_label(WINDOW n, char* text) { + reinterpret_cast(n)->copy_label(text); +} + + +void fl_window_size_range(WINDOW n, int lw, int lh, int hw, int hh, int dw, int dh, int a) { + reinterpret_cast(n)->size_range(lw, lh, hw, hh, dw, dh, a); +} + + +void fl_window_set_icon(WINDOW n, void * img) { + reinterpret_cast(n)->icon(reinterpret_cast(img)); +} + + +void fl_window_set_modal(WINDOW n) { + reinterpret_cast(n)->set_modal(); +} + + +void fl_window_set_non_modal(WINDOW n) { + reinterpret_cast(n)->set_non_modal(); +} + diff --git a/src/c_fl_window.h b/src/c_fl_window.h new file mode 100644 index 0000000..c382919 --- /dev/null +++ b/src/c_fl_window.h @@ -0,0 +1,24 @@ + + +#ifndef FL_WINDOW_GUARD +#define FL_WINDOW_GUARD + + +typedef void* WINDOW; + + +extern "C" WINDOW new_fl_window(int x, int y, int w, int h, char* label); +extern "C" WINDOW new_fl_window2(int w, int h); +extern "C" void free_fl_window(WINDOW n); + +extern "C" void fl_window_show(WINDOW n); +extern "C" void fl_window_hide(WINDOW n); +extern "C" void fl_window_set_label(WINDOW n, char* text); +extern "C" void fl_window_size_range(WINDOW n, int lw, int lh, int hw, int hh, int dw, int dh, int a); +extern "C" void fl_window_set_icon(WINDOW n, void * img); +extern "C" void fl_window_set_modal(WINDOW n); +extern "C" void fl_window_set_non_modal(WINDOW n); + + +#endif + diff --git a/src/fltk-dialogs.adb b/src/fltk-dialogs.adb new file mode 100644 index 0000000..0c9adcf --- /dev/null +++ b/src/fltk-dialogs.adb @@ -0,0 +1,111 @@ + + +with Interfaces.C; +with Interfaces.C.Strings; +use type Interfaces.C.Strings.chars_ptr; + + +package body FLTK.Dialogs is + + + procedure dialog_fl_alert + (M : in Interfaces.C.char_array); + pragma Import (C, dialog_fl_alert, "dialog_fl_alert"); + + 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; + pragma Import (C, dialog_fl_input, "dialog_fl_input"); + + procedure dialog_fl_message + (M : in Interfaces.C.char_array); + pragma Import (C, dialog_fl_message, "dialog_fl_message"); + + + + + procedure Alert + (Message : String) is + begin + dialog_fl_alert (Interfaces.C.To_C (Message)); + end Alert; + + + + + function Three_Way_Choice + (Message, Button1, Button2, Button3 : in String) + return Choice + is + Result : Interfaces.C.int := dialog_fl_choice + (Interfaces.C.To_C (Message), + Interfaces.C.To_C (Button1), + Interfaces.C.To_C (Button2), + Interfaces.C.To_C (Button3)); + begin + return Choice'Val (Result); + end Three_Way_Choice; + + + + + 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 Text_Input + (Message : in String; + Default : in String := "") + return String + is + Result : Interfaces.C.Strings.chars_ptr := dialog_fl_input + (Interfaces.C.To_C (Message), + 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 Text_Input; + + + + + procedure Message_Box + (Message : in String) is + begin + dialog_fl_message (Interfaces.C.To_C (Message)); + end Message_Box; + + +end FLTK.Dialogs; + diff --git a/src/fltk-dialogs.ads b/src/fltk-dialogs.ads new file mode 100644 index 0000000..cb5b966 --- /dev/null +++ b/src/fltk-dialogs.ads @@ -0,0 +1,33 @@ + + +package FLTK.Dialogs is + + + procedure Alert + (Message : String); + + + type Choice is (First, Second, Third); + function Three_Way_Choice + (Message, Button1, Button2, Button3 : in String) + return Choice; + + + function File_Chooser + (Message, Filter_Pattern, Default : in String; + Relative : in Boolean := False) + return String; + + + function Text_Input + (Message : in String; + Default : in String := "") + return String; + + + procedure Message_Box + (Message : in String); + + +end FLTK.Dialogs; + diff --git a/src/fltk-enum_values.ads b/src/fltk-enum_values.ads new file mode 100644 index 0000000..068d5c1 --- /dev/null +++ b/src/fltk-enum_values.ads @@ -0,0 +1,7 @@ + + +private package FLTK.Enum_Values is + + +end FLTK.Enum_Values; + diff --git a/src/fltk-enums.adb b/src/fltk-enums.adb new file mode 100644 index 0000000..292e5ff --- /dev/null +++ b/src/fltk-enums.adb @@ -0,0 +1,71 @@ + + +with Interfaces.C; +use type Interfaces.C.unsigned_long; + + +package body FLTK.Enums is + + + function Shortcut + (Key : Pressable_Key) + return Shortcut_Key is + begin + return This : Shortcut_Key do + This.Modifier := Mod_None; + This.Keypress := Key; + end return; + end Shortcut; + + + + + function Key_To_C + (Key : Shortcut_Key) + return Interfaces.C.unsigned_long is + begin + return Interfaces.C.unsigned_long (Key.Modifier) * + 65536 + Character'Pos (Key.Keypress); + end Key_To_C; + + + + + function "+" + (Left, Right : in Modifier_Key) + return Modifier_Key is + begin + return Left or Right; + end "+"; + + + + + function "+" + (Left : in Modifier_Key; + Right : in Pressable_Key) + return Shortcut_Key is + begin + return This : Shortcut_Key do + This.Modifier := Left; + This.Keypress := Right; + end return; + end "+"; + + + + + function "+" + (Left : in Modifier_Key; + Right : in Shortcut_Key) + return Shortcut_Key is + begin + return This : Shortcut_Key do + This.Modifier := Left or Right.Modifier; + This.Keypress := Right.Keypress; + end return; + end "+"; + + +end FLTK.Enums; + diff --git a/src/fltk-enums.ads b/src/fltk-enums.ads new file mode 100644 index 0000000..91f7353 --- /dev/null +++ b/src/fltk-enums.ads @@ -0,0 +1,146 @@ + + +with Interfaces.C; +private with FLTK.Enum_Values; + + +package FLTK.Enums is + + + type Box_Kind is + (No_Box, + Flat_Box, + Up_Box, + Down_Box, + Up_Frame, + Down_Frame, + Thin_Up_Box, + Thin_Down_Box, + Thin_Up_Frame, + Thin_Down_Frame, + Engraved_Box, + Embossed_Box, + Engraved_Frame, + Embossed_Frame, + Border_Box, + Shadow_Box, + Border_Frame, + Shadow_Frame, + Rounded_Box, + RShadow_Box, + Rounded_Frame, + RFlat_Box, + Round_Up_Box, + Round_Down_Box, + Diamond_Up_Box, + Diamond_Down_Box, + Oval_Box, + OShadow_Box, + Oval_Frame, + OFlat_Box, + Plastic_Up_Box, + Plastic_Down_Box, + Plastic_Up_Frame, + Plastic_Down_Frame, + Plastic_Thin_Up_Box, + Plastic_Thin_Down_Box, + Plastic_Round_Up_Box, + Plastic_Round_Down_Box, + Gtk_Up_Box, + Gtk_Down_Box, + Gtk_Up_Frame, + Gtk_Down_Frame, + Gtk_Thin_Up_Box, + Gtk_Thin_Down_Box, + Gtk_Thin_Up_Frame, + Gtk_Thin_Down_Frame, + Gtk_Round_Up_Box, + Gtk_Round_Down_Box, + Gleam_Up_Box, + Gleam_Down_Box, + Gleam_Up_Frame, + Gleam_Down_Frame, + Gleam_Thin_Up_Box, + Gleam_Thin_Down_Box, + Gleam_Round_Up_Box, + Gleam_Round_Down_Box, + Free_Box); + + + type Font_Kind is + (Helvetica, + Helvetica_Bold, + Helvetica_Italic, + Helvetica_Bold_Italic, + Courier, + Courier_Bold, + Courier_Italic, + Courier_Bold_Italic, + Times, + Times_Bold, + Times_Italic, + Times_Bold_Italic, + Symbol, + Screen, + Screen_Bold, + Zapf_Dingbats, + Free_Font); + + + type Label_Kind is + (Normal_Label, + No_Label, + Shadow_Label, + Engraved_Label, + Embossed_Label, + Multi_Label, + Icon_Label, + Image_Label, + Free_Label); + + + -- type Modifier_Key is private; + type Modifier_Key is new Interfaces.Unsigned_8; + + -- type Shortcut_Key is private; + type Shortcut_Key is + record + Modifier : Modifier_Key; + Keypress : Character; + end record; + + subtype Pressable_Key is Character range Character'Val (32) .. Character'Val (126); + function Shortcut (Key : Pressable_Key) return Shortcut_Key; + No_Key : constant Shortcut_Key; + + + function "+" (Left, Right : in Modifier_Key) return Modifier_Key; + function "+" (Left : in Modifier_Key; Right : in Pressable_Key) return Shortcut_Key; + function "+" (Left : in Modifier_Key; Right : in Shortcut_Key) return Shortcut_Key; + Mod_None : constant Modifier_Key; + Mod_Shift : constant Modifier_Key; + Mod_Ctrl : constant Modifier_Key; + Mod_Alt : constant Modifier_Key; + + + function Key_To_C + (Key : Shortcut_Key) + return Interfaces.C.unsigned_long; + + +private + + + -- these values designed to align with FLTK enumeration types + Mod_None : constant Modifier_Key := 2#00000000#; + Mod_Shift : constant Modifier_Key := 2#00000001#; + Mod_Ctrl : constant Modifier_Key := 2#00000100#; + Mod_Alt : constant Modifier_Key := 2#00001000#; + + + No_Key : constant Shortcut_Key := + (Modifier => Mod_None, Keypress => Character'Val (0)); + + +end FLTK.Enums; + diff --git a/src/fltk-images-rgb-png.adb b/src/fltk-images-rgb-png.adb new file mode 100644 index 0000000..ecb2f5e --- /dev/null +++ b/src/fltk-images-rgb-png.adb @@ -0,0 +1,49 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Images.RGB.PNG is + + + function new_fl_png_image + (F : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_png_image, "new_fl_png_image"); + + procedure free_fl_png_image + (P : in System.Address); + pragma Import (C, free_fl_png_image, "free_fl_png_image"); + + + + + overriding procedure Finalize + (This : in out PNG_Image) is + begin + Finalize (RGB_Image (This)); + if This.Void_Ptr /= System.Null_Address then + if This in PNG_Image then + free_fl_png_image (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (Filename : in String) + return PNG_Image is + begin + return This : PNG_Image do + This.Void_Ptr := new_fl_png_image + (Interfaces.C.To_C (Filename)); + end return; + end Create; + + +end FLTK.Images.RGB.PNG; + diff --git a/src/fltk-images-rgb-png.ads b/src/fltk-images-rgb-png.ads new file mode 100644 index 0000000..0b44cb0 --- /dev/null +++ b/src/fltk-images-rgb-png.ads @@ -0,0 +1,25 @@ + + +package FLTK.Images.RGB.PNG is + + + type PNG_Image is new RGB_Image with private; + + + function Create + (Filename : in String) + return PNG_Image; + + +private + + + type PNG_Image is new RGB_Image with null record; + + + overriding procedure Finalize + (This : in out PNG_Image); + + +end FLTK.Images.RGB.PNG; + diff --git a/src/fltk-images-rgb.adb b/src/fltk-images-rgb.adb new file mode 100644 index 0000000..3556f74 --- /dev/null +++ b/src/fltk-images-rgb.adb @@ -0,0 +1,14 @@ + + +package body FLTK.Images.RGB is + + + overriding procedure Finalize + (This : in out RGB_Image) is + begin + Finalize (Image (This)); + end Finalize; + + +end FLTK.Images.RGB; + diff --git a/src/fltk-images-rgb.ads b/src/fltk-images-rgb.ads new file mode 100644 index 0000000..ba47793 --- /dev/null +++ b/src/fltk-images-rgb.ads @@ -0,0 +1,20 @@ + + +package FLTK.Images.RGB is + + + type RGB_Image is new Image with private; + + +private + + + type RGB_Image is new Image with null record; + + + overriding procedure Finalize + (This : in out RGB_Image); + + +end FLTK.Images.RGB; + diff --git a/src/fltk-images.adb b/src/fltk-images.adb new file mode 100644 index 0000000..bbd87c9 --- /dev/null +++ b/src/fltk-images.adb @@ -0,0 +1,96 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Images is + + + function new_fl_image + (W, H, D : in Interfaces.C.int) + return System.Address; + pragma Import (C, new_fl_image, "new_fl_image"); + + procedure free_fl_image + (I : in System.Address); + pragma Import (C, free_fl_image, "free_fl_image"); + + function fl_image_w + (I : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_image_w, "fl_image_w"); + + function fl_image_h + (I : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_image_h, "fl_image_h"); + + function fl_image_d + (I : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_image_d, "fl_image_d"); + + + + + overriding procedure Finalize + (This : in out Image) is + begin + Finalize (Wrapper (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Image then + free_fl_image (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (Width, Height, Depth : in Natural) + return Image is + begin + return This : Image do + This.Void_Ptr := new_fl_image + (Interfaces.C.int (Width), + Interfaces.C.int (Height), + Interfaces.C.int (Depth)); + end return; + end Create; + + + + + function Get_W + (This : in Image) + return Natural is + begin + return Natural (fl_image_w (This.Void_Ptr)); + end Get_W; + + + + + function Get_H + (This : in Image) + return Natural is + begin + return Natural (fl_image_h (This.Void_Ptr)); + end Get_H; + + + + + function Get_D + (This : in Image) + return Natural is + begin + return Natural (fl_image_d (This.Void_Ptr)); + end Get_D; + + +end FLTK.Images; + diff --git a/src/fltk-images.ads b/src/fltk-images.ads new file mode 100644 index 0000000..f005443 --- /dev/null +++ b/src/fltk-images.ads @@ -0,0 +1,40 @@ + + +package FLTK.Images is + + + type Image is new Wrapper with private; + + + function Create + (Width, Height, Depth : in Natural) + return Image; + + + function Get_W + (This : in Image) + return Natural; + + + function Get_H + (This : in Image) + return Natural; + + + function Get_D + (This : in Image) + return Natural; + + +private + + + type Image is new Wrapper with null record; + + + overriding procedure Finalize + (This : in out Image); + + +end FLTK.Images; + diff --git a/src/fltk-text_buffers.adb b/src/fltk-text_buffers.adb new file mode 100644 index 0000000..52f12e0 --- /dev/null +++ b/src/fltk-text_buffers.adb @@ -0,0 +1,540 @@ + + +with Interfaces.C.Strings; +with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; +with Ada.Containers; +with System; +use type System.Address; +use type Interfaces.C.int; +use type Interfaces.C.Strings.chars_ptr; +use type Ada.Containers.Count_Type; + + +package body FLTK.Text_Buffers is + + + function new_fl_text_buffer + (RS, PGS : in Interfaces.C.int) + return System.Address; + pragma Import (C, new_fl_text_buffer, "new_fl_text_buffer"); + + procedure free_fl_text_buffer + (TB : in System.Address); + pragma Import (C, free_fl_text_buffer, "free_fl_text_buffer"); + + procedure fl_text_buffer_add_modify_callback + (TB, CB, UD : in System.Address); + pragma Import (C, fl_text_buffer_add_modify_callback, + "fl_text_buffer_add_modify_callback"); + + procedure fl_text_buffer_add_predelete_callback + (TB, CB, UD : in System.Address); + pragma Import (C, fl_text_buffer_add_predelete_callback, + "fl_text_buffer_add_predelete_callback"); + + procedure fl_text_buffer_call_modify_callbacks + (TB : in System.Address); + pragma Import (C, fl_text_buffer_call_modify_callbacks, + "fl_text_buffer_call_modify_callbacks"); + + procedure fl_text_buffer_call_predelete_callbacks + (TB : in System.Address); + pragma Import (C, fl_text_buffer_call_predelete_callbacks, + "fl_text_buffer_call_predelete_callbacks"); + + procedure fl_text_buffer_insert + (TB : in System.Address; + P : in Interfaces.C.int; + I : in Interfaces.C.char_array); + pragma Import (C, fl_text_buffer_insert, "fl_text_buffer_insert"); + + procedure fl_text_buffer_remove + (TB : in System.Address; + S, F : in Interfaces.C.int); + pragma Import (C, fl_text_buffer_remove, "fl_text_buffer_remove"); + + function fl_text_buffer_length + (TB : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_length, "fl_text_buffer_length"); + + function fl_text_buffer_loadfile + (TB : in System.Address; + N : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_loadfile, "fl_text_buffer_loadfile"); + + procedure fl_text_buffer_remove_selection + (TB : in System.Address); + pragma Import (C, fl_text_buffer_remove_selection, "fl_text_buffer_remove_selection"); + + function fl_text_buffer_savefile + (TB : in System.Address; + N : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_savefile, "fl_text_buffer_savefile"); + + function fl_text_buffer_search_forward + (TB : in System.Address; + SP : in Interfaces.C.int; + IT : in Interfaces.C.char_array; + FP : out Interfaces.C.int; + CA : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_search_forward, "fl_text_buffer_search_forward"); + + function fl_text_buffer_search_backward + (TB : in System.Address; + SP : in Interfaces.C.int; + IT : in Interfaces.C.char_array; + FP : out Interfaces.C.int; + CA : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_search_backward, "fl_text_buffer_search_backward"); + + procedure fl_text_buffer_select + (TB : in System.Address; + S, E : in Interfaces.C.int); + pragma Import (C, fl_text_buffer_select, "fl_text_buffer_select"); + + function fl_text_buffer_selection_position + (TB : in System.Address; + S, E : out Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_selection_position, "fl_text_buffer_selection_position"); + + function fl_text_buffer_selected + (TB : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_selected, "fl_text_buffer_selected"); + + function fl_text_buffer_skip_lines + (TB : in System.Address; + S, L : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_skip_lines, "fl_text_buffer_skip_lines"); + + function fl_text_buffer_rewind_lines + (TB : in System.Address; + S, L : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_rewind_lines, "fl_text_buffer_rewind_lines"); + + function fl_text_buffer_char_at + (TB : in System.Address; + P : in Interfaces.C.int) + return Interfaces.C.unsigned; + pragma Import (C, fl_text_buffer_char_at, "fl_text_buffer_char_at"); + + function fl_text_buffer_text_range + (TB : in System.Address; + S, F : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_text_buffer_text_range, "fl_text_buffer_text_range"); + + + + + procedure Finalize + (This : in out Text_Buffer) is + begin + if This.Void_Ptr /= System.Null_Address then + if This in Text_Buffer then + free_fl_text_buffer (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + procedure Modify_Callback_Hook + (Pos, Inserted, Deleted, Restyled : in Interfaces.C.int; + Text : in Interfaces.C.Strings.chars_ptr; + UD : in System.Address); + pragma Convention (C, Modify_Callback_Hook); + + procedure Modify_Callback_Hook + (Pos : in Interfaces.C.int; + Inserted, Deleted, Restyled : in Interfaces.C.int; + Text : in Interfaces.C.Strings.chars_ptr; + UD : in System.Address) + is + Action : Modification; + Place : Position := Position (Pos); + Length : Natural; + Deleted_Text : Unbounded_String := To_Unbounded_String (""); + + Ada_Text_Buffer : access Text_Buffer := + Text_Buffer_Convert.To_Pointer (UD); + begin + if Ada_Text_Buffer.CB_Active then + if Inserted > 0 then + Length := Natural (Inserted); + Action := Insert; + elsif Deleted > 0 then + Length := Natural (Deleted); + Action := Delete; + if Text /= Interfaces.C.Strings.Null_Ptr then + Deleted_Text := To_Unbounded_String (Interfaces.C.Strings.Value (Text)); + end if; + elsif Restyled > 0 then + Length := Natural (Restyled); + Action := Restyle; + else + Length := 0; + Action := None; + end if; + + for CB of Ada_Text_Buffer.Modify_CBs loop + CB.all (Action, Place, Length, To_String (Deleted_Text)); + end loop; + end if; + end Modify_Callback_Hook; + + + + + procedure Predelete_Callback_Hook + (Pos, Deleted : in Interfaces.C.int; + UD : in System.Address); + pragma Convention (C, Predelete_Callback_Hook); + + procedure Predelete_Callback_Hook + (Pos, Deleted : in Interfaces.C.int; + UD : in System.Address) + is + Place : Position := Position (Pos); + Length : Natural := Natural (Deleted); + + Ada_Text_Buffer : access Text_Buffer := + Text_Buffer_Convert.To_Pointer (UD); + begin + if Ada_Text_Buffer.CB_Active then + for CB of Ada_Text_Buffer.Predelete_CBs loop + CB.all (Place, Length); + end loop; + end if; + end Predelete_Callback_Hook; + + + + + function Create + (Requested_Size : in Natural := 0; + Preferred_Gap_Size : in Natural := 1024) + return Text_Buffer is + begin + return This : Text_Buffer do + This.Void_Ptr := new_fl_text_buffer + (Interfaces.C.int (Requested_Size), + Interfaces.C.int (Preferred_Gap_Size)); + + This.Modify_CBs := Modify_Vectors.Empty_Vector; + This.Predelete_CBs := Predelete_Vectors.Empty_Vector; + This.CB_Active := True; + end return; + end Create; + + + + + procedure Add_Modify_Callback + (This : in out Text_Buffer; + Func : in Modify_Callback) is + begin + if This.Modify_CBs.Length = 0 then + fl_text_buffer_add_modify_callback + (This.Void_Ptr, + Modify_Callback_Hook'Address, + This'Address); + end if; + This.Modify_CBs.Append (Func); + end Add_Modify_Callback; + + + + + procedure Add_Predelete_Callback + (This : in out Text_Buffer; + Func : in Predelete_Callback) is + begin + if This.Predelete_CBs.Length = 0 then + fl_text_buffer_add_predelete_callback + (This.Void_Ptr, + Predelete_Callback_Hook'Address, + This'Address); + end if; + This.Predelete_CBs.Append (Func); + end Add_Predelete_Callback; + + + + + procedure Call_Modify_Callbacks + (This : in out Text_Buffer) is + begin + fl_text_buffer_call_modify_callbacks (This.Void_Ptr); + end Call_Modify_Callbacks; + + + + + procedure Call_Predelete_Callbacks + (This : in out Text_Buffer) is + begin + fl_text_buffer_call_predelete_callbacks (This.Void_Ptr); + end Call_Predelete_Callbacks; + + + + + procedure Enable_Callbacks + (This : in out Text_Buffer) is + begin + This.CB_Active := True; + end Enable_Callbacks; + + + + + procedure Disable_Callbacks + (This : in out Text_Buffer) is + begin + This.CB_Active := False; + end Disable_Callbacks; + + + + + procedure Insert_Text + (This : in out Text_Buffer; + Pos : in Natural; + Item : in String) is + begin + fl_text_buffer_insert + (This.Void_Ptr, + Interfaces.C.int (Pos), + Interfaces.C.To_C (Item)); + end Insert_Text; + + + + + procedure Remove_Text + (This : in out Text_Buffer; + Start, Finish : in Natural) is + begin + fl_text_buffer_remove + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish)); + end Remove_Text; + + + + + function Length + (This : in Text_Buffer) + return Natural is + begin + return Natural (fl_text_buffer_length (This.Void_Ptr)); + end Length; + + + + + procedure Load_File + (This : in Text_Buffer; + Name : in String) + is + Err_No : Interfaces.C.int := fl_text_buffer_loadfile + (This.Void_Ptr, + Interfaces.C.To_C (Name)); + begin + if Err_No /= 0 then + raise Storage_Error; + end if; + end Load_File; + + + + + procedure Remove_Selected_Text + (This : in out Text_Buffer) is + begin + fl_text_buffer_remove_selection (This.Void_Ptr); + end Remove_Selected_Text; + + + + + procedure Save_File + (This : in Text_Buffer; + Name : in String) + is + Err_No : Interfaces.C.int := fl_text_buffer_savefile + (This.Void_Ptr, + Interfaces.C.To_C (Name)); + begin + if Err_No /= 0 then + raise Storage_Error; + end if; + end Save_File; + + + + + function Search_Forward + (This : in Text_Buffer; + Start_At : in Natural; + Item : in String; + Found_At : out Natural; + Match_Case : in Boolean) + return Boolean + is + Found_Raw, Result : Interfaces.C.int; + begin + Result := fl_text_buffer_search_forward + (This.Void_Ptr, + Interfaces.C.int (Start_At), + Interfaces.C.To_C (Item), + Found_Raw, + Boolean'Pos (Match_Case)); + if Result /= 0 then + Found_At := Natural (Found_Raw); + end if; + return Result /= 0; + end Search_Forward; + + + + + function Search_Backward + (This : in Text_Buffer; + Start_At : in Natural; + Item : in String; + Found_At : out Natural; + Match_Case : in Boolean) + return Boolean + is + Found_Raw, Result : Interfaces.C.int; + begin + Result := fl_text_buffer_search_backward + (This.Void_Ptr, + Interfaces.C.int (Start_At), + Interfaces.C.To_C (Item), + Found_Raw, + Boolean'Pos (Match_Case)); + if Result /= 0 then + Found_At := Natural (Found_Raw); + end if; + return Result /= 0; + end Search_Backward; + + + + + procedure Set_Selection + (This : in out Text_Buffer; + Start, Finish : in Natural) is + begin + fl_text_buffer_select + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish)); + end Set_Selection; + + + + + function Get_Selection + (This : in Text_Buffer; + Start, Finish : out Natural) + return Boolean + is + Result, Start_Raw, Finish_Raw : Interfaces.C.int; + begin + Result := fl_text_buffer_selection_position + (This.Void_Ptr, + Start_Raw, + Finish_Raw); + if Result /= 0 then + Start := Natural (Start_Raw); + Finish := Natural (Finish_Raw); + end if; + return Result /= 0; + end Get_Selection; + + + + + function Has_Selection + (This : in Text_Buffer) + return Boolean is + begin + return fl_text_buffer_selected (This.Void_Ptr) /= 0; + end Has_Selection; + + + + + function Skip_Lines + (This : in out Text_Buffer; + Start, Lines : in Natural) + return Natural is + begin + return Natural (fl_text_buffer_skip_lines + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Lines))); + end Skip_Lines; + + + + + function Rewind_Lines + (This : in out Text_Buffer; + Start, Lines : in Natural) + return Natural is + begin + return Natural (fl_text_buffer_rewind_lines + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Lines))); + end Rewind_Lines; + + + + + function Character_At + (This : in Text_Buffer; + Pos : in Natural) + return Character is + begin + return Character'Val (fl_text_buffer_char_at + (This.Void_Ptr, + Interfaces.C.int (Pos))); + end Character_At; + + + + + function Text_At + (This : in Text_Buffer; + Start, Finish : in Natural) + return String + is + C_Str : Interfaces.C.Strings.chars_ptr := fl_text_buffer_text_range + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish)); + The_Text : String := Interfaces.C.Strings.Value (C_Str); + begin + Interfaces.C.Strings.Free (C_Str); + return The_Text; + end Text_At; + + +end FLTK.Text_Buffers; + diff --git a/src/fltk-text_buffers.ads b/src/fltk-text_buffers.ads new file mode 100644 index 0000000..d3e1bab --- /dev/null +++ b/src/fltk-text_buffers.ads @@ -0,0 +1,180 @@ + + +private with Ada.Containers.Vectors; +private with System.Address_To_Access_Conversions; + + +package FLTK.Text_Buffers is + + + type Text_Buffer is new Wrapper with private; + type Text_Buffer_Cursor (Data : access Text_Buffer'Class) is limited null record + with Implicit_Dereference => Data; + + + type Position is new Natural; + type Modification is (Insert, Restyle, Delete, None); + + + type Modify_Callback is access procedure + (Action : in Modification; + Place : in Position; + Length : in Natural; + Deleted_Text : in String); + + + type Predelete_Callback is access procedure + (Place : in Position; + Length : in Natural); + + + function Create + (Requested_Size : in Natural := 0; + Preferred_Gap_Size : in Natural := 1024) + return Text_Buffer; + + + procedure Add_Modify_Callback + (This : in out Text_Buffer; + Func : in Modify_Callback); + + + procedure Add_Predelete_Callback + (This : in out Text_Buffer; + Func : in Predelete_Callback); + + + procedure Call_Modify_Callbacks + (This : in out Text_Buffer); + + + procedure Call_Predelete_Callbacks + (This : in out Text_Buffer); + + + procedure Enable_Callbacks + (This : in out Text_Buffer); + + + procedure Disable_Callbacks + (This : in out Text_Buffer); + + + procedure Insert_Text + (This : in out Text_Buffer; + Pos : in Natural; + Item : in String); + + + procedure Remove_Text + (This : in out Text_Buffer; + Start, Finish : in Natural); + + + function Length + (This : in Text_Buffer) + return Natural; + + + procedure Load_File + (This : in Text_Buffer; + Name : in String); + + + procedure Remove_Selected_Text + (This : in out Text_Buffer); + + + procedure Save_File + (This : in Text_Buffer; + Name : in String); + + + function Search_Forward + (This : in Text_Buffer; + Start_At : in Natural; + Item : in String; + Found_At : out Natural; + Match_Case : in Boolean) + return Boolean; + + + function Search_Backward + (This : in Text_Buffer; + Start_At : in Natural; + Item : in String; + Found_At : out Natural; + Match_Case : in Boolean) + return Boolean; + + + procedure Set_Selection + (This : in out Text_Buffer; + Start, Finish : in Natural); + + + function Get_Selection + (This : in Text_Buffer; + Start, Finish : out Natural) + return Boolean; + + + function Has_Selection + (This : in Text_Buffer) + return Boolean; + + + -- only takes into account newline characters, not word wrap + function Skip_Lines + (This : in out Text_Buffer; + Start, Lines : in Natural) + return Natural; + + + -- only takes into account newline characters, not word wrap + function Rewind_Lines + (This : in out Text_Buffer; + Start, Lines : in Natural) + return Natural; + + + function Character_At + (This : in Text_Buffer; + Pos : in Natural) + return Character; + + + function Text_At + (This : in Text_Buffer; + Start, Finish : in Natural) + return String; + + +private + + + package Modify_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Modify_Callback); + package Predelete_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Predelete_Callback); + + + type Text_Buffer is new Wrapper with + record + CB_Active : Boolean; + Modify_CBs : Modify_Vectors.Vector; + Predelete_CBs : Predelete_Vectors.Vector; + end record; + + + overriding procedure Finalize + (This : in out Text_Buffer); + + + package Text_Buffer_Convert is new System.Address_To_Access_Conversions (Text_Buffer); + + +end FLTK.Text_Buffers; + diff --git a/src/fltk-widgets-boxes.adb b/src/fltk-widgets-boxes.adb new file mode 100644 index 0000000..7b70f01 --- /dev/null +++ b/src/fltk-widgets-boxes.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Boxes is + + + function new_fl_box + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_box, "new_fl_box"); + + procedure free_fl_box + (B : in System.Address); + pragma Import (C, free_fl_box, "free_fl_box"); + + + + + procedure Finalize + (This : in out Box) is + begin + Finalize (Widget (This)); + if (This.Void_Ptr /= System.Null_Address) then + if This in Box then + free_fl_box (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Box is + begin + return This : Box do + This.Void_Ptr := new_fl_box + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Boxes; + diff --git a/src/fltk-widgets-boxes.ads b/src/fltk-widgets-boxes.ads new file mode 100644 index 0000000..00f84d4 --- /dev/null +++ b/src/fltk-widgets-boxes.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Boxes is + + + type Box is new Widget with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Box; + + +private + + + type Box is new Widget with null record; + + + overriding procedure Finalize + (This : in out Box); + + +end FLTK.Widgets.Boxes; + diff --git a/src/fltk-widgets-buttons-enter.adb b/src/fltk-widgets-buttons-enter.adb new file mode 100644 index 0000000..bbef830 --- /dev/null +++ b/src/fltk-widgets-buttons-enter.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Enter is + + + function new_fl_return_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_return_button, "new_fl_return_button"); + + procedure free_fl_return_button + (B : in System.Address); + pragma Import (C, free_fl_return_button, "free_fl_return_button"); + + + + + procedure Finalize + (This : in out Enter_Button) is + begin + Finalize (Button (This)); + if (This.Void_Ptr /= System.Null_Address) then + if This in Enter_Button then + free_fl_return_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Enter_Button is + begin + return This : Enter_Button do + This.Void_Ptr := new_fl_return_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Buttons.Enter; + diff --git a/src/fltk-widgets-buttons-enter.ads b/src/fltk-widgets-buttons-enter.ads new file mode 100644 index 0000000..1db7308 --- /dev/null +++ b/src/fltk-widgets-buttons-enter.ads @@ -0,0 +1,29 @@ + + +-- Return Buttons, but return is a reserved word, so they're Enter Buttons instead + + +package FLTK.Widgets.Buttons.Enter is + + + type Enter_Button is new Button with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Enter_Button; + + +private + + + type Enter_Button is new Button with null record; + + + overriding procedure Finalize + (This : in out Enter_Button); + + +end FLTK.Widgets.Buttons.Enter; + diff --git a/src/fltk-widgets-buttons-light-check.adb b/src/fltk-widgets-buttons-light-check.adb new file mode 100644 index 0000000..7f16c9d --- /dev/null +++ b/src/fltk-widgets-buttons-light-check.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Light.Check is + + + function new_fl_check_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_check_button, "new_fl_check_button"); + + procedure free_fl_check_button + (B : in System.Address); + pragma Import (C, free_fl_check_button, "free_fl_check_button"); + + + + + procedure Finalize + (This : in out Check_Button) is + begin + Finalize (Light_Button (This)); + if (This.Void_Ptr /= System.Null_Address) then + if This in Check_Button then + free_fl_check_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Check_Button is + begin + return This : Check_Button do + This.Void_Ptr := new_fl_check_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Buttons.Light.Check; + diff --git a/src/fltk-widgets-buttons-light-check.ads b/src/fltk-widgets-buttons-light-check.ads new file mode 100644 index 0000000..1ab34f0 --- /dev/null +++ b/src/fltk-widgets-buttons-light-check.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Buttons.Light.Check is + + + type Check_Button is new Light_Button with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Check_Button; + + +private + + + type Check_Button is new Light_Button with null record; + + + overriding procedure Finalize + (This : in out Check_Button); + + +end FLTK.Widgets.Buttons.Light.Check; + diff --git a/src/fltk-widgets-buttons-light-radio.adb b/src/fltk-widgets-buttons-light-radio.adb new file mode 100644 index 0000000..1a741b9 --- /dev/null +++ b/src/fltk-widgets-buttons-light-radio.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Light.Radio is + + + function new_fl_radio_light_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_radio_light_button, "new_fl_radio_light_button"); + + procedure free_fl_radio_light_button + (B : in System.Address); + pragma Import (C, free_fl_radio_light_button, "free_fl_radio_light_button"); + + + + + procedure Finalize + (This : in out Radio_Light_Button) is + begin + Finalize (Light_Button (This)); + if (This.Void_Ptr /= System.Null_Address) then + if This in Radio_Light_Button then + free_fl_radio_light_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Radio_Light_Button is + begin + return This : Radio_Light_Button do + This.Void_Ptr := new_fl_radio_light_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Buttons.Light.Radio; + diff --git a/src/fltk-widgets-buttons-light-radio.ads b/src/fltk-widgets-buttons-light-radio.ads new file mode 100644 index 0000000..bad0a92 --- /dev/null +++ b/src/fltk-widgets-buttons-light-radio.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Buttons.Light.Radio is + + + type Radio_Light_Button is new Light_Button with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Radio_Light_Button; + + +private + + + type Radio_Light_Button is new Light_Button with null record; + + + overriding procedure Finalize + (This : in out Radio_Light_Button); + + +end FLTK.Widgets.Buttons.Light.Radio; + diff --git a/src/fltk-widgets-buttons-light-round-radio.adb b/src/fltk-widgets-buttons-light-round-radio.adb new file mode 100644 index 0000000..c61430f --- /dev/null +++ b/src/fltk-widgets-buttons-light-round-radio.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Light.Round.Radio is + + + function new_fl_radio_round_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_radio_round_button, "new_fl_radio_round_button"); + + procedure free_fl_radio_round_button + (B : in System.Address); + pragma Import (C, free_fl_radio_round_button, "free_fl_radio_round_button"); + + + + + procedure Finalize + (This : in out Radio_Round_Button) is + begin + Finalize (Round_Button (This)); + if (This.Void_Ptr /= System.Null_Address) then + if This in Radio_Round_Button then + free_fl_radio_round_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Radio_Round_Button is + begin + return This : Radio_Round_Button do + This.Void_Ptr := new_fl_radio_round_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Buttons.Light.Round.Radio; + diff --git a/src/fltk-widgets-buttons-light-round-radio.ads b/src/fltk-widgets-buttons-light-round-radio.ads new file mode 100644 index 0000000..ad1eec7 --- /dev/null +++ b/src/fltk-widgets-buttons-light-round-radio.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Buttons.Light.Round.Radio is + + + type Radio_Round_Button is new Round_Button with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Radio_Round_Button; + + +private + + + type Radio_Round_Button is new Round_Button with null record; + + + overriding procedure Finalize + (This : in out Radio_Round_Button); + + +end FLTK.Widgets.Buttons.Light.Round.Radio; + diff --git a/src/fltk-widgets-buttons-light-round.adb b/src/fltk-widgets-buttons-light-round.adb new file mode 100644 index 0000000..8be6a4e --- /dev/null +++ b/src/fltk-widgets-buttons-light-round.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Light.Round is + + + function new_fl_round_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_round_button, "new_fl_round_button"); + + procedure free_fl_round_button + (B : in System.Address); + pragma Import (C, free_fl_round_button, "free_fl_round_button"); + + + + + procedure Finalize + (This : in out Round_Button) is + begin + Finalize (Light_Button (This)); + if (This.Void_Ptr /= System.Null_Address) then + if This in Round_Button then + free_fl_round_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Round_Button is + begin + return This : Round_Button do + This.Void_Ptr := new_fl_round_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Buttons.Light.Round; + diff --git a/src/fltk-widgets-buttons-light-round.ads b/src/fltk-widgets-buttons-light-round.ads new file mode 100644 index 0000000..7cb99b8 --- /dev/null +++ b/src/fltk-widgets-buttons-light-round.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Buttons.Light.Round is + + + type Round_Button is new Light_Button with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Round_Button; + + +private + + + type Round_Button is new Light_Button with null record; + + + overriding procedure Finalize + (This : in out Round_Button); + + +end FLTK.Widgets.Buttons.Light.Round; + diff --git a/src/fltk-widgets-buttons-light.adb b/src/fltk-widgets-buttons-light.adb new file mode 100644 index 0000000..cefc9ef --- /dev/null +++ b/src/fltk-widgets-buttons-light.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Light is + + + function new_fl_light_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_light_button, "new_fl_light_button"); + + procedure free_fl_light_button + (B : in System.Address); + pragma Import (C, free_fl_light_button, "free_fl_light_button"); + + + + + procedure Finalize + (This : in out Light_Button) is + begin + Finalize (Button (This)); + if (This.Void_Ptr /= System.Null_Address) then + if This in Light_Button then + free_fl_light_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Light_Button is + begin + return This : Light_Button do + This.Void_Ptr := new_fl_light_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Buttons.Light; + diff --git a/src/fltk-widgets-buttons-light.ads b/src/fltk-widgets-buttons-light.ads new file mode 100644 index 0000000..6fe7a76 --- /dev/null +++ b/src/fltk-widgets-buttons-light.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Buttons.Light is + + + type Light_Button is new Button with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Light_Button; + + +private + + + type Light_Button is new Button with null record; + + + overriding procedure Finalize + (This : in out Light_Button); + + +end FLTK.Widgets.Buttons.Light; + diff --git a/src/fltk-widgets-buttons-radio.adb b/src/fltk-widgets-buttons-radio.adb new file mode 100644 index 0000000..d3fd405 --- /dev/null +++ b/src/fltk-widgets-buttons-radio.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Radio is + + + function new_fl_radio_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_radio_button, "new_fl_radio_button"); + + procedure free_fl_radio_button + (B : in System.Address); + pragma Import (C, free_fl_radio_button, "free_fl_radio_button"); + + + + + procedure Finalize + (This : in out Radio_Button) is + begin + Finalize (Button (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Radio_Button then + free_fl_radio_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Radio_Button is + begin + return This : Radio_Button do + This.Void_Ptr := new_fl_radio_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Buttons.Radio; + diff --git a/src/fltk-widgets-buttons-radio.ads b/src/fltk-widgets-buttons-radio.ads new file mode 100644 index 0000000..cf14eeb --- /dev/null +++ b/src/fltk-widgets-buttons-radio.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Buttons.Radio is + + + type Radio_Button is new Button with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Radio_Button; + + +private + + + type Radio_Button is new Button with null record; + + + overriding procedure Finalize + (This : in out Radio_Button); + + +end FLTK.Widgets.Buttons.Radio; + diff --git a/src/fltk-widgets-buttons-repeat.adb b/src/fltk-widgets-buttons-repeat.adb new file mode 100644 index 0000000..8e81a8e --- /dev/null +++ b/src/fltk-widgets-buttons-repeat.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Repeat is + + + function new_fl_repeat_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_repeat_button, "new_fl_repeat_button"); + + procedure free_fl_repeat_button + (B : in System.Address); + pragma Import (C, free_fl_repeat_button, "free_fl_repeat_button"); + + + + + procedure Finalize + (This : in out Repeat_Button) is + begin + Finalize (Button (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Repeat_Button then + free_fl_repeat_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Repeat_Button is + begin + return This : Repeat_Button do + This.Void_Ptr := new_fl_repeat_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Buttons.Repeat; + diff --git a/src/fltk-widgets-buttons-repeat.ads b/src/fltk-widgets-buttons-repeat.ads new file mode 100644 index 0000000..5c27b40 --- /dev/null +++ b/src/fltk-widgets-buttons-repeat.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Buttons.Repeat is + + + type Repeat_Button is new Button with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Repeat_Button; + + +private + + + type Repeat_Button is new Button with null record; + + + overriding procedure Finalize + (This : in out Repeat_Button); + + +end FLTK.Widgets.Buttons.Repeat; + diff --git a/src/fltk-widgets-buttons-toggle.adb b/src/fltk-widgets-buttons-toggle.adb new file mode 100644 index 0000000..9b8ce83 --- /dev/null +++ b/src/fltk-widgets-buttons-toggle.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Toggle is + + + function new_fl_toggle_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_toggle_button, "new_fl_toggle_button"); + + procedure free_fl_toggle_button + (B : in System.Address); + pragma Import (C, free_fl_toggle_button, "free_fl_toggle_button"); + + + + + procedure Finalize + (This : in out Toggle_Button) is + begin + Finalize (Button (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Toggle_Button then + free_fl_toggle_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Toggle_Button is + begin + return This : Toggle_Button do + This.Void_Ptr := new_fl_toggle_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Buttons.Toggle; + diff --git a/src/fltk-widgets-buttons-toggle.ads b/src/fltk-widgets-buttons-toggle.ads new file mode 100644 index 0000000..a8f4181 --- /dev/null +++ b/src/fltk-widgets-buttons-toggle.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Buttons.Toggle is + + + type Toggle_Button is new Button with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Toggle_Button; + + +private + + + type Toggle_Button is new Button with null record; + + + overriding procedure Finalize + (This : in out Toggle_Button); + + +end FLTK.Widgets.Buttons.Toggle; + diff --git a/src/fltk-widgets-buttons.adb b/src/fltk-widgets-buttons.adb new file mode 100644 index 0000000..bc79b9c --- /dev/null +++ b/src/fltk-widgets-buttons.adb @@ -0,0 +1,101 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons is + + + function new_fl_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_button, "new_fl_button"); + + procedure free_fl_button + (B : in System.Address); + pragma Import (C, free_fl_button, "free_fl_button"); + + function fl_button_get_state + (B : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_button_get_state, "fl_button_get_state"); + + procedure fl_button_set_state + (B : in System.Address; + S : in Interfaces.C.int); + pragma Import (C, fl_button_set_state, "fl_button_set_state"); + + procedure fl_button_set_only + (B : in System.Address); + pragma Import (C, fl_button_set_only, "fl_button_set_only"); + + + + + procedure Finalize + (This : in out Button) is + begin + Finalize (Widget (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Button then + free_fl_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Button is + begin + return This : Button do + This.Void_Ptr := new_fl_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + function Get_State + (This : in Button) + return State is + begin + return State'Val (fl_button_get_state (This.Void_Ptr)); + end Get_State; + + + + + procedure Set_State + (This : in out Button; + St : in State) is + begin + fl_button_set_state (This.Void_Ptr, State'Pos (St)); + end Set_State; + + + + + procedure Set_Only + (This : in out Button) is + begin + fl_button_set_only (This.Void_Ptr); + end Set_Only; + + +end FLTK.Widgets.Buttons; + diff --git a/src/fltk-widgets-buttons.ads b/src/fltk-widgets-buttons.ads new file mode 100644 index 0000000..403ad1a --- /dev/null +++ b/src/fltk-widgets-buttons.ads @@ -0,0 +1,43 @@ + + +package FLTK.Widgets.Buttons is + + + type Button is new Widget with private; + + + type State is (Off, On); + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Button; + + + function Get_State + (This : in Button) + return State; + + + procedure Set_State + (This : in out Button; + St : in State); + + + procedure Set_Only + (This : in out Button); + + +private + + + type Button is new Widget with null record; + + + overriding procedure Finalize + (This : in out Button); + + +end FLTK.Widgets.Buttons; + diff --git a/src/fltk-widgets-groups-text_displays-text_editors.adb b/src/fltk-widgets-groups-text_displays-text_editors.adb new file mode 100644 index 0000000..0172128 --- /dev/null +++ b/src/fltk-widgets-groups-text_displays-text_editors.adb @@ -0,0 +1,145 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is + + + function new_fl_text_editor + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_text_editor, "new_fl_text_editor"); + + procedure free_fl_text_editor + (TE : in System.Address); + pragma Import (C, free_fl_text_editor, "free_fl_text_editor"); + + procedure fl_text_editor_undo + (TE : in System.Address); + pragma Import (C, fl_text_editor_undo, "fl_text_editor_undo"); + + procedure fl_text_editor_cut + (TE : in System.Address); + pragma Import (C, fl_text_editor_cut, "fl_text_editor_cut"); + + procedure fl_text_editor_copy + (TE : in System.Address); + pragma Import (C, fl_text_editor_copy, "fl_text_editor_copy"); + + procedure fl_text_editor_paste + (TE : in System.Address); + pragma Import (C, fl_text_editor_paste, "fl_text_editor_paste"); + + procedure fl_text_editor_delete + (TE : in System.Address); + pragma Import (C, fl_text_editor_delete, "fl_text_editor_delete"); + + procedure fl_text_editor_remove_key_binding + (TE : in System.Address; + K : in Interfaces.C.unsigned; + M : in Interfaces.C.unsigned_long); + pragma Import (C, fl_text_editor_remove_key_binding, "fl_text_editor_remove_key_binding"); + + + + + procedure Finalize + (This : in out Text_Editor) is + begin + Finalize (Text_Display (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Text_Editor then + free_fl_text_editor (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Text_Editor is + begin + return This : Text_Editor do + This.Void_Ptr := new_fl_text_editor + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + procedure Undo + (This : in out Text_Editor) is + begin + fl_text_editor_undo (This.Void_Ptr); + end Undo; + + + + + procedure Cut + (This : in out Text_Editor) is + begin + fl_text_editor_cut (This.Void_Ptr); + end Cut; + + + + + procedure Copy + (This : in out Text_Editor) is + begin + fl_text_editor_copy (This.Void_Ptr); + end Copy; + + + + + procedure Paste + (This : in out Text_Editor) is + begin + fl_text_editor_paste (This.Void_Ptr); + end Paste; + + + + + procedure Delete + (This : in out Text_Editor) is + begin + fl_text_editor_delete (This.Void_Ptr); + end Delete; + + + + + procedure Remove_Key_Binding + (This : in out Text_Editor; + Key : in Shortcut_Key) + is + use type Interfaces.C.unsigned_long; + begin + fl_text_editor_remove_key_binding + (This.Void_Ptr, + Character'Pos (Key.Keypress), + Interfaces.C.unsigned_long (Key.Modifier) * 65536); + end Remove_Key_Binding; + + +end FLTK.Widgets.Groups.Text_Displays.Text_Editors; + diff --git a/src/fltk-widgets-groups-text_displays-text_editors.ads b/src/fltk-widgets-groups-text_displays-text_editors.ads new file mode 100644 index 0000000..d4c9b85 --- /dev/null +++ b/src/fltk-widgets-groups-text_displays-text_editors.ads @@ -0,0 +1,54 @@ + + +with FLTK.Enums; use FLTK.Enums; + + +package FLTK.Widgets.Groups.Text_Displays.Text_Editors is + + + type Text_Editor is new Text_Display with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Text_Editor; + + + procedure Undo + (This : in out Text_Editor); + + + procedure Cut + (This : in out Text_Editor); + + + procedure Copy + (This : in out Text_Editor); + + + procedure Paste + (This : in out Text_Editor); + + + procedure Delete + (This : in out Text_Editor); + + + procedure Remove_Key_Binding + (This : in out Text_Editor; + Key : in Shortcut_Key); + + +private + + + type Text_Editor is new Text_Display with null record; + + + overriding procedure Finalize + (This : in out Text_Editor); + + +end FLTK.Widgets.Groups.Text_Displays.Text_Editors; + diff --git a/src/fltk-widgets-groups-text_displays.adb b/src/fltk-widgets-groups-text_displays.adb new file mode 100644 index 0000000..1aa5962 --- /dev/null +++ b/src/fltk-widgets-groups-text_displays.adb @@ -0,0 +1,327 @@ + + +with Interfaces.C; +with System; +with FLTK.Text_Buffers; +use type System.Address; + + +package body FLTK.Widgets.Groups.Text_Displays is + + + function new_fl_text_display + (X, Y, W, H : in Interfaces.C.int; + Label : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_text_display, "new_fl_text_display"); + + procedure free_fl_text_display + (TD : in System.Address); + pragma Import (C, free_fl_text_display, "free_fl_text_display"); + + function fl_text_display_get_buffer + (TD : in System.Address) + return System.Address; + pragma Import (C, fl_text_display_get_buffer, "fl_text_display_get_buffer"); + + procedure fl_text_display_set_buffer + (TD, TB : in System.Address); + pragma Import (C, fl_text_display_set_buffer, "fl_text_display_set_buffer"); + + function fl_text_display_get_text_color + (TD : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_get_text_color, "fl_text_display_get_text_color"); + + procedure fl_text_display_set_text_color + (TD : in System.Address; + C : in Interfaces.C.int); + pragma Import (C, fl_text_display_set_text_color, "fl_text_display_set_text_color"); + + function fl_text_display_get_text_font + (TD : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_get_text_font, "fl_text_display_get_text_font"); + + procedure fl_text_display_set_text_font + (TD : in System.Address; + F : in Interfaces.C.int); + pragma Import (C, fl_text_display_set_text_font, "fl_text_display_set_text_font"); + + function fl_text_display_get_text_size + (TD : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_get_text_size, "fl_text_display_get_text_size"); + + procedure fl_text_display_set_text_size + (TD : in System.Address; + S : in Interfaces.C.int); + pragma Import (C, fl_text_display_set_text_size, "fl_text_display_set_text_size"); + + function fl_text_display_get_insert_pos + (TD : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_get_insert_pos, "fl_text_display_get_insert_pos"); + + procedure fl_text_display_set_insert_pos + (TD : in System.Address; + P : in Interfaces.C.int); + pragma Import (C, fl_text_display_set_insert_pos, "fl_text_display_set_insert_pos"); + + procedure fl_text_display_show_insert_pos + (TD : in System.Address); + pragma Import (C, fl_text_display_show_insert_pos, "fl_text_display_show_insert_pos"); + + procedure fl_text_display_next_word + (TD : in System.Address); + pragma Import (C, fl_text_display_next_word, "fl_text_display_next_word"); + + procedure fl_text_display_previous_word + (TD : in System.Address); + pragma Import (C, fl_text_display_previous_word, "fl_text_display_previous_word"); + + procedure fl_text_display_wrap_mode + (TD : in System.Address; + W, M : in Interfaces.C.int); + pragma Import (C, fl_text_display_wrap_mode, "fl_text_display_wrap_mode"); + + function fl_text_display_skip_lines + (TD : in System.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"); + + function fl_text_display_rewind_lines + (TD : in System.Address; + S, L : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_text_display_rewind_lines, "fl_text_display_rewind_lines"); + + procedure fl_text_display_linenumber_width + (TD : in System.Address; + W : in Interfaces.C.int); + pragma Import (C, fl_text_display_linenumber_width, "fl_text_display_linenumber_width"); + + + + + procedure Finalize + (This : in out Text_Display) is + begin + Finalize (Group (This)); + if (This.Void_Ptr /= System.Null_Address) then + if This in Text_Display then + free_fl_text_display (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + 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)); + fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + function Get_Buffer + (This : in Text_Display) + return FLTK.Text_Buffers.Text_Buffer_Cursor is + begin + return Ref : FLTK.Text_Buffers.Text_Buffer_Cursor (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); + end Set_Buffer; + + + + + 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.int (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; + + + + + 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; + + + + + 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 Skip_Lines + (This : in out 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 out 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; + + + + + procedure Set_Linenumber_Width + (This : in out Text_Display; + Width : in Natural) is + begin + fl_text_display_linenumber_width + (This.Void_Ptr, + Interfaces.C.int (Width)); + end Set_Linenumber_Width; + + +end FLTK.Widgets.Groups.Text_Displays; + diff --git a/src/fltk-widgets-groups-text_displays.ads b/src/fltk-widgets-groups-text_displays.ads new file mode 100644 index 0000000..0e136ff --- /dev/null +++ b/src/fltk-widgets-groups-text_displays.ads @@ -0,0 +1,124 @@ + + +with FLTK.Text_Buffers; +with FLTK.Enums; use FLTK.Enums; + + +package FLTK.Widgets.Groups.Text_Displays is + + + type Text_Display is new Group with private; + + + type Wrap_Mode is (Wrap_None, Wrap_At_Column, Wrap_At_Pixel, Wrap_At_Bounds); + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Text_Display; + + + function Get_Buffer + (This : in Text_Display) + return FLTK.Text_Buffers.Text_Buffer_Cursor; + + + procedure Set_Buffer + (This : in out Text_Display; + Buff : in out FLTK.Text_Buffers.Text_Buffer); + + + function Get_Text_Color + (This : in Text_Display) + return Color; + + + procedure Set_Text_Color + (This : in out Text_Display; + Col : in Color); + + + function Get_Text_Font + (This : in Text_Display) + return Font_Kind; + + + procedure Set_Text_Font + (This : in out Text_Display; + Font : in Font_Kind); + + + function Get_Text_Size + (This : in Text_Display) + return Font_Size; + + + procedure Set_Text_Size + (This : in out Text_Display; + Size : in Font_Size); + + + function Get_Insert_Position + (This : in Text_Display) + return Natural; + + + procedure Set_Insert_Position + (This : in out Text_Display; + Pos : in Natural); + + + procedure Show_Insert_Position + (This : in out Text_Display); + + + procedure Next_Word + (This : in out Text_Display); + + + procedure Previous_Word + (This : in out Text_Display); + + + procedure Set_Wrap_Mode + (This : in out Text_Display; + Mode : in Wrap_Mode; + Margin : in Natural := 0); + + + -- takes into account word wrap as well as newline characters + function Skip_Lines + (This : in out Text_Display; + Start, Lines : in Natural; + Start_Pos_Is_Line_Start : in Boolean := False) + return Natural; + + + -- takes into account word wrap as well as newline characters + function Rewind_Lines + (This : in out Text_Display; + Start, Lines : in Natural) + return Natural; + + + procedure Set_Linenumber_Width + (This : in out Text_Display; + Width : in Natural); + + +private + + + type Text_Display is new Group with + record + Buffer : access FLTK.Text_Buffers.Text_Buffer; + end record; + + + overriding procedure Finalize + (This : in out Text_Display); + + +end FLTK.Widgets.Groups.Text_Displays; + diff --git a/src/fltk-widgets-groups-windows-double.adb b/src/fltk-widgets-groups-windows-double.adb new file mode 100644 index 0000000..407c018 --- /dev/null +++ b/src/fltk-widgets-groups-windows-double.adb @@ -0,0 +1,108 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Groups.Windows.Double is + + + function new_fl_double_window + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_double_window, "new_fl_double_window"); + + function new_fl_double_window2 + (X, Y : in Interfaces.C.int) + return System.Address; + pragma Import (C, new_fl_double_window2, "new_fl_double_window2"); + + procedure free_fl_double_window + (W : in System.Address); + pragma Import (C, free_fl_double_window, "free_fl_double_window"); + + procedure fl_double_window_show + (W : in System.Address); + pragma Import (C, fl_double_window_show, "fl_double_window_show"); + + procedure fl_double_window_hide + (W : in System.Address); + pragma Import (C, fl_double_window_hide, "fl_double_window_hide"); + + + + + procedure Finalize + (This : in out Double_Window) is + begin + Finalize (Window (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Double_Window then + free_fl_double_window (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Double_Window is + begin + return This : Double_Window do + This.Void_Ptr := new_fl_double_window + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + function Create + (W, H : in Integer) + return Double_Window is + begin + return This : Double_Window do + This.Void_Ptr := new_fl_double_window2 + (Interfaces.C.int (W), + Interfaces.C.int (H)); + fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + procedure Show + (This : in Double_Window) is + begin + fl_double_window_show (This.Void_Ptr); + end Show; + + + + + procedure Hide + (This : in Double_Window) is + begin + fl_double_window_hide (This.Void_Ptr); + end Hide; + + +end FLTK.Widgets.Groups.Windows.Double; + diff --git a/src/fltk-widgets-groups-windows-double.ads b/src/fltk-widgets-groups-windows-double.ads new file mode 100644 index 0000000..214f698 --- /dev/null +++ b/src/fltk-widgets-groups-windows-double.ads @@ -0,0 +1,39 @@ + + +package FLTK.Widgets.Groups.Windows.Double is + + + type Double_Window is new Window with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Double_Window; + + + function Create + (W, H : in Integer) + return Double_Window; + + + procedure Show + (This : in Double_Window); + + + procedure Hide + (This : in Double_Window); + + +private + + + type Double_Window is new Window with null record; + + + overriding procedure Finalize + (This : in out Double_Window); + + +end FLTK.Widgets.Groups.Windows.Double; + diff --git a/src/fltk-widgets-groups-windows-single-menu.adb b/src/fltk-widgets-groups-windows-single-menu.adb new file mode 100644 index 0000000..8345308 --- /dev/null +++ b/src/fltk-widgets-groups-windows-single-menu.adb @@ -0,0 +1,158 @@ + + +with Interfaces.C; +with System; +use type System.Address; +use type Interfaces.C.unsigned; + + +package body FLTK.Widgets.Groups.Windows.Single.Menu is + + + function new_fl_menu_window + (X, Y, W, H : in Interfaces.C.int; + Label : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_menu_window, "new_fl_menu_window"); + + function new_fl_menu_window2 + (W, H : in Interfaces.C.int) + return System.Address; + pragma Import (C, new_fl_menu_window2, "new_fl_menu_window2"); + + procedure free_fl_menu_window + (M : in System.Address); + pragma Import (C, free_fl_menu_window, "free_fl_menu_window"); + + procedure fl_menu_window_show + (M : in System.Address); + pragma Import (C, fl_menu_window_show, "fl_menu_window_show"); + + procedure fl_menu_window_hide + (M : in System.Address); + pragma Import (C, fl_menu_window_hide, "fl_menu_window_hide"); + + procedure fl_menu_window_flush + (M : in System.Address); + pragma Import (C, fl_menu_window_flush, "fl_menu_window_flush"); + + procedure fl_menu_window_set_overlay + (M : in System.Address); + pragma Import (C, fl_menu_window_set_overlay, "fl_menu_window_set_overlay"); + + procedure fl_menu_window_clear_overlay + (M : in System.Address); + pragma Import (C, fl_menu_window_clear_overlay, "fl_menu_window_clear_overlay"); + + function fl_menu_window_overlay + (M : in System.Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_menu_window_overlay, "fl_menu_window_overlay"); + + + + + procedure Finalize + (This : in out Menu_Window) is + begin + Finalize (Single_Window (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Menu_Window then + free_fl_menu_window (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Menu_Window is + begin + return This : Menu_Window do + This.Void_Ptr := new_fl_menu_window + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + function Create + (W, H : in Integer) + return Menu_Window is + begin + return This : Menu_Window do + This.Void_Ptr := new_fl_menu_window2 + (Interfaces.C.int (W), + Interfaces.C.int (H)); + fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + procedure Show + (This : in Menu_Window) is + begin + fl_menu_window_show (This.Void_Ptr); + end Show; + + + + + procedure Hide + (This : in Menu_Window) is + begin + fl_menu_window_hide (This.Void_Ptr); + end Hide; + + + + + procedure Flush + (This : in out Menu_Window) is + begin + fl_menu_window_flush (This.Void_Ptr); + end Flush; + + + + + function Get_Overlay + (This : in Menu_Window) + return Boolean is + begin + return fl_menu_window_overlay (This.Void_Ptr) /= 0; + end Get_Overlay; + + + + procedure Set_Overlay + (This : in out Menu_Window; + Value : in Boolean) is + begin + if Value then + fl_menu_window_set_overlay (This.Void_Ptr); + else + fl_menu_window_clear_overlay (This.Void_Ptr); + end if; + end Set_Overlay; + + +end FLTK.Widgets.Groups.Windows.Single.Menu; + diff --git a/src/fltk-widgets-groups-windows-single-menu.ads b/src/fltk-widgets-groups-windows-single-menu.ads new file mode 100644 index 0000000..f5d88e7 --- /dev/null +++ b/src/fltk-widgets-groups-windows-single-menu.ads @@ -0,0 +1,53 @@ + + +package FLTK.Widgets.Groups.Windows.Single.Menu is + + + type Menu_Window is new Single_Window with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Menu_Window; + + + function Create + (W, H : in Integer) + return Menu_Window; + + + procedure Show + (This : in Menu_Window); + + + procedure Hide + (This : in Menu_Window); + + + procedure Flush + (This : in out Menu_Window); + + + function Get_Overlay + (This : in Menu_Window) + return Boolean; + + + procedure Set_Overlay + (This : in out Menu_Window; + Value : in Boolean); + + +private + + + type Menu_Window is new Single_Window with null record; + + + overriding procedure Finalize + (This : in out Menu_Window); + + +end FLTK.Widgets.Groups.Windows.Single.Menu; + diff --git a/src/fltk-widgets-groups-windows-single.adb b/src/fltk-widgets-groups-windows-single.adb new file mode 100644 index 0000000..16c5f44 --- /dev/null +++ b/src/fltk-widgets-groups-windows-single.adb @@ -0,0 +1,108 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Groups.Windows.Single is + + + function new_fl_single_window + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_single_window, "new_fl_single_window"); + + function new_fl_single_window2 + (W, H : in Interfaces.C.int) + return System.Address; + pragma Import (C, new_fl_single_window2, "new_fl_single_window2"); + + procedure free_fl_single_window + (S : in System.Address); + pragma Import (C, free_fl_single_window, "free_fl_single_window"); + + procedure fl_single_window_show + (S : in System.Address); + pragma Import (C, fl_single_window_show, "fl_single_window_show"); + + procedure fl_single_window_flush + (S : in System.Address); + pragma Import (C, fl_single_window_flush, "fl_single_window_flush"); + + + + + procedure Finalize + (This : in out Single_Window) is + begin + Finalize (Window (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Single_Window then + free_fl_single_window (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Single_Window is + begin + return This : Single_Window do + This.Void_Ptr := new_fl_single_window + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + function Create + (W, H : in Integer) + return Single_Window is + begin + return This : Single_Window do + This.Void_Ptr := new_fl_single_window2 + (Interfaces.C.int (W), + Interfaces.C.int (H)); + fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + procedure Show + (This : in Single_Window) is + begin + fl_single_window_show (This.Void_Ptr); + end Show; + + + + + procedure Flush + (This : in out Single_Window) is + begin + fl_single_window_flush (This.Void_Ptr); + end Flush; + + +end FLTK.Widgets.Groups.Windows.Single; + diff --git a/src/fltk-widgets-groups-windows-single.ads b/src/fltk-widgets-groups-windows-single.ads new file mode 100644 index 0000000..07a2bca --- /dev/null +++ b/src/fltk-widgets-groups-windows-single.ads @@ -0,0 +1,39 @@ + + +package FLTK.Widgets.Groups.Windows.Single is + + + type Single_Window is new Window with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Single_Window; + + + function Create + (W, H : in Integer) + return Single_Window; + + + procedure Show + (This : in Single_Window); + + + procedure Flush + (This : in out Single_Window); + + +private + + + type Single_Window is new Window with null record; + + + overriding procedure Finalize + (This : in out Single_Window); + + +end FLTK.Widgets.Groups.Windows.Single; + diff --git a/src/fltk-widgets-groups-windows.adb b/src/fltk-widgets-groups-windows.adb new file mode 100644 index 0000000..2d93bdd --- /dev/null +++ b/src/fltk-widgets-groups-windows.adb @@ -0,0 +1,191 @@ + + +with Interfaces.C; +with System; +with FLTK.Images.RGB; +use type System.Address; + + +package body FLTK.Widgets.Groups.Windows is + + + function new_fl_window + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_window, "new_fl_window"); + + function new_fl_window2 + (W, H : in Interfaces.C.int) + return System.Address; + pragma Import (C, new_fl_window2, "new_fl_window2"); + + procedure free_fl_window + (W : in System.Address); + pragma Import (C, free_fl_window, "free_fl_window"); + + procedure fl_window_show + (W : in System.Address); + pragma Import (C, fl_window_show, "fl_window_show"); + + procedure fl_window_hide + (W : in System.Address); + pragma Import (C, fl_window_hide, "fl_window_hide"); + + procedure fl_window_set_label + (W : in System.Address; + T : in Interfaces.C.char_array); + pragma Import (C, fl_window_set_label, "fl_window_set_label"); + + procedure fl_window_size_range + (W : in System.Address; + LW, LH, HW, HH, DW, DH, A : in Interfaces.C.int); + pragma Import (C, fl_window_size_range, "fl_window_size_range"); + + procedure fl_window_set_icon + (W, P : in System.Address); + pragma Import (C, fl_window_set_icon, "fl_window_set_icon"); + + procedure fl_window_set_modal + (W : in System.Address); + pragma Import (C, fl_window_set_modal, "fl_window_set_modal"); + + procedure fl_window_set_non_modal + (W : in System.Address); + pragma Import (C, fl_window_set_non_modal, "fl_window_set_non_modal"); + + + + + procedure Finalize + (This : in out Window) is + begin + Finalize (Group (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Window then + free_fl_window (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Window is + begin + return This : Window do + This.Void_Ptr := new_fl_window + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + function Create + (W, H : in Integer) + return Window is + begin + return This : Window do + This.Void_Ptr := new_fl_window2 + (Interfaces.C.int (W), + Interfaces.C.int (H)); + fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + procedure Show + (This : in Window) is + begin + fl_window_show (This.Void_Ptr); + end Show; + + + + + procedure Hide + (This : in Window) is + begin + fl_window_hide (This.Void_Ptr); + end Hide; + + + + + procedure Set_Label + (This : in out Window; + Text : in String) is + begin + fl_window_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); + end Set_Label; + + + + + procedure Set_Size_Range + (This : in out Window; + Min_W, Min_H : in Integer; + Max_W, Max_H, Incre_W, Incre_H : in Integer := 0; + Keep_Aspect : in Boolean := False) is + begin + fl_window_size_range + (This.Void_Ptr, + Interfaces.C.int (Min_W), + Interfaces.C.int (Min_H), + Interfaces.C.int (Max_W), + Interfaces.C.int (Max_H), + Interfaces.C.int (Incre_W), + Interfaces.C.int (Incre_H), + Boolean'Pos (Keep_Aspect)); + end Set_Size_Range; + + + + + procedure Set_Icon + (This : in out Window; + Pic : in out FLTK.Images.RGB.RGB_Image'Class) is + begin + fl_window_set_icon + (This.Void_Ptr, + Wrapper (Pic).Void_Ptr); + end Set_Icon; + + + + + procedure Set_Modal + (This : in out Window) is + begin + fl_window_set_modal (This.Void_Ptr); + end Set_Modal; + + + + + procedure Set_Non_Modal + (This : in out Window) is + begin + fl_window_set_non_modal (This.Void_Ptr); + end Set_Non_Modal; + + +end FLTK.Widgets.Groups.Windows; + diff --git a/src/fltk-widgets-groups-windows.ads b/src/fltk-widgets-groups-windows.ads new file mode 100644 index 0000000..96047ee --- /dev/null +++ b/src/fltk-widgets-groups-windows.ads @@ -0,0 +1,67 @@ + + +with FLTK.Images.RGB; + + +package FLTK.Widgets.Groups.Windows is + + + type Window is new Group with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Window; + + + function Create + (W, H : in Integer) + return Window; + + + procedure Show + (This : in Window); + + + procedure Hide + (This : in Window); + + + procedure Set_Label + (This : in out Window; + Text : in String); + + + procedure Set_Size_Range + (This : in out Window; + Min_W, Min_H : in Integer; + Max_W, Max_H, Incre_W, Incre_H : in Integer := 0; + Keep_Aspect : in Boolean := False); + + + procedure Set_Icon + (This : in out Window; + Pic : in out FLTK.Images.RGB.RGB_Image'Class); + + + procedure Set_Modal + (This : in out Window); + + + procedure Set_Non_Modal + (This : in out Window); + + +private + + + type Window is new Group with null record; + + + overriding procedure Finalize + (This : in out Window); + + +end FLTK.Widgets.Groups.Windows; + diff --git a/src/fltk-widgets-groups.adb b/src/fltk-widgets-groups.adb new file mode 100644 index 0000000..067407d --- /dev/null +++ b/src/fltk-widgets-groups.adb @@ -0,0 +1,202 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Groups is + + + function new_fl_group + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_group, "new_fl_group"); + + procedure free_fl_group + (G : in System.Address); + pragma Import (C, free_fl_group, "free_fl_group"); + + procedure fl_group_add + (G, W : in System.Address); + pragma Import (C, fl_group_add, "fl_group_add"); + + function fl_group_find + (G, W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_group_find, "fl_group_find"); + + procedure fl_group_insert + (G, W : in System.Address; + P : in Interfaces.C.int); + pragma Import (C, fl_group_insert, "fl_group_insert"); + + procedure fl_group_remove + (G, W : in System.Address); + pragma Import (C, fl_group_remove, "fl_group_remove"); + + procedure fl_group_remove2 + (G : in System.Address; + P : in Interfaces.C.int); + pragma Import (C, fl_group_remove2, "fl_group_remove2"); + + function fl_group_children + (G : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_group_children, "fl_group_children"); + + function fl_group_child + (G : in System.Address; + I : in Interfaces.C.int) + return System.Address; + pragma Import (C, fl_group_child, "fl_group_child"); + + procedure fl_group_resizable + (G, W : in System.Address); + pragma Import (C, fl_group_resizable, "fl_group_resizable"); + + + + + procedure Finalize + (This : in out Group) is + begin + Finalize (Widget (This)); + if This.Void_Ptr /= System.Null_Address then + This.Clear; + if This in Group then + free_fl_group (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Group is + begin + return This : Group do + This.Void_Ptr := new_fl_group + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_group_end (This.Void_Ptr); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + procedure Add + (This : in out Group; + Item : in out Widget'Class) is + begin + fl_group_add (This.Void_Ptr, Item.Void_Ptr); + end Add; + + + + + function Child + (This : in Group; + Place : in Index) + return access Widget'Class + is + Widget_Ptr : System.Address := + fl_group_child (This.Void_Ptr, Interfaces.C.int (Place - 1)); + + Actual_Widget : access Widget'Class := + Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); + begin + return Actual_Widget; + end Child; + + + + + function Number_Of_Children + (This : in Group) + return Natural is + begin + return Natural (fl_group_children (This.Void_Ptr)); + end Number_Of_Children; + + + + + procedure Clear + (This : in out Group) is + begin + for I in reverse 1 .. This.Number_Of_Children loop + This.Remove (Index (I)); + end loop; + end Clear; + + + + + function Find + (This : in Group; + Item : in out Widget'Class) + return Index is + begin + -- should set this up to throw an exception if not found + return Index (fl_group_find (This.Void_Ptr, Item.Void_Ptr)); + end Find; + + + + + procedure Insert + (This : in out Group; + Item : in out Widget'Class; + Place : in Index) is + begin + fl_group_insert + (This.Void_Ptr, + Item.Void_Ptr, + Interfaces.C.int (Place)); + end Insert; + + + + + procedure Remove + (This : in out Group; + Item : in out Widget'Class) is + begin + fl_group_remove (This.Void_Ptr, Item.Void_Ptr); + end Remove; + + + + + procedure Remove + (This : in out Group; + Place : in Index) is + begin + fl_group_remove2 (This.Void_Ptr, Interfaces.C.int (Place)); + end Remove; + + + + + procedure Set_Resizable + (This : in out Group; + Item : in Widget'Class) is + begin + fl_group_resizable (This.Void_Ptr, Item.Void_Ptr); + end Set_Resizable; + + +end FLTK.Widgets.Groups; + diff --git a/src/fltk-widgets-groups.ads b/src/fltk-widgets-groups.ads new file mode 100644 index 0000000..57faf87 --- /dev/null +++ b/src/fltk-widgets-groups.ads @@ -0,0 +1,82 @@ + + +private with System; + + +package FLTK.Widgets.Groups is + + + type Group is new Widget with private; + type Index is new Positive; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Group; + + + procedure Add + (This : in out Group; + Item : in out Widget'Class); + + + function Child + (This : in Group; + Place : in Index) + return access Widget'Class; + + + function Number_Of_Children + (This : in Group) + return Natural; + + + procedure Clear + (This : in out Group); + + + function Find + (This : in Group; + Item : in out Widget'Class) + return Index; + + + procedure Insert + (This : in out Group; + Item : in out Widget'Class; + Place : in Index); + + + procedure Remove + (This : in out Group; + Item : in out Widget'Class); + + + procedure Remove + (This : in out Group; + Place : in Index); + + + procedure Set_Resizable + (This : in out Group; + Item : in Widget'Class); + + +private + + + type Group is new Widget with null record; + + + overriding procedure Finalize + (This : in out Group); + + + procedure fl_group_end + (G : in System.Address); + pragma Import (C, fl_group_end, "fl_group_end"); + + +end FLTK.Widgets.Groups; + diff --git a/src/fltk-widgets-inputs-int.adb b/src/fltk-widgets-inputs-int.adb new file mode 100644 index 0000000..30f3d01 --- /dev/null +++ b/src/fltk-widgets-inputs-int.adb @@ -0,0 +1,75 @@ + + +with Interfaces.C.Strings; +with System; +use type System.Address; + + +package body FLTK.Widgets.Inputs.Int is + + + function new_fl_int_input + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_int_input, "new_fl_int_input"); + + procedure free_fl_int_input + (F : in System.Address); + pragma Import (C, free_fl_int_input, "free_fl_int_input"); + + function fl_int_input_get_value + (F : in System.Address) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_int_input_get_value, "fl_int_input_get_value"); + + + + + procedure Finalize + (This : in out Integer_Input) is + begin + Finalize (Input (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Integer_Input then + free_fl_int_input (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Integer_Input is + begin + return This : Integer_Input do + This.Void_Ptr := new_fl_int_input + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + function Get_Value + (This : in Integer_Input) + return Integer is + begin + return Integer'Value + (Interfaces.C.Strings.Value + (fl_int_input_get_value (This.Void_Ptr))); + end Get_Value; + + +end FLTK.Widgets.Inputs.Int; + diff --git a/src/fltk-widgets-inputs-int.ads b/src/fltk-widgets-inputs-int.ads new file mode 100644 index 0000000..2777f54 --- /dev/null +++ b/src/fltk-widgets-inputs-int.ads @@ -0,0 +1,31 @@ + + +package FLTK.Widgets.Inputs.Int is + + + type Integer_Input is new Input with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Integer_Input; + + + function Get_Value + (This : in Integer_Input) + return Integer; + + +private + + + type Integer_Input is new Input with null record; + + + overriding procedure Finalize + (This : in out Integer_Input); + + +end FLTK.Widgets.Inputs.Int; + diff --git a/src/fltk-widgets-inputs.adb b/src/fltk-widgets-inputs.adb new file mode 100644 index 0000000..9af8e87 --- /dev/null +++ b/src/fltk-widgets-inputs.adb @@ -0,0 +1,74 @@ + + +with Interfaces.C; +with Interfaces.C.Strings; +with System; +use type System.Address; + + +package body FLTK.Widgets.Inputs is + + + function new_fl_input + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_input, "new_fl_input"); + + procedure free_fl_input + (F : in System.Address); + pragma Import (C, free_fl_input, "free_fl_input"); + + function fl_input_get_value + (F : in System.Address) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_input_get_value, "fl_input_get_value"); + + + + + procedure Finalize + (This : in out Input) is + begin + Finalize (Widget (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Input then + free_fl_input (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Input is + begin + return This : Input do + This.Void_Ptr := new_fl_input + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + function Get_Value + (This : in Input) + return String is + begin + return Interfaces.C.Strings.Value (fl_input_get_value (This.Void_Ptr)); + end Get_Value; + + +end FLTK.Widgets.Inputs; + diff --git a/src/fltk-widgets-inputs.ads b/src/fltk-widgets-inputs.ads new file mode 100644 index 0000000..0f818ac --- /dev/null +++ b/src/fltk-widgets-inputs.ads @@ -0,0 +1,31 @@ + + +package FLTK.Widgets.Inputs is + + + type Input is new Widget with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Input; + + + function Get_Value + (This : in Input) + return String; + + +private + + + type Input is new Widget with null record; + + + overriding procedure Finalize + (This : in out Input); + + +end FLTK.Widgets.Inputs; + diff --git a/src/fltk-widgets-menus-menu_bars.adb b/src/fltk-widgets-menus-menu_bars.adb new file mode 100644 index 0000000..19d44e0 --- /dev/null +++ b/src/fltk-widgets-menus-menu_bars.adb @@ -0,0 +1,58 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Menus.Menu_Bars is + + + function new_fl_menu_bar + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_menu_bar, "new_fl_menu_bar"); + + procedure free_fl_menu_bar + (M : in System.Address); + pragma Import (C, free_fl_menu_bar, "free_fl_menu_bar"); + + + + + procedure Finalize + (This : in out Menu_Bar) is + begin + Finalize (Menu (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Menu_Bar then + free_fl_menu_bar (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Menu_Bar is + begin + return This : Menu_Bar do + This.Void_Ptr := new_fl_menu_bar + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + +end FLTK.Widgets.Menus.Menu_Bars; + diff --git a/src/fltk-widgets-menus-menu_bars.ads b/src/fltk-widgets-menus-menu_bars.ads new file mode 100644 index 0000000..0f975b3 --- /dev/null +++ b/src/fltk-widgets-menus-menu_bars.ads @@ -0,0 +1,26 @@ + + +package FLTK.Widgets.Menus.Menu_Bars is + + + type Menu_Bar is new Menu with private; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Menu_Bar; + + +private + + + type Menu_Bar is new Menu with null record; + + + overriding procedure Finalize + (This : in out Menu_Bar); + + +end FLTK.Widgets.Menus.Menu_Bars; + diff --git a/src/fltk-widgets-menus-menu_buttons.adb b/src/fltk-widgets-menus-menu_buttons.adb new file mode 100644 index 0000000..8347099 --- /dev/null +++ b/src/fltk-widgets-menus-menu_buttons.adb @@ -0,0 +1,73 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Menus.Menu_Buttons is + + + function new_fl_menu_button + (X, Y, W, H : in Interfaces.C.int; + Text : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_menu_button, "new_fl_menu_button"); + + procedure free_fl_menu_button + (M : in System.Address); + pragma Import (C, free_fl_menu_button, "free_fl_menu_button"); + + procedure fl_menu_button_type + (M : in System.Address; + T : in Interfaces.C.unsigned); + pragma Import (C, fl_menu_button_type, "fl_menu_button_type"); + + + + + procedure Finalize + (This : in out Menu_Button) is + begin + Finalize (Menu (This)); + if This.Void_Ptr /= System.Null_Address then + if This in Menu_Button then + free_fl_menu_button (This.Void_Ptr); + end if; + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Menu_Button is + begin + return This : Menu_Button do + This.Void_Ptr := new_fl_menu_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Text)); + fl_widget_set_user_data + (This.Void_Ptr, + Widget_Convert.To_Address (This'Unchecked_Access)); + end return; + end Create; + + + + + procedure Set_Popup_Kind + (This : in out Menu_Button; + Pop : in Popup_Buttons) is + begin + fl_menu_button_type (This.Void_Ptr, Popup_Buttons'Pos (Pop)); + end Set_Popup_Kind; + + +end FLTK.Widgets.Menus.Menu_Buttons; + diff --git a/src/fltk-widgets-menus-menu_buttons.ads b/src/fltk-widgets-menus-menu_buttons.ads new file mode 100644 index 0000000..5527abc --- /dev/null +++ b/src/fltk-widgets-menus-menu_buttons.ads @@ -0,0 +1,35 @@ + + +package FLTK.Widgets.Menus.Menu_Buttons is + + + type Menu_Button is new Menu with private; + + + -- signifies which mouse buttons cause the menu to appear + type Popup_Buttons is (No_Popup, Popup1, Popup2, Popup12, Popup3, Popup13, Popup23, Popup123); + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Menu_Button; + + + procedure Set_Popup_Kind + (This : in out Menu_Button; + Pop : in Popup_Buttons); + + +private + + + type Menu_Button is new Menu with null record; + + + overriding procedure Finalize + (This : in out Menu_Button); + + +end FLTK.Widgets.Menus.Menu_Buttons; + diff --git a/src/fltk-widgets-menus.adb b/src/fltk-widgets-menus.adb new file mode 100644 index 0000000..b92f0a1 --- /dev/null +++ b/src/fltk-widgets-menus.adb @@ -0,0 +1,160 @@ + + +with FLTK.Enums; use FLTK.Enums; +with Interfaces.C; +with System; +use type System.Address; +use type Interfaces.C.int; +use type Interfaces.C.unsigned_long; + + +package body FLTK.Widgets.Menus is + + + function "+" + (Left, Right : in Menu_Flag) + return Menu_Flag is + begin + return Left or Right; + end "+"; + + + + + function fl_menu_add + (M : in System.Address; + T : in Interfaces.C.char_array; + S : in Interfaces.C.unsigned_long; + C, U : in System.Address; + F : in Interfaces.C.unsigned_long) + return Interfaces.C.int; + pragma Import (C, fl_menu_add, "fl_menu_add"); + + function fl_menu_find_item + (M : in System.Address; + T : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, fl_menu_find_item, "fl_menu_find_item"); + + function fl_menu_mvalue + (M : in System.Address) + return System.Address; + pragma Import (C, fl_menu_mvalue, "fl_menu_mvalue"); + + function fl_menuitem_value + (MI : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_menuitem_value, "fl_menuitem_value"); + + procedure fl_menuitem_activate + (MI : in System.Address); + pragma Import (C, fl_menuitem_activate, "fl_menuitem_activate"); + + procedure fl_menuitem_deactivate + (MI : in System.Address); + pragma Import (C, fl_menuitem_deactivate, "fl_menuitem_deactivate"); + + + + + procedure Item_Hook (M, U : in System.Address); + pragma Convention (C, Item_Hook); + + procedure Item_Hook + (M, U : in System.Address) + is + Ada_Widget : access Widget'Class := + Widget_Convert.To_Pointer (fl_widget_get_user_data (M)); + Action : Widget_Callback := Callback_Convert.To_Pointer (U); + begin + Action.all (Ada_Widget.all); + end Item_Hook; + + + + + procedure Add + (This : in out Menu; + Text : in String; + Action : in Widget_Callback := null; + Shortcut : in Shortcut_Key := No_Key; + Flags : in Menu_Flag := Flag_Normal) + is + Place : Interfaces.C.int; + Callback, User_Data : System.Address; + begin + if Action = null then + Callback := System.Null_Address; + User_Data := System.Null_Address; + else + Callback := Item_Hook'Address; + User_Data := Callback_Convert.To_Address (Action); + end if; + + Place := fl_menu_add + (This.Void_Ptr, + Interfaces.C.To_C (Text), + Key_To_C (Shortcut), + Callback, + User_Data, + Interfaces.C.unsigned_long (Flags)); + end Add; + + + + + function Find_Item + (This : in Menu'Class; + Name : in String) + return Menu_Item is + begin + return Item : Menu_Item do + Item.Void_Ptr := fl_menu_find_item + (This.Void_Ptr, + Interfaces.C.To_C (Name)); + end return; + end Find_Item; + + + + + function Chosen + (This : in Menu'Class) + return Menu_Item is + begin + return Item : Menu_Item do + Item.Void_Ptr := fl_menu_mvalue (This.Void_Ptr); + end return; + end Chosen; + + + + + function Value + (Item : in Menu_Item) + return Boolean is + begin + return fl_menuitem_value (Item.Void_Ptr) /= 0; + end Value; + + + + + procedure Activate + (Item : in Menu_Item) is + begin + fl_menuitem_activate (Item.Void_Ptr); + end Activate; + + + + + procedure Deactivate + (Item : in Menu_Item) is + begin + fl_menuitem_deactivate (Item.Void_Ptr); + end Deactivate; + + +end FLTK.Widgets.Menus; + diff --git a/src/fltk-widgets-menus.ads b/src/fltk-widgets-menus.ads new file mode 100644 index 0000000..d01f02e --- /dev/null +++ b/src/fltk-widgets-menus.ads @@ -0,0 +1,97 @@ + + +with FLTK.Enums; use FLTK.Enums; +private with Interfaces; +private with System; + + +package FLTK.Widgets.Menus is + + + type Menu is abstract new Widget with private; + type Menu_Cursor (Data : access Menu'Class) is limited null record + with Implicit_Dereference => Data; + + + type Menu_Item is tagged limited private; + + + type Index is new Positive; + + + type Menu_Flag is private; + function "+" (Left, Right : in Menu_Flag) return Menu_Flag; + Flag_Normal : constant Menu_Flag; + Flag_Inactive : constant Menu_Flag; + Flag_Toggle : constant Menu_Flag; + Flag_Value : constant Menu_Flag; + Flag_Radio : constant Menu_Flag; + Flag_Invisible : constant Menu_Flag; + Flag_Submenu : constant Menu_Flag; + Flag_Divider : constant Menu_Flag; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Menu is abstract; + + + procedure Add + (This : in out Menu; + Text : in String; + Action : in Widget_Callback := null; + Shortcut : in Shortcut_Key := No_Key; + Flags : in Menu_Flag := Flag_Normal); + + + function Find_Item + (This : in Menu'Class; + Name : in String) + return Menu_Item; + + + function Chosen + (This : in Menu'Class) + return Menu_Item; + + + function Value + (Item : in Menu_Item) + return Boolean; + + + procedure Activate + (Item : in Menu_Item); + + + procedure Deactivate + (Item : in Menu_Item); + + +private + + + type Menu is abstract new Widget with null record; + + + type Menu_Item is tagged limited + record + Void_Ptr : System.Address; + end record; + + + type Menu_Flag is new Interfaces.Unsigned_8; + Flag_Normal : constant Menu_Flag := 2#00000000#; + Flag_Inactive : constant Menu_Flag := 2#00000001#; + Flag_Toggle : constant Menu_Flag := 2#00000010#; + Flag_Value : constant Menu_Flag := 2#00000100#; + Flag_Radio : constant Menu_Flag := 2#00001000#; + Flag_Invisible : constant Menu_Flag := 2#00010000#; + -- Flag_Submenu_Pointer unlikely to be used + Flag_Submenu : constant Menu_Flag := 2#01000000#; + Flag_Divider : constant Menu_Flag := 2#10000000#; + + +end FLTK.Widgets.Menus; + diff --git a/src/fltk-widgets.adb b/src/fltk-widgets.adb new file mode 100644 index 0000000..9ec2350 --- /dev/null +++ b/src/fltk-widgets.adb @@ -0,0 +1,352 @@ + + +with Interfaces.C; +with Interfaces.C.Strings; +with System; +with System.Address_To_Access_Conversions; +with FLTK.Widgets.Groups; +with FLTK.Images; +use type System.Address; + + +package body FLTK.Widgets is + + + package Group_Convert is new + System.Address_To_Access_Conversions (FLTK.Widgets.Groups.Group'Class); + + + + + function fl_widget_get_box + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_box, "fl_widget_get_box"); + + procedure fl_widget_set_box + (W : in System.Address; + B : in Interfaces.C.int); + pragma Import (C, fl_widget_set_box, "fl_widget_set_box"); + + function fl_widget_get_label + (W : in System.Address) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, fl_widget_get_label, "fl_widget_get_label"); + + procedure fl_widget_set_label + (W : in System.Address; + T : in Interfaces.C.char_array); + pragma Import (C, fl_widget_set_label, "fl_widget_set_label"); + + function fl_widget_get_label_font + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_label_font, "fl_widget_get_label_font"); + + procedure fl_widget_set_label_font + (W : in System.Address; + F : in Interfaces.C.int); + pragma Import (C, fl_widget_set_label_font, "fl_widget_set_label_font"); + + function fl_widget_get_label_size + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_label_size, "fl_widget_get_label_size"); + + procedure fl_widget_set_label_size + (W : in System.Address; + S : in Interfaces.C.int); + pragma Import (C, fl_widget_set_label_size, "fl_widget_set_label_size"); + + function fl_widget_get_label_type + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_label_type, "fl_widget_get_label_type"); + + procedure fl_widget_set_label_type + (W : in System.Address; + L : in Interfaces.C.int); + pragma Import (C, fl_widget_set_label_type, "fl_widget_set_label_type"); + + function fl_widget_get_parent + (W : in System.Address) + return System.Address; + pragma Import (C, fl_widget_get_parent, "fl_widget_get_parent"); + + procedure fl_widget_set_callback + (W, C : in System.Address); + pragma Import (C, fl_widget_set_callback, "fl_widget_set_callback"); + + function fl_widget_get_x + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_x, "fl_widget_get_x"); + + function fl_widget_get_y + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_y, "fl_widget_get_y"); + + function fl_widget_get_w + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_w, "fl_widget_get_w"); + + function fl_widget_get_h + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_h, "fl_widget_get_h"); + + procedure fl_widget_size + (W : in System.Address; + D, H : in Interfaces.C.int); + pragma Import (C, fl_widget_size, "fl_widget_size"); + + procedure fl_widget_position + (W : in System.Address; + X, Y : in Interfaces.C.int); + pragma Import (C, fl_widget_position, "fl_widget_position"); + + procedure fl_widget_set_image + (W, I : in System.Address); + pragma Import (C, fl_widget_set_image, "fl_widget_set_image"); + + + + + function Parent + (This : in Widget) + return access FLTK.Widgets.Groups.Group'Class + is + Parent_Ptr : System.Address; + Actual_Parent : access FLTK.Widgets.Groups.Group'Class; + begin + Parent_Ptr := fl_widget_get_parent (This.Void_Ptr); + if Parent_Ptr /= System.Null_Address then + Actual_Parent := Group_Convert.To_Pointer (fl_widget_get_user_data (Parent_Ptr)); + end if; + return Actual_Parent; + end Parent; + + + + + function Get_Box + (This : in Widget) + return Box_Kind is + begin + return Box_Kind'Val (fl_widget_get_box (This.Void_Ptr)); + end Get_Box; + + + + + procedure Set_Box + (This : in out Widget; + Box : in Box_Kind) is + begin + fl_widget_set_box (This.Void_Ptr, Box_Kind'Pos (Box)); + end Set_Box; + + + + + function Get_Label + (This : in out Widget) + return String is + begin + return Interfaces.C.Strings.Value (fl_widget_get_label (This.Void_Ptr)); + end Get_Label; + + + + + procedure Set_Label + (This : in out Widget; + Text : in String) is + begin + fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); + end Set_Label; + + + + + function Get_Label_Font + (This : in Widget) + return Font_Kind is + begin + return Font_Kind'Val (fl_widget_get_label_font (This.Void_Ptr)); + end Get_Label_Font; + + + + + procedure Set_Label_Font + (This : in out Widget; + Font : in Font_Kind) is + begin + fl_widget_set_label_font (This.Void_Ptr, Font_Kind'Pos (Font)); + end Set_Label_Font; + + + + + function Get_Label_Size + (This : in Widget) + return Font_Size is + begin + return Font_Size (fl_widget_get_label_size (This.Void_Ptr)); + end Get_Label_Size; + + + + + procedure Set_Label_Size + (This : in out Widget; + Size : in Font_Size) is + begin + fl_widget_set_label_size (This.Void_Ptr, Interfaces.C.int (Size)); + end Set_Label_Size; + + + + + function Get_Label_Type + (This : in Widget) + return Label_Kind is + begin + return Label_Kind'Val (fl_widget_get_label_type (This.Void_Ptr)); + end Get_Label_Type; + + + + + procedure Set_Label_Type + (This : in out Widget; + Label : in Label_Kind) is + begin + fl_widget_set_label_type (This.Void_Ptr, Label_Kind'Pos (Label)); + end Set_Label_Type; + + + + + -- this is the part called by FLTK callbacks + -- note that the user data portion is a reference back to the Ada binding + procedure Callback_Hook (W, U : in System.Address); + pragma Convention (C, Callback_Hook); + + procedure Callback_Hook + (W, U : in System.Address) + is + Ada_Widget : access Widget'Class := + Widget_Convert.To_Pointer (U); + begin + Ada_Widget.Callback.all (Ada_Widget.all); + end Callback_Hook; + + + + + procedure Set_Callback + (This : in out Widget; + Func : in Widget_Callback) is + begin + if Func /= null then + This.Callback := Func; + fl_widget_set_callback (This.Void_Ptr, Callback_Hook'Address); + end if; + end Set_Callback; + + + + + function Get_X + (This : in Widget) + return Integer is + begin + return Integer (fl_widget_get_x (This.Void_Ptr)); + end Get_X; + + + + + function Get_Y + (This : in Widget) + return Integer is + begin + return Integer (fl_widget_get_y (This.Void_Ptr)); + end Get_Y; + + + + + function Get_W + (This : in Widget) + return Integer is + begin + return Integer (fl_widget_get_w (This.Void_Ptr)); + end Get_W; + + + + + function Get_H + (This : in Widget) + return Integer is + begin + return Integer (fl_widget_get_h (This.Void_Ptr)); + end Get_H; + + + + + procedure Resize + (This : in out Widget; + W, H : in Integer) is + begin + fl_widget_size + (This.Void_Ptr, + Interfaces.C.int (W), + Interfaces.C.int (H)); + end Resize; + + + + + procedure Reposition + (This : in out Widget; + X, Y : in Integer) is + begin + fl_widget_position + (This.Void_Ptr, + Interfaces.C.int (X), + Interfaces.C.int (Y)); + end Reposition; + + + + + function Get_Image + (This : in Widget) + return access FLTK.Images.Image'Class is + begin + return This.Current_Image; + end Get_Image; + + + + + procedure Set_Image + (This : in out Widget; + Pic : in out FLTK.Images.Image'Class) is + begin + This.Current_Image := Pic'Unchecked_Access; + fl_widget_set_image + (This.Void_Ptr, + Wrapper (Pic).Void_Ptr); + end Set_Image; + + +end FLTK.Widgets; + diff --git a/src/fltk-widgets.ads b/src/fltk-widgets.ads new file mode 100644 index 0000000..d1c4b89 --- /dev/null +++ b/src/fltk-widgets.ads @@ -0,0 +1,162 @@ + + +with FLTK.Enums; use FLTK.Enums; +with FLTK.Images; +limited with FLTK.Widgets.Groups; +private with System; +private with System.Address_To_Access_Conversions; +private with Ada.Unchecked_Conversion; + + +package FLTK.Widgets is + + + type Widget is abstract new Wrapper with private; + + + type Widget_Callback is access procedure + (Item : in out Widget'Class); + + + type Font_Size is new Natural; + Normal_Size : constant Font_Size := 14; + type Color is new Natural; + + + function Create + (X, Y, W, H : in Integer; + Text : in String) + return Widget is abstract; + + + function Parent + (This : in Widget) + return access FLTK.Widgets.Groups.Group'Class; + + + function Get_Box + (This : in Widget) + return Box_Kind; + + + procedure Set_Box + (This : in out Widget; + Box : in Box_Kind); + + + function Get_Label + (This : in out Widget) + return String; + + + procedure Set_Label + (This : in out Widget; + Text : in String); + + + function Get_Label_Font + (This : in Widget) + return Font_Kind; + + + procedure Set_Label_Font + (This : in out Widget; + Font : in Font_Kind); + + + function Get_Label_Size + (This : in Widget) + return Font_Size; + + + procedure Set_Label_Size + (This : in out Widget; + Size : in Font_Size); + + + function Get_Label_Type + (This : in Widget) + return Label_Kind; + + + procedure Set_Label_Type + (This : in out Widget; + Label : in Label_Kind); + + + procedure Set_Callback + (This : in out Widget; + Func : in Widget_Callback); + + + function Get_X + (This : in Widget) + return Integer; + + + function Get_Y + (This : in Widget) + return Integer; + + + function Get_W + (This : in Widget) + return Integer; + + + function Get_H + (This : in Widget) + return Integer; + + + procedure Resize + (This : in out Widget; + W, H : in Integer); + + + procedure Reposition + (This : in out Widget; + X, Y : in Integer); + + + function Get_Image + (This : in Widget) + return access FLTK.Images.Image'Class; + + + procedure Set_Image + (This : in out Widget; + Pic : in out FLTK.Images.Image'Class); + + +private + + + type Widget is abstract new Wrapper with + record + Callback : Widget_Callback; + Current_Image : access FLTK.Images.Image'Class; + end record; + + + package Widget_Convert is new System.Address_To_Access_Conversions (Widget'Class); + -- package Callback_Convert is new System.Address_To_Access_Conversions (Widget_Callback); + package Callback_Convert is + function To_Pointer is new Ada.Unchecked_Conversion (System.Address, Widget_Callback); + function To_Address is new Ada.Unchecked_Conversion (Widget_Callback, System.Address); + end Callback_Convert; + + + function fl_widget_get_user_data + (W : in System.Address) + return System.Address; + pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data"); + + + procedure fl_widget_set_user_data + (W, D : in System.Address); + pragma Import (C, fl_widget_set_user_data, "fl_widget_set_user_data"); + + +end FLTK.Widgets; + diff --git a/src/fltk.adb b/src/fltk.adb new file mode 100644 index 0000000..983f308 --- /dev/null +++ b/src/fltk.adb @@ -0,0 +1,44 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK is + + + function fl_run return Interfaces.C.int; + pragma Import (C, fl_run, "fl_run"); + + + + + function Run + return Integer is + begin + return Integer (fl_run); + end Run; + + + + + function Has_Valid_Ptr + (This : in Wrapper) + return Boolean is + begin + return This.Void_Ptr /= System.Null_Address; + end Has_Valid_Ptr; + + + + + procedure Initialize + (This : in out Wrapper) is + begin + This.Void_Ptr := System.Null_Address; + end Initialize; + + +end FLTK; + diff --git a/src/fltk.ads b/src/fltk.ads new file mode 100644 index 0000000..490050d --- /dev/null +++ b/src/fltk.ads @@ -0,0 +1,43 @@ + + +with Ada.Finalization; +private with System; + + +package FLTK is + + + function Run return Integer; + + + -- ugly implementation detail, never use this + -- just ignore the hand moving behind the curtain + -- (this is necessary so things like text_buffers and + -- widgets can talk to each other behind the binding) + type Wrapper is abstract new Ada.Finalization.Limited_Controlled with private; + + +private + + + function Has_Valid_Ptr + (This : in Wrapper) + return Boolean; + + + type Wrapper is abstract new Ada.Finalization.Limited_Controlled with + record + Void_Ptr : System.Address; + end record; + -- with Type_Invariant => Has_Valid_Ptr (Wrapper); + + -- unsure if the above invariant is doing what I'm after + -- oh well, something to work on + + + overriding procedure Initialize + (This : in out Wrapper); + + +end FLTK; + -- cgit